'*************************************************** ' 说明: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 |