XML Operation classes

Author: unknown please contact with me
<%
Class XMLDOMDocument
Private Fnode,fanode
Private Ferrinfo,ffilename,fopen
Dim XmlDom

' Returns the node's indent string
Private Property Get tabstr (ByVal Node)
Tabstr= ""
If Node is Nothing Then the Exit property
If not Node.parentnode are nothing Then tabstr= "" &tabstr (Node.parentnode)
End Property

' Returns a child node object, elementobj as the parent node, childnodeobj the node to find, Isattributenode indicates whether the Property object
Public Property Get Childnode (byVal elementobj,byval childnodeobj,byval isattributenode)
Dim Element
Set childnode=nothing

If IsNull (childnodeobj) Then
If isattributenode= falseThen
Set Childnode=fnode
Else
Set Childnode=fanode
End If
Exit Property
ElseIf IsObject (childnodeobj) Then
Set Childnode=childnodeobj
Exit Property
End If

Set element=nothing
If LCase (TypeName (childnodeobj)) = "string" and Trim (childnodeobj) <> "Then
If IsNull (elementobj) Then
Set Element=fnode
ElseIf LCase (TypeName (elementobj)) = "string" Then
If Trim (elementobj) <> "Then
Set Element=xmldom.selectsinglenode ("//" &trim (elementobj))
If Lcase (element.nodetypestring) = "attribute" then Set element=element.selectsinglenode ("..")
End If
ElseIf IsObject (elementobj) Then
Set Element=elementobj
End If

If Element is Nothing Then
Set Childnode=xmldom.selectsinglenode ("//" &trim (childnodeobj))
ElseIf isattributenode= trueThen
Set Childnode=element.selectsinglenode ("./@" &trim (childnodeobj))
Else
Set Childnode=element.selectsinglenode ("./" &trim (childnodeobj))
End If
End If
End Property

' Read the last error message
Public Property Get Errinfo
Errinfo=ferrinfo
End Property

' To XML content
Public Property Get XmlText (ByVal elementobj)
Xmltext= ""
If fopen= falseThen Exit property

Set Elementobj=childnode (Xmldom,elementobj, false)
If Elementobj is Nothing Then Set elementobj=xmldom

Xmltext=elementobj.xml
End Property

'=================================================================
' Class initialization
Private Sub Class_Initialize ()
Set xmldom=createobject ("Microsoft.XMLDOM")
Xmldom.preservewhitespace= true

Set fnode=nothing
Set fanode=nothing

Ferrinfo= ""
Ffilename= ""
fopen= false
End Sub

' Class release
Private Sub Class_Terminate ()
Set fnode=nothing
Set fanode=nothing
Set xmldom=nothing
fopen= false
End Sub

'=====================================================================
' Create an XML file, Rootelementname: root node name. Xslurl: Using XSL style addresses
' Return to the root node.
FunctionCreate (ByVal rootelementname,byval xslurl)
Dim pinode,rootelement

Set create=nothing

If (XmlDom is Nothing) Or (fopen= true) then Exit Function

If Trim (rootelementname) = "Then Rootelementname=" Root "

Set pinode=xmldom.createprocessinginstruction ("xml", "version=" "1.0" "encoding=" "GB2312" "")
Xmldom.appendchild Pinode

Set Pinode=xmldom. Createprocessinginstruction ("Xml-stylesheet", "type=" "text/xsl" "href=" "" &XslUrl& "" "")
Xmldom.appendchild Pinode

Set rootelement=xmldom.createelement (Trim (rootelementname))
Xmldom.appendchild rootelement

Set create=rootelement

Fopen=true
Set Fnode=rootelement
End Function

' Start an existing XML file and return to the open state
FunctionOpen (ByVal xmlsourcefile)
open= false

Xmlsourcefile=trim (Xmlsourcefile)
If xmlsourcefile= "then Exit Function

Xmldom.async = false
Xmldom.load Xmlsourcefile

Ffilename=xmlsourcefile

If not IsError Then
open= true
fopen= true
End If
End Function

' Off
Sub Close ()
Set fnode=nothing
Set fanode=nothing

Ferrinfo= ""
Ffilename= ""
fopen= false
End Sub

' Read the value of a nodeobj node text
' Nodeobj can be either a node object or a node name, or null to take the current default Fnode
FunctionGetnodetext (ByVal NodeOBJ)
Getnodetext= ""
If fopen= falseThen Exit Function

Set Nodeobj=childnode ( NULL, NodeOBJ, false)
If NodeOBJ is and then Exit Function

If Lcase (nodeobj.nodetypestring) = "element" Then
Set Fnode=nodeobj
Else
Set Fanode=nodeobj
End If
Getnodetext=nodeobj.text
End function

' Insert under Befelementobj A child node named Elementname,value as Elementtext.
' IsFirst: Is it in the first position; Iscdata: Indicates whether the value of the node belongs to a CDATA type
' Insert succeeds to return new insert this node
' Befelementobj can be either an object or a node name, or null to take the current default object
FunctionInsertelement (byVal befelementobj,byval elementname,byval elementtext,byval isfirst,byval IsCDATA)
Dim Element,textsection,spacestr
Set insertelement=nothing

If not fopen then Exit Function

Set Befelementobj=childnode (Xmldom,befelementobj, false)
If Befelementobj is and then Exit Function

Set element=xmldom.createelement (Trim (elementname))

' Spacestr=vbcrlf&tabstr (befelementobj)
' Set Stabstr=xmldom.createtextnode (SPACESTR)

' If Len (spacestr) >2 then Spacestr=left (Spacestr,len (SPACESTR)-2)
' Set Etabstr=xmldom.createtextnode (SPACESTR)

If isfirst= trueThen
' Befelementobj.insertbefore Etabstr,befelementobj.firstchild
Befelementobj.insertbefore Element,befelementobj.firstchild
' Befelementobj.insertbefore Stabstr,befelementobj.firstchild
Else
' Befelementobj.appendchild stabstr
Befelementobj.appendchild Element
' Befelementobj.appendchild etabstr
End If

If Iscdata= trueThen
Set Textsection=xmldom.createcdatasection (Elementtext)
Element.appendchild textsection
ElseIf elementtext<> "" Then
Element.text=elementtext
End If

Set insertelement=element
Set fnode=element
End Function

' Insert or modify a property named AttributeName on the Elementobj node with a value of: Attributetext
' If a Property object named AttributeName already exists, modify it.
' Returns the node that inserted or modified the attribute
' Elementobj can be an element object or a name, or null to take the current default object
FunctionSetattributenode (byVal elementobj,byval attributename,byval attributetext)
Dim Attributenode
Set setattributenode=nothing

If not fopen then Exit Function

Set Elementobj=childnode (Xmldom,elementobj, false)
If Elementobj is and then Exit Function

Set Attributenode=elementobj.attributes.getnameditem (AttributeName)
If Attributenode is Nothing Then
Set Attributenode=xmldom.createattribute (AttributeName)
Elementobj.setattributenode Attributenode
End If
Attributenode.text=attributetext

Set Fnode=elementobj
Set Fanode=attributenode
Set Setattributenode=attributenode
End Function

' Modifies the text value of the Elementobj node and returns the node
' Elementobj can object or object name, NULL to take the current default object
FunctionUpdatenodetext (byVal elementobj,byval newelementtext,byval iscdata)
Dim textsection

Set updatenodetext=nothing
If not fopen then Exit Function

Set Elementobj=childnode (Xmldom,elementobj, false)
If Elementobj is and then Exit Function

If Iscdata= trueThen
Set Textsection=xmldom.createcdatasection (Newelementtext)
If Elementobj.firstchild is Nothing Then
Elementobj.appendchild textsection
ElseIf LCase (ElementOBJ.firstchild.nodeTypeString) = "Cdatasection" Then
Elementobj.replacechild Textsection,elementobj.firstchild
End If
Else
Elementobj.text=newelementtext
End If

Set Fnode=elementobj
Set Updatenodetext=elementobj
End Function

' Returns the first elementnode that meets the testvalue condition, and null to take the current default object
FunctionGetelementnode (ByVal elementname,byval testvalue)
Dim Element,regex,basename

Set getelementnode=nothing
If not fopen then Exit Function

Testvalue=trim (TestValue)
Set regex=new REGEXP
Regex.pattern= "^[a-za-z]+"
Regex.ignorecase= true
If regex.test (testvalue) then testvalue= "/" &testvalue
Set regex=nothing

Basename=lcase (Right (Elementname,len (elementname)-instrrev (ElementName, "/",-1)))

Set Element=xmldom.selectsinglenode ("//" &elementname&testvalue)

If Element is Nothing Then
' Response.Write Elementname&testvalue
Set getelementnode=nothing
Exit Function
End If

Do While LCase (Element.basename) <>basename
Set Element=element.selectsinglenode ("..")
If Element is Nothing Then Exit do
Loop

If LCase (element.basename) <>basename Then
Set getelementnode=nothing
Else
Set getelementnode=element
If Lcase (element.nodetypestring) = "Element" Then
Set fnode=element
Else
Set fanode=element
End If
End If
End Function

' Delete a child node
FunctionRemoveChild (ByVal elementobj)
Removechild= false
If not fopen then Exit Function

Set Elementobj=childnode ( NULL, Elementobj, false)
If Elementobj is and then Exit Function

' Response.Write Elementobj.basename

If Lcase (elementobj.nodetypestring) = "element" Then
If Elementobj is FNode then set fnode=nothing
If Elementobj.parentnode is Nothing Then
Xmldom.removechild (Elementobj)
Else
ElementOBJ.parentNode.removeChild (Elementobj)
End If
Removechild=true
End If
End Function

' Empties all child nodes of a node
FunctionClearnode (ByVal elementobj)
Set clearnode=nothing
If not fopen then Exit Function

Set Elementobj=childnode ( nul