S.l.e!ep.¢%

像打了激速一样,以四倍的速度运转,开心的工作
简单、开放、平等的公司文化;尊重个性、自由与个人价值;
posts - 1098, comments - 335, trackbacks - 0, articles - 1
  C++博客 :: 首页 :: 新随笔 :: 联系 :: 聚合  :: 管理

一个XML类创建子节点的问题

Posted on 2009-10-22 08:04 S.l.e!ep.¢% 阅读(480) 评论(0)  编辑 收藏 引用 所属分类: HTML
网上找了个VBS操作XML的类,代码如下:
Class clsXML
'strFile must be full path to document, ie C:XMLXMLFile.XML
'objDoc is the XML Object
Private strFile, objDoc

'*********************************************************************
' Initialization/Termination
'*********************************************************************

'Initialize Class Members
Private Sub Class_Initialize()
strFile = ""
End Sub

'Terminate and unload all created objects
Private Sub Class_Terminate()
Set objDoc = Nothing
End Sub

'*********************************************************************
' Properties
'*********************************************************************

'Set XML File and objDoc
Public Property Let File(str)
Set objDoc = CreateObject("Microsoft.XMLDOM")
objDoc.async = False
strFile = str
objDoc.Load strFile
End Property

'Get XML File
Public Property Get File()
File = strFile
End Property

'*********************************************************************
' Functions
'*********************************************************************

'Create Blank XML File, set current obj File to newly created file
Public Function createFile(strPath, strRoot)
Dim objFSO, objTextFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile(strPath, True)
objTextFile.WriteLine("<?xml version=""1.0"" encoding=""gb2312""?>")
objTextFile.WriteLine("<" & strRoot & "/>")
objTextFile.Close
Me.File = strPath
Set objTextFile = Nothing
Set objFSO = Nothing
End Function

'Get XML Field(s) based on XPath input from root node
Public Function getField(strXPath)
Dim objNodeList, arrResponse(), i
Set objNodeList = objDoc.documentElement.selectNodes(strXPath)
ReDim arrResponse(objNodeList.length)
For i = 0 To objNodeList.length - 1
arrResponse(i) = objNodeList.Dir(i).Text
Next
getField = arrResponse
End Function

'Update existing node(s) based on XPath specs
Public Function updateField(strXPath, strData)
Dim objField
For Each objField In objDoc.documentElement.selectNodes(strXPath)
objField.DirName= strData
Next
objDoc.Save strFile
Set objField = Nothing
updateField = True
End Function

'Create node directly under root
Public Function createRootChild(strNode)
Dim objChild
Set objChild = objDoc.createNode(1, strNode, "")
objDoc.documentElement.appendChild(objChild)
objDoc.Save strFile
Set objChild = Nothing
End Function

'Create a child node under root node with attributes
Public Function createRootNodeWAttr(strNode, attr, val)
Dim objChild, objAttr
Set objChild = objDoc.createNode(1, strNode, "")
If IsArray(attr) And IsArray(val) Then
If UBound(attr)-LBound(attr) <> UBound(val)-LBound(val) Then
Exit Function
Else
Dim i
For i = LBound(attr) To UBound(attr)
Set objAttr = objDoc.createAttribute(attr(i))
objChild.setAttribute attr(i), val(i)
Next
End If
Else
Set objAttr = objDoc.createAttribute(attr)
objChild.setAttribute attr, val
End If
objDoc.documentElement.appendChild(objChild)
objDoc.Save strFile
Set objChild = Nothing
End Function

'Create a child node under the specified XPath Node
Public Function createChildNode(strXPath, strNode)
Dim objParent, objChild
For Each objParent In objDoc.documentElement.selectNodes(strXPath)
Set objChild = objDoc.createNode(1, strNode, "")
objParent.appendChild(objChild)
Next
objDoc.Save strFile
Set objParent = Nothing
Set objChild = Nothing
End Function

'Create a child node(s) under the specified XPath Node with attributes
Public Function createChildNodeWAttr(strXPath, strNode, attr, val)
Dim objParent, objChild, objAttr
For Each objParent In objDoc.documentElement.selectNodes(strXPath)
Set objChild = objDoc.createNode(1, strNode, "")
If IsArray(attr) And IsArray(val) Then
If UBound(attr)-LBound(attr) <> UBound(val)-LBound(val) Then
Exit Function
Else
Dim i
For i = LBound(attr) To UBound(attr)
Set objAttr = objDoc.createAttribute(attr(i))
objChild.SetAttribute attr(i), val(i)
Next
End If
Else
Set objAttr = objDoc.createAttribute(attr)
objChild.setAttribute attr, val
End If
objParent.appendChild(objChild)
Next
objDoc.Save strFile
Set objParent = Nothing
Set objChild = Nothing
End Function

'Delete the node specified by the XPath
Public Function deleteNode(strXPath)
Dim objOld
For Each objOld In objDoc.documentElement.selectNodes(strXPath)
objDoc.documentElement.removeChild objOld
Next
objDoc.Save strFile
Set objOld = Nothing
End Function
End Class


然后,我参照上面的类写了个目录岛,代码如下:

Dim objXML, strPath, str

Set objXML = New clsXML

strPath = "c:Dir.xml"

objXML.createFile strPath, "Dir_Island"
'<!-- 创建3个根节点 -->
objXML.createRootNodeWAttr "Dir", Array("DirID","DirName", "DirOwner", "DirDescption","CreateTime"), _
Array(1,"Dir1", "Lili", "a",now)
objXML.createRootNodeWAttr "Dir", Array("DirID","DirName", "DirOwner", "DirDescption","CreateTime"), _
Array(2,"Dir2", "Jony", "b",now)
objXML.createRootNodeWAttr "Dir", Array("DirID","DirName", "DirOwner", "DirDescption","CreateTime"), _
Array(3,"Dir3", "Self", "c",now)
'<!-- 在第一个根节点中创建1个子节点可以成功 -->
objXML.createChildNodeWAttr "Dir[@DirName='Dir1']", "Dir", _
Array("DirID","DirName", "DirOwner", "DirDescption","CreateTime"), _
Array(4,"Sub_Dir1", "Jony1", "bb",now)
'<!-- 在刚才创建的子节点中再创建1个子节点怎么就不行? -->
objXML.createChildNodeWAttr "Dir[@DirName='Sub_Dir1']", "Dir", _
Array("DirID","DirName", "DirOwner", "DirDescption","CreateTime"), _
Array(5,"Sub_Sub_Dir1", "Jony2", "bbb",now)

Set objXML = Nothing

'程序运行完后生成的XML文件如下:
' <?xml version="1.0" encoding="gb2312" ?>
'- <Dir_Island>
' - <Dir DirID="1" DirName="Dir1" DirOwner="Lili" DirDescption="a" CreateTime="3/30/2004 9:03:11 AM">
' <Dir DirID="4" DirName="Sub_Dir1" DirOwner="Jony1" DirDescption="bb" CreateTime="3/30/2004 9:03:11 AM" />
' </Dir>
' <Dir DirID="2" DirName="Dir2" DirOwner="Jony" DirDescption="b" CreateTime="3/30/2004 9:03:11 AM" />
' <Dir DirID="3" DirName="Dir3" DirOwner="Self" DirDescption="c" CreateTime="3/30/2004 9:03:11 AM" />
' </Dir_Island>

'为什么不是这样的呢?

' <?xml version="1.0" encoding="gb2312" ?>
'- <Dir_Island>
' - <Dir DirID="1" DirName="Dir1" DirOwner="Lili" DirDescption="a" CreateTime="3/30/2004 9:03:11 AM">
' <Dir DirID="4" DirName="Sub_Dir1" DirOwner="Jony1" DirDescption="bb" CreateTime="3/30/2004 9:03:11 AM">
' <Dir DirID="5" DirName="Sub_Sub_Dir1" DirOwner="Jony2" DirDescption="bbb" CreateTime="3/30/2004 9:03:11 AM" />
' </Dir>
' </Dir>
' <Dir DirID="2" DirName="Dir2" DirOwner="Jony" DirDescption="b" CreateTime="3/30/2004 9:03:11 AM" />
' <Dir DirID="3" DirName="Dir3" DirOwner="Self" DirDescption="c" CreateTime="3/30/2004 9:03:11 AM" />
' </Dir_Island>

以上代码需要测试的话请各位连同类和代码COPY到本地新建一个VBS文档运行,运行结果在你本机C:Dir.xml中显示。
请教各位XML高手啊。

只有注册用户登录后才能发表评论。
网站导航: 博客园   IT新闻   BlogJava   博问   Chat2DB   管理