ASP+XML編程執行個體講解(2)

四、操作Xml資料的Cls_Person類說明（clsPerson.asp）

Cls_Person類用來完成與連絡人資訊相關的各種操作，包括添加、修改和刪除等等，它使用VBScript編寫。Cls_Person包括Id、Name、Nick、Mobile、Tel、Email、QQ和Company屬性，對應於XML檔案中的Person節點。Cls_Person包括GetInfoFromXml、AddToXml、EditToXml和DeleteFormXml四個主要方法，分別完成擷取資訊，添加資訊，修改資訊和刪除資訊四個功能。

Cls_Person的具體實現如下，

'***************************************************
' 說明：Person類
' 作者：gwd 2002-11-06
' 引用：pub/constpub.asp
'***************************************************
Class Cls_Person
Private m_intId ' Id，對應Person節點在Persons集合中的位置
Private m_strName ' 姓名
Private m_strNick ' 英文名
Private m_strMobile ' 手機
Private m_strTel ' 電話
Private m_strEmail ' 電子郵件
Private m_strQQ ' QQ號
Private m_strCompany ' 所在公司
Private m_strError ' 出錯資訊
' 類初始化
Private Sub Class_Initialize()
　m_strError = ""
　m_intId = -1
End Sub
' 類釋放
Private Sub Class_Terminate()
　m_strError = ""
End Sub
'-----讀寫各個屬性---------------------------
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
'-----------------------------------------------
' 擷取錯誤資訊
Public Function GetLastError()
　GetLastError = m_strError
End Function
' 私人方法，添加錯誤資訊
Private Sub AddErr(strEcho)
　m_strError = m_strError + "＜Div CLASS=""alert""＞" & strEcho & "＜/Div＞"
End Sub
' 清除錯誤資訊
Public Function ClearError()
　m_strError = ""
End Function
' 從Xml中讀取指定節點的資料，並填充各個屬性
' 需要首先設定Id
Public Function GetInfoFromXml(objXmlDoc)
　Dim objNodeList
　Dim I
ClearError
If objXmlDoc Is Nothing Then
　　GetInfoFromXml = False
　　AddErr "Dom對象為空白值"
　　Exit Function
　End If
If CStr(m_intId) = "-1" Then
　　GetInfoFromXml = False
　　AddErr "未正確設定連絡人對象的ID屬性"
　　Exit Function
　Else
　　I = m_intId - 1 ' 要讀取得節點位置
　End If
' 選擇並讀取節點資訊，賦予各個屬性
　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 "擷取聯絡資訊發生錯誤"
　　Set objNodeList = Nothing
　　Exit Function
　End If
　Set objNodeList = Nothing
End Function
' 添加資訊到XML檔案中
' 需要首先設定好要填充的屬性
Public Function AddToXml(objXmlDoc)
　Dim objPerson, objNode
ClearError
If objXmlDoc Is Nothing Then
　　AddToXml = False
　　AddErr "Dom對象為空白值"
　　Exit Function
　End If
' 建立Person節點
　Set objPerson = objXmlDoc.createElement("Person")
　objXmlDoc.documentElement.appendChild objPerson
' 建立各個子節點
　'-----------------------------------------------------
　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) '儲存XML檔案
　If Err.Number = 0 Then
　　AddToXml = True
　Else
　　AddToXml = False
　　AddErr Err.Description
　End If
End Function
' 從XML檔案中刪除資料
' 需要首先設定Id
Public Function DeleteFromXml(objXmlDoc)
　Dim objNodeList, objNode
ClearError
If objXmlDoc Is Nothing Then
　　DeleteFromXml = False
　　AddErr "Dom對象為空白值"
　　Exit Function
　End If
If CStr(m_intId) = "-1" Then
　　DeleteFromXml = False
　　AddErr "未正確設定連絡人對象的ID屬性"
　　Exit Function
　End If
Set objNodeList = objXmlDoc.getElementsByTagName("Person")
　If objNodeList.length - m_intId ＜ 0 Then
　　DeleteFromXml = False
　　AddErr "未找到相應的連絡人"
　　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 "刪除連絡人失敗"
　　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
' 修改XML檔案中的資料
' 需要首先設定好Id
Public Function EditToXml(objXmlDoc)
　Dim objPersonList, objOldPerson, objNewPerson, objNode
ClearError
If objXmlDoc Is Nothing Then
　　EditToXml = False
　　AddErr "Dom對象為空白值"
　　Exit Function
　End If
If CStr(m_intId) = "-1" Then
　　EditToXml = False
　　AddErr "未正確設定連絡人對象的ID屬性"
　　Exit Function
　End If
Set objPersonList = objXmlDoc.getElementsByTagName("Person")
　If objPersonList.length - m_intId ＜ 0 Then
　　DeleteFromXml = False
　　AddErr "未找到相應的連絡人"
　　Set objPersonList = Nothing
　　Exit Function
　End If
Set objOldPerson = objPersonList(m_intId-1) ' 要修改的舊節點
Set objNewPerson = objXmlDoc.createElement("Person") ' 用來替換舊節點的新節點
　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
　' 進行替換
　Set objNode = objXmlDoc.documentElement.replaceChild(objNewPerson, objOldPerson)
　If objNode Is Nothing Then
　EditToXml = False
　AddErr "修改連絡人失敗"
　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