Vbs native xml file

There are two files: objXML. asp: test file clsXML. asp: vbs File Code: objXML. asp % @ Language = VBScript % OptionExplicit %! -- # INCLUDEFILE = "clsXML. asp" -- % DimobjXML, strPath, and strSe have two files:
ObjXML. asp: test file
ClsXML. asp: vbs files
Code:
ObjXML. asp

<% @ 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 'job', Array ('size', 'length', 'width '),_
Array (24, 31, 30)
ObjXML. createRootNodeWAttr 'job', Array ('size', 'length', 'width '),_
Array (24, 30, 29)
ObjXML. createRootNodeWAttr 'job', 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. filesystemobobject ')
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.doc umentElement. 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.doc umentElement. 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.doc umentElement. 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.doc umentElement. 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.doc umentElement. 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.doc umentElement. 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.doc umentElement. selectNodes (strXPath)
ObjDoc.doc umentElement. removeChild objOld
Next
ObjDoc. Save strFile
Set objOld = Nothing
End Function
End Class
%>