vbs类天生xml文件

<%@ Language=Vbscript %>
<% Option Explicit %>

<%
Dim objXML, strPath, str
Set objXML = New clsXML

strPath = Server.MapPath('.') & '\New.xml'

objXML.createFile strPath, 'Root'
'Or If using an existing XML file:
'objXML.File = 'C:\File.xml'

objXML.createRootChild 'Images'

'Here only one attribute is added to the Images/Image Node
objXML.createChildNodeWAttr 'Images', 'Image', 'id', '1'
objXML.updateField 'Images//Image[@id=1]', 'super.gif'
objXML.createRootNodeWAttr 'Jobs', Array('Size', 'Length', 'Width'), _
Array(24, 31, 30)
objXML.createRootNodeWAttr 'Jobs', Array('Size', 'Length', 'Width'), _
Array(24, 30, 29)
objXML.createRootNodeWAttr 'Jobs', Array('Size', 'Length', 'Width'), _
Array(24, 31, 85)

'Notice that all three job nodes have size 24, all of those
'nodes will be updated
objXML.updateField 'Jobs[@Size=24]', '24's'

'Notice that only two nodes have the specified XPath, hence
'only two new child nodes will be added
objXML.createChildNodeWAttr 'Jobs[@Size=24 and @Length=31]', 'Specs', _
Array('Wood', 'Metal', 'Color'), _
Array('Cedar', 'Aluminum', 'Green')

'It is always important to iterate through all of the nodes
'returned by this XPath query.
For Each str In objXML.getField('Jobs[@Size=24]')
Response.Write(str & '
')
Next
Set objXML = Nothing

Response.Redirect 'New.xml'
%>

clsXML.asp:

<%
Class clsXML
'strFile must be full path to document, ie C:\XML\XMLFile.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 = Server.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 = Server.CreateObject('Scripting.FileSystemObject')
Set objTextFile = objFSO.CreateTextFile(strPath, True)
objTextFile.WriteLine('')
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.item(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.Text = 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
%>