This script demonstrates how to save information to a xml file with the use of MSXML. The example xml file is used for the photo album on the site.
Copy codeThe Code is as follows: '*************************************** **************************
'** Script: CreateXML. vbs
'** Version: 1.0
'** Created: 01/12/2009 PM
'** Author: Adriaan Westra
'** E-mail:
'** Purpose/Comments:
'** Create xml file for photo album
'**
'**
'** Changelog:
'**: Initial version
'**
'*************************************** **************************
On Error Resume next
Dim Version: Version = "1.0" 'script version
Dim Author: Author = "A. Westra"
Dim objXML 'xml Document object
Dim root 'root element of the xml document
Dim newnode'xml Node object
Dim cNode 'xml (child) Node object
Dim cNodeText 'xml Text Node object
'*************************************** **************************
'** Make sure the script is started with cscript
If InStr (wscript. FullName, "wscript.exe")> 0 Then
MsgBox "Please run this script with cscript.exe." & Chr (13 )&_
"For example: cscript" & WScript. ScriptName &"/? ",_
VbExclamation, WScript. ScriptName
WScript. Quit (1)
End If
'*************************************** **************************
'** Get commandline parameters
Set Args = Wscript. Arguments
If Args. Count = 0 Then
StrImageDir = InputBox ("Please give the directory name "&_
"To process:", wscript. scriptname, strPath)
Else
If InStr (Args (0 ),"/? ")> 0 Or InStr (UCase (Args (0),"/H ")> 0 _
Or InStr (UCase (Args (0), "/HELP")> 0 Then
DisplayHelp
Wscript. quit (0)
Else
StrImageDir = Args (0)
End if
End if
Set objXML = CreateObject ("Msxml2.DOMDocument. 6.0 ")
ObjXML. setProperty "SelectionLanguage", "XPath"
'*************************************** **************************
'** Determine if the file exists
StrXMLFile = strImageDir & "\ album. xml"
Set objFSO = CreateObject ("Scripting. FileSystemObject ")
If objFSO. FileExists (strXMLFile) Then
'*************************************** **************************
'** Read the XML File
ObjXML. load (strXMLFile)
Else
'*************************************** **************************
'** Create the XML File
ObjXML. loadXML ("")
End If
'*************************************** **************************
'** Process directory
Set objImgDir = objFSO. GetFolder (strImageDir)
For each objFile in objImgDir. Files
If IsJPG (objFile. Name) Then
ArrTemp = split (objFile. Name ,".")
StrNode = arrTemp (0)
'*************************************** **************************
'** Determine if the node exists
If Not XmlNodeExists (strChildNode, objXML) Then
'*************************************** **************************
'** Get the root element of the xml document
Set root = objXML.doc umentElement
'*************************************** **************************
'** Create the new node
Set newNode = objXML. createNode (1, strNode ,"")
Root. appendChild newNode
Set cNode = objXML. createNode (1, "alt ","")
Set cNodeText = objXML. createNode (3 ,"","")
CNodeText. Text = strNode
CNode. appendChild cNodeText
NewNode. appendChild cNode
Set cNode = objXML. createNode (1, "Title ","")
Set cNodeText = objXML. createNode (3 ,"","")
CNodeText. Text = strNode
CNode. appendChild cNodeText
NewNode. appendChild cNode
End If
End If
Next
'*************************************** **************************
'** Save the xml file
ObjXML. save (strXMLFile)
'*************************************** **************************
'** End the script
Wscript. quit
'*************************************** **************************
'** Function: XmlNodeExists
'** Version: 1.0
'** Created: 1/12/2009 PM
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose/Comments:
'** Determines if a node exists in XML
'**
'** Arguments:
'** StrNode: Name of the XML node
'** OXML: XMl DOM Object
'**
'** Changelog:
'** 1/12/2009 12:16 PM: Initial version
'**
'*************************************** **************************
Function XmlNodeExists (strNode, oXML)
On Error Resume next
Set oNode = oXML. selectSingleNode (strNode)
StrNodetype = oNode. nodetype
If err. number = 0 Then
XmlNodeExists = True
Else
XmlNodeExists = False
End if
End Function
'*************************************** **************************
'** Sub: DisplayHelp
'** Version: 1.0
'** Created: 24-03-2003 8: 22
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose/Comments:
'** Display help for script
'**
'** Arguments:
'**
'** Wijzigingslog:
'** 24-03-2003 8:22: Initi bought e versie
'**
'*************************************** **************************
Sub DisplayHelp ()
StrComment = string (2 ,"*")
StrCmntLine = String (79 ,"*")
Wscript. echo strCmntline
Wscript. echo strComment
Wscript. echo strComment & "Online help "&_
Wscript. scriptname & "version:" & Version
Wscript. echo strComment
Wscript. echo strComment & "Usage: cscript "&_
Wscript. scriptname & "directoryname"
Wscript. echo strComment
Wscript. echo strComment & "Purpose: Create XML file "&_
"For all images in given directory ."
Wscript. echo strComment
Wscript. echo strComment & "Author:" & Author
Wscript. echo strComment & "E-mail:" & Email
Wscript. echo strComment
Wscript. echo strCmntline
End Sub
'*************************************** **************************
'** Function: IsJPG
'** Version: 1.0
'** Created: 12/29/2008 11: 01 PM
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose/Comments:
'** Determine if file is jpg image
'**
'** Arguments:
'** StrFilename: name of the file to check
'**
'** Wijzigingslog:
'** 12/29/2008 :02 PM: Initi {e versie
'**
'*************************************** **************************
Function IsJPG (strFilename)
Set objRegExp = New RegExp
ObjRegExp. Pattern = "\ invalid jpg"
ObjRegExp. IgnoreCase = True
IsJPG = objRegExp. Test (strFileName)
End Function