'************************************************ **
' Description: Person class
' Author: gwd 2002-11-06
' Reference: 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 phone
Private m_strTel 'Telephone
Private m_strEmail ' Email
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 release
Private Sub Class_Terminate()
m_strError = ""
End Sub '-----Read and write 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 error information
Public Function GetLastError()
GetLastError = m_strError
End Function ' private method, add error message
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 'Read the data of the specified node from Xml and fill in each attribute
'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 was not set correctly"
Exit Function
Else
I = m_intId - 1 'To read the node positionEnd If 'Select and read the node information, assign each attribute 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 "An error occurred while retrieving contact information"
Set objNodeList = Nothing
Exit Function
End If
Set objNodeList = Nothing
End Function 'Add information to the XML file
'You need to set the attributes to be filled 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 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 fileIf Err.Number = 0 Then
AddToXml = True
Else
AddToXml = False
AddErr Err.Description
End If
End Function 'Remove data from 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 was not set correctly"
Exit Function
End If Set objNodeList = objXmlDoc.getElementsByTagName("Person")
If objNodeList.length - m_intId < 0 Then
DeleteFromXml = False
AddErr "The corresponding contact was not 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 "Failed to delete contact"
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 data in 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 was not set correctly"
Exit Function
End If Set objPersonList = objXmlDoc.getElementsByTagName("Person")
If objPersonList.length - m_intId < 0 Then
DeleteFromXml = False
AddErr "The corresponding contact was not found"
Set objPersonList = Nothing
Exit Function
End If Set objOldPerson = objPersonList(m_intId-1) ' The old node to be modified Set objNewPerson = objXmlDoc.createElement("Person") ' The new node used to replace 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
'Replace Set objNode = objXmlDoc.documentElement.replaceChild(objNewPerson, objOldPerson)
If objNode Is Nothing Then
EditToXml = False
AddErr "Failed to modify contact"
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 | 