Asp+xml Programming Example Explanation (2)

Iv. Cls_person class Description of manipulating XML data (clsperson.asp)

The Cls_person class is used to complete a variety of actions related to contact information, including additions, modifications, deletions, and so on, which are written in VBScript. Cls_person includes ID, Name, Nick, Mobile, Tel, Email, QQ, and Company attributes, corresponding to the person node in the XML file. Cls_person includes four main methods of Getinfofromxml, Addtoxml, Edittoxml and Deleteformxml, respectively, to obtain information, add information, modify information and delete information four functions.

The specific implementation of Cls_person is as follows,

'***************************************************
' Description: Person class
' Author: gwd 2002-11-06
' References: pub/constpub.asp
'***************************************************
Class Cls_person
Private m_intid ' Id, corresponding to the position of the person node in the persons collection
Private M_strname ' name
Private M_strnick ' English name
Private m_strmobile ' Mobile
Private M_strtel ' phone
Private m_stremail ' e-mail
Private M_STRQQ ' QQ number
Private M_strcompany ' Company
Private m_strerror ' error message
' Class initialization
Private Sub Class_Initialize ()
M_strerror = ""
M_intid =-1
End Sub
' Class releases
Private Sub Class_Terminate ()
M_strerror = ""
End Sub
'-----Read and write to each property---------------------------
Public Property Get Id
Id = M_intid
End Property
Public Property Let Id (IntId)
M_intid = IntId
End Property
Public Property Get Name
Name = M_strname
End Property
Public Property Let Name (StrName)
M_strname = StrName
End Property
Public Property Get Nick
Nick = M_strnick
End Property
Public Property Let Nick (Strnick)
M_strnick = Strnick
End Property
Public Property Get Mobile
Mobile = M_strmobile
End Property
Public Property Let Mobile (Strmobile)
M_strmobile = Strmobile
End Property
Public Property Get Tel
Tel = M_strtel
End Property
Public Property Let Tel (Strtel)
M_strtel = Strtel
End Property
Public Property Get Email
Email = M_stremail
End Property
Public Property Let Email (Stremail)
M_stremail = Stremail
End Property
Public Property Get QQ
QQ = M_strqq
End Property
Public Property Let QQ (STRQQ)
M_STRQQ = Strqq
End Property
Public Property Get Company
Company = M_strcompany
End Property
Public Property Let company (Strcompany)
M_strcompany = Strcompany
End Property
'-----------------------------------------------
' Get the error message
Public Function GetLastError ()
GetLastError = M_strerror
End Function
' Private method, adding error messages
Private Sub Adderr (Strecho)
M_strerror = M_strerror + "<div class=" "Alert" ">" & Strecho & "</Div>"
End Sub
' Clear error message
Public Function ClearError ()
M_strerror = ""
End Function
' Reads the data of the specified node from the XML and populates the individual properties
' You need to set the ID first
Public Function Getinfofromxml (objXMLDoc)
Dim objNodeList
Dim I
ClearError
If objXMLDoc is nothing Then
Getinfofromxml = False
Adderr "DOM object is null"
Exit Function
End If
If CStr (M_intid) = "-1" Then
Getinfofromxml = False
Adderr "The id attribute of the contact object is not set correctly"
Exit Function
Else
I = M_intid-1 ' to read to get the node position
End If
' Select and read node information, giving individual attributes
Set objnodelist = objxmldoc.getelementsbytagname ("person")
If Objnodelist.length-m_intid >= 0 Then
On Error Resume Next
M_strname = objNodeList (I). selectSingleNode ("Name"). Text
M_strnick = objNodeList (I). selectSingleNode ("Nick"). Text
M_strmobile = objNodeList (I). selectSingleNode ("Mobile"). Text
M_strtel = objNodeList (I). selectSingleNode ("Tel"). Text
M_stremail = objNodeList (I). selectSingleNode ("Email"). Text
M_STRQQ = objNodeList (I). selectSingleNode ("QQ"). Text
M_strcompany = objNodeList (I). selectSingleNode ("Company"). Text
Getinfofromxml = True
Else
Getinfofromxml = False
Adderr "Get Contact information Error"
Set objnodelist = Nothing
Exit Function
End If
Set objnodelist = Nothing
End Function
' Add information to the XML file
' You need to set the properties to be populated first.
Public Function Addtoxml (objXMLDoc)
Dim Objperson, Objnode
ClearError
If objXMLDoc is nothing Then
Addtoxml = False
Adderr "DOM object is null"
Exit Function
End If
' Create a person node
Set Objperson = objxmldoc.createelement ("person")
ObjXmlDoc.documentElement.appendChild Objperson
' Create each child node
'-----------------------------------------------------
Set objnode = objxmldoc.createelement ("Name")
Objnode.text = M_strname
Objperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Nick")
Objnode.text = M_strnick
Objperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Mobile")
Objnode.text = M_strmobile
Objperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Tel")
Objnode.text = M_strtel
Objperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Email")
Objnode.text = M_stremail
Objperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("QQ")
Objnode.text = M_strqq
Objperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Company")
Objnode.text = M_strcompany
Objperson.appendchild Objnode
'-----------------------------------------------------
Set Objnode = Nothing
Set Objperson = Nothing
On Error Resume Next
Objxmldoc.save Server.MapPath (c_xmlfile) ' Save XML file
If Err.Number = 0 Then
Addtoxml = True
Else
Addtoxml = False
Adderr Err.Description
End If
End Function
' Delete data from the XML file
' You need to set the ID first
Public Function Deletefromxml (objXMLDoc)
Dim objNodeList, Objnode
ClearError
If objXMLDoc is nothing Then
Deletefromxml = False
Adderr "DOM object is null"
Exit Function
End If
If CStr (M_intid) = "-1" Then
Deletefromxml = False
Adderr "The id attribute of the contact object is not set correctly"
Exit Function
End If
Set objnodelist = objxmldoc.getelementsbytagname ("person")
If Objnodelist.length-m_intid 0 Then
Deletefromxml = False
Adderr "no corresponding contact found"
Set objnodelist = Nothing
Exit Function
End If
On Error Resume Next
Set objnode = ObjXmlDoc.documentElement.removeChild (objNodeList (intId-1))
If Objnode is nothing Then
Deletefromxml = False
Adderr "Delete Contact failed"
Set objnodelist = Nothing
Exit Function
Else
Objxmldoc.save Server.MapPath (C_xmlfile)
End If
Set Objnode = Nothing
Set objnodelist = Nothing
If Err.Number = 0 Then
Deletefromxml = True
Else
Deletefromxml = False
Adderr Err.Description
End If
End Function
' Modify the data in the XML file
' You need to set the ID first.
Public Function Edittoxml (objXMLDoc)
Dim objpersonlist, Objoldperson, Objnewperson, Objnode
ClearError
If objXMLDoc is nothing Then
Edittoxml = False
Adderr "DOM object is null"
Exit Function
End If
If CStr (M_intid) = "-1" Then
Edittoxml = False
Adderr "The id attribute of the contact object is not set correctly"
Exit Function
End If
Set objpersonlist = objxmldoc.getelementsbytagname ("person")
If Objpersonlist.length-m_intid 0 Then
Deletefromxml = False
Adderr "no corresponding contact found"
Set objpersonlist = Nothing
Exit Function
End If
Set Objoldperson = objpersonlist (m_intid-1) ' The old node to modify
Set Objnewperson = objxmldoc.createelement ("person") is used to replace the new node of the old node
Set objnode = objxmldoc.createelement ("Name")
Objnode.text = M_strname
Objnewperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Nick")
Objnode.text = M_strnick
Objnewperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Mobile")
Objnode.text = M_strmobile
Objnewperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Tel")
Objnode.text = M_strtel
Objnewperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Email")
Objnode.text = M_stremail
Objnewperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("QQ")
Objnode.text = M_strqq
Objnewperson.appendchild Objnode
Set objnode = objxmldoc.createelement ("Company")
Objnode.text = M_strcompany
Objnewperson.appendchild Objnode
On Error Resume Next
' To replace
Set objnode = ObjXmlDoc.documentElement.replaceChild (Objnewperson, Objoldperson)
If Objnode is nothing Then
Edittoxml = False
Adderr "Modify Contact Failed"
Set objoldperosn = Nothing
Set Objnewperson = Nothing
Set objpersonlist = Nothing
Exit Function
Else
Objxmldoc.save Server.MapPath (C_xmlfile)
End If
Set Objoldperson = Nothing
Set Objnewperson = Nothing
Set objpersonlist = Nothing
If Err.Number = 0 Then
Edittoxml = True
Else
Edittoxml = False
Adderr Err.Description
End If
End Function
End Class