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.
复制代码 代码如下:
'*****************************************************************
'** Script: CreateXML.vbs
'** Version: 1.0
'** Created: 01/12/2009 9:51PM
'** Author: Adriaan Westra
'** E-mail:
'** Purpose / Comments:
'** Create xml file for photo album
'**
'**
'** Changelog :
'** 12-01-2009 9:51 : 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.documentElement
'*****************************************************************
'** 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 12:14PM
'** 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:16PM : 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雔e versie
'**
'*****************************************************************
Sub DisplayHelp()
strComment = string(2,"*")
strCmntLine = String(79, "*")
wscript.echo strCmntline
wscript.echo strComment
wscript.echo strComment & " Online help for " & _
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:01PM
'** 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 11:02PM : Initi雔e versie
'**
'*****************************************************************
Function IsJPG(strFilename)
Set objRegExp = New RegExp
objRegExp.Pattern = "\w.jpg"
objRegExp.IgnoreCase = True
IsJPG = objRegExp.Test(strFileName)
End Function
复制代码 代码如下:
'*****************************************************************
'** Script: CreateXML.vbs
'** Version: 1.0
'** Created: 01/12/2009 9:51PM
'** Author: Adriaan Westra
'** E-mail:
'** Purpose / Comments:
'** Create xml file for photo album
'**
'**
'** Changelog :
'** 12-01-2009 9:51 : 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.documentElement
'*****************************************************************
'** 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 12:14PM
'** 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:16PM : 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雔e versie
'**
'*****************************************************************
Sub DisplayHelp()
strComment = string(2,"*")
strCmntLine = String(79, "*")
wscript.echo strCmntline
wscript.echo strComment
wscript.echo strComment & " Online help for " & _
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:01PM
'** 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 11:02PM : Initi雔e versie
'**
'*****************************************************************
Function IsJPG(strFilename)
Set objRegExp = New RegExp
objRegExp.Pattern = "\w.jpg"
objRegExp.IgnoreCase = True
IsJPG = objRegExp.Test(strFileName)
End Function
标签:
信息,XML
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件!
如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
岱庙资源网 Copyright www.zgmyg.com
暂无“将信息保存到一个XML文件的vbs代码”评论...
RTX 5090要首发 性能要翻倍!三星展示GDDR7显存
三星在GTC上展示了专为下一代游戏GPU设计的GDDR7内存。
首次推出的GDDR7内存模块密度为16GB,每个模块容量为2GB。其速度预设为32 Gbps(PAM3),但也可以降至28 Gbps,以提高产量和初始阶段的整体性能和成本效益。
据三星表示,GDDR7内存的能效将提高20%,同时工作电压仅为1.1V,低于标准的1.2V。通过采用更新的封装材料和优化的电路设计,使得在高速运行时的发热量降低,GDDR7的热阻比GDDR6降低了70%。
更新日志
2024年09月21日
2024年09月21日
- 王瑞霞.1996-是我太软心【名冠】【WAV+CUE】
- 《谭维维 30首经典流行歌曲精选辑 2CD》[WAV/分轨][1.1GB]
- 《赵传 出道三十年全新大碟 你过得还好吗》[WAV/分轨][460MB]
- 《发烧四大天王 磁性男声HiFi发烧碟 2CD》[WAV/分轨][1GB]
- 黑神话悟空上品鼠司空精魄获取方法一览|上品鼠司空精魄收集攻略
- 《真三国无双:起源》新情报将于9月26日公开,实机演示亮相!
- 黑神话悟空上品鼠禁卫精魄获取方法一览|上品鼠禁卫精魄收集攻略
- 优美的旋律至真的情怀《品茶轻音乐·极品典藏Vol.1CD1》[WAV+CUE]
- 曾嵘《峥嵘岁月DSD(试音碟)》WAV+CUE
- 小提琴天碟AlfredoCampoli坎波利-贝多芬D大调小提琴协奏曲与普罗米修斯作品选FLAC
- 博主称本周游戏业内动荡无比:高价PS5 Pro、Xbox裁员等
- 米哈游也搞AI?米哈游AI大模型Glossa完成备案
- G胖变G瘦后:玩家担心其健康状况:如果他出事 游戏业将发生巨变
- 群星.1995-SUMMER.PASSION.REMIX【宝丽金】【WAV+CUE】
- 王栎鑫.2008-天生一对(EP)【种子音乐】【WAV+CUE】