'***************************************************
' 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 + "
" & Strecho & "
"
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 |
