--2007-6-18 18:51:10
最强对Xml操作的类，可创建无限级Xml结点，有实例（ASP代码）
<%'对Xml操作的类，可创建无限级Xml结点，有实例。此代码不知道是哪个仁兄编写的，没有留下出处。
'现在本人给改了改，并加入了出处，请不要怪小弟。
Rem =================================================================
Rem = 类:clsXML
Rem = 说明:对Xml操作的类，可创建无限级Xml结点，有实例（ASP代码）
Rem = Revision:1.01 Beta
Rem = 作者:乐府诗（654cn）
Rem = Date:2006/05/6 18:38:10
Rem = QQ:378080686
Rem = MySite:Http://www.laidu.net
Rem = 适用:对Xml操作,可创建无限级Xml结点,修改结点属性，修改结点值，删除结点等操作
Rem =================================================================
Class clsXML
'局部变量定义
Private strFile, objDoc
'*********************************************************************
' 类初始化及注销时的事件
'*********************************************************************
Private Sub Class_Initialize()
strFile = ""
End Sub
Private Sub Class_Terminate()
'注销Xml对象objDoc
Set objDoc = Nothing
End Sub
'*********************************************************************
' 属性
'*********************************************************************
'设置Xml文件路径并建立Xml对象objDoc
Public Property Let File(str)
Set objDoc = Server.CreateObject("Microsoft.XMLDOM")
objDoc.async = False
strFile = str
objDoc.Load strFile
End Property
'获取Xml文件路径
Public Property Get File()
File = strFile
End Property
'*********************************************************************
' 函数
'*********************************************************************
'创建Xml文件strPath，并加入一个根结点strRoot
Public Function createFile(strPath, strRoot)
On Error Resume Next
Dim objFSO, objTextFile
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile(strPath, True)
If Err Then
Call ErrMsg("在 createFile(" & strPath & ", " & strRoot & ") 时出错。错误提示：" & Err.Description)
End If
objTextFile.WriteLine("<?xml version=""1.0"" encoding=""GB2312""?>")
objTextFile.WriteLine("<" & strRoot & "/>")
objTextFile.Close
Me.File = strPath
Set objTextFile = Nothing
Set objFSO = Nothing
End Function
'返回结点名为strXPath（含条件）结点下的所有值加子结点值
Public Function getField(strXPath)
On Error Resume Next
Dim objNodeList, arrResponse(), i
Set objNodeList = objDoc.documentElement.selectNodes(strXPath)
ReDim arrResponse(objNodeList.length)
For i = 0 To objNodeList.length - 1
arrResponse(i) = objNodeList.item(i).Text
Next
If Err Then
Call ErrMsg("在 getField(" & strXPath & ") 时出错。错误提示：" & Err.Description)
End If
getField = arrResponse
End Function
'修改结点名为strXPath（含条件）结点的值
Public Function updateField(strXPath, strData)
On Error Resume Next
Dim objField
For Each objField In objDoc.documentElement.selectNodes(strXPath)
If Err Then
Call ErrMsg("在 updateField(" & strXPath & ", " & strData & ") 时出错。错误提示：" & Err.Description)
End If
objField.Text = strData
Next
objDoc.Save strFile
Set objField = Nothing
updateField = True
End Function
'为根结点创建子结点strNode(不带属性)
Public Function createRootChild(strNode)
On Error Resume Next
Dim objChild
Set objChild = objDoc.createNode(1, strNode, "")
objDoc.documentElement.appendChild(objChild)
If Err Then
Call ErrMsg("在 createRootChild(" & strNode & ") 时出错。错误提示：" & Err.Description)
End If
objDoc.Save strFile
Set objChild = Nothing
End Function
'为根结点创建带属性的子结点strNode(带属性)，属性名为：attr属性值为：val
Public Function createRootNodeWAttr(strNode, attr, val)
On Error Resume Next
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
If Err Then
Call ErrMsg("在 createRootNodeWAttr(" & strNode & ", " & attr & ", " & val &") 时出错。错误提示：" & Err.Description)
End If
objDoc.documentElement.appendChild(objChild)
objDoc.Save strFile
Set objChild = Nothing
End Function
'为指定的结点strXPath（含条件）创建子结点strNode(不带属性)
Public Function createChildNode(strXPath, strNode)
On Error Resume Next
Dim objParent, objChild
For Each objParent In objDoc.documentElement.selectNodes(strXPath)
If Err Then
Call ErrMsg("在 createChildNode(" & strXPath & ", " & strNode &") 时出错。错误提示：" & Err.Description)
End If
Set objChild = objDoc.createNode(1, strNode, "")
objParent.appendChild(objChild)
Next
objDoc.Save strFile
Set objParent = Nothing
Set objChild = Nothing
End Function
'为指定的结点strXPath（含条件）创建带属性的子结点strNode(带属性)，属性名为：attr属性值为：val
Public Function createChildNodeWAttr(strXPath, strNode, attr, val)
On Error Resume Next
Dim objParent, objChild, objAttr
For Each objParent In objDoc.documentElement.selectNodes(strXPath)
If Err Then
Call ErrMsg("在 createChildNodeWAttr（" & strXPath & "，" & strNode & "，" & attr & "，" & val & "） 时出错。错误提示：" & Err.Description)
End If
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
'删除指定的结点strXPath（含条件）
Public Function deleteNode(strXPath)
On Error Resume Next
Dim objOld
For Each objOld In objDoc.documentElement.selectNodes(strXPath)
If Err Then
Call ErrMsg("在删除结点 " & strXPath & " 时出错。 错误提示：" & Err.Description)
End If
objDoc.documentElement.removeChild objOld
Next
objDoc.Save strFile
Set objOld = Nothing
End Function
'错误提示信息（消息）
Private Sub ErrMsg(msg)
Response.Write msg
Response.End
End Sub
End Class
%>
<%@ Language=VBScript %>
<% Option Explicit %>
<!--#INCLUDE FILE="clsXML.asp"-->
<%
Rem =================================================================
Rem = 类:clsXML
Rem = 说明:对Xml操作的类，可创建无限级Xml结点，有实例（ASP代码）
Rem = Revision:1.01 Beta
Rem = 作者:乐府诗（654cn）
Rem = Date:2006/05/6 18:38:10
Rem = QQ:378080686
Rem = MySite:Http://www.Laidu.net
Rem = 适用:对Xml操作,可创建无限级Xml结点,修改结点属性，修改结点值，删除结点等操作
Rem =================================================================
Dim objXML, strPath, str
Set objXML = New clsXML
strPath = Server.MapPath(".") & "\NewXml.xml"
objXML.createFile strPath, "html"
'创建Xml文件strPath，并加入一个根结点Html
objXML.createRootChild "head"
'创建根结点的子结点head
objXML.createChildNodeWAttr "head", "Img", "Width", "1"
'创建head结点的标记Img，并添加属性Width=1
objXML.updateField "head//Img[@Width=1]", "super.gif"
'修改head结点下标记为Img的值为：super.gif 条件：Width=1
objXML.createRootNodeWAttr "Body", Array("Size", "Length", "Width"), Array(24, 31, 30)
'创建根结点的子结点Body，并添加属性Size=24,Length=31,Width=30
objXML.createRootNodeWAttr "Body", Array("Size", "Length", "Width"), Array(24, 30, 29)
'创建根结点的子结点Body，并添加属性Size=24,Length=30,Width=29
objXML.createRootNodeWAttr "Body", Array("Size", "Length", "Width"), Array(24, 31, 85)
'创建根结点的子结点Body，并添加属性Size=24,Length=31,Width=85
objXML.updateField "Body[@Size=24]", "24's"
'修改Body结点下所有标记值为：24's 条件：Size=24
objXML.createChildNodeWAttr "Body[@Size=24 and @Length=31]", "A", Array("Wood", "Metal", "Color"), Array("Cedar", "Aluminum", "Green")
'创建Body结点的标记A，并添加属性Wood=Cedar,Metal=Aluminum,Color=Green, 条件：Size=24 and Length=31
objXML.updateField "Body//A[@Wood='Cedar']", "A"
'修改Body结点下标记为A的值为：A 条件：Wood='Cedar'
objXML.createChildNodeWAttr "Body//A", "A2", Array("Wood", "Metal", "Color"), Array("Cedar", "Aluminum", "Green")
'创建Body//A结点的标记A2，并添加属性Wood=Cedar,Metal=Aluminum,Color=Green, 条件：无
objXML.updateField "Body//A//A2[@Wood='Cedar']", "A2"
objXML.createChildNode "Body//A","Img3"
'objXML.deleteNode("Body[@Length=31]")
'删除子结点
'返回结点名为Body结点下的所有值加子结点值
For Each str In objXML.getField("Body[@Size=24]")
Response.Write(str & "<br>")
Next
Set objXML = Nothing
Response.Redirect "NewXml.xml"
%>
相关内容
下列内容与有着内在的联系，建议您一并阅读。