'********************************************** *
' Descrição: Classe Pessoa
' Autor: gwd 2002-11-06
' Referência: pub/constpub.asp
'********************************************** * Classe Cls_Person Private m_intId 'Id, correspondente à posição do nó Person na coleção Persons
Privado m_strNome 'Nome
Privado m_strNick ' Nome em inglês
Privado m_strMobile 'Celular
Privado m_strTel 'Telefone
Privado m_strEmail ' E-mail
Privado m_strQQ 'número QQ
Privado m_strCompany ' Empresa
Inicialização da classe privada m_strError 'mensagem de erro '
Subclasse Privada_Initialize()
m_strError = ""
m_intId = -1
Fim da liberação da sub-classe
Subclasse Privada_Terminate()
m_strError = ""
End Sub '-----Leia e escreva cada propriedade------------------------------------------ Propriedade pública Obter ID
Id = m_intId
Propriedade final Propriedade pública Let Id(intId)
m_intId = intId
Fim da propriedade Propriedade pública Obter nome
Nome = m_strNome
Propriedade final Propriedade pública Let Name(strName)
m_strNome = strNome
Fim da propriedade Propriedade pública Obtenha Nick
Nick = m_strNick
Propriedade final Propriedade pública Let Nick(strNick)
m_strNick = strNick
Fim da propriedade Propriedade pública Obtenha dispositivos móveis
Celular = m_strMobile
Propriedade final Propriedade pública Let Mobile (strMobile)
m_strMobile = strMobile
Fim da propriedade Propriedade pública Obter Tel
Tel = m_strTel
Fim Propriedade Propriedade Pública Let Tel(strTel)
m_strTel = strTel
Fim da propriedade Propriedade pública Obter e-mail
E-mail = m_strEmail
Fim Propriedade Propriedade Pública Let Email(strEmail)
m_strEmail = strEmail
Fim da propriedade Propriedade pública Obtenha QQ
QQ = m_strQQ
Propriedade final Propriedade pública Let QQ(strQQ)
m_strQQ = strQQ
Fim da propriedade Propriedade pública Obter empresa
Empresa = m_strEmpresa
Propriedade Final Propriedade Pública Let Company (strCompany)
m_strEmpresa = strEmpresa
Propriedade final '---------------------------------------------------------- -- 'Obter informações de erro
Função Pública GetLastError()
GetLastError = m_strError
End Function 'método privado, adicionar mensagem de erro
Sub AddErr privado (strEcho)
m_strError = m_strError + "＜Div CLASS=""alert""＞" & strEcho & "＜/Div＞"
End Sub 'Limpar mensagem de erro
Função Pública ClearError()
m_strError = ""
End Function 'Lê os dados do nó especificado em XML e preenche cada atributo
'Você precisa definir o Id primeiro
Função pública GetInfoFromXml(objXmlDoc)
Dim objNodeList
Dim I ClearError se objXmlDoc não for nada, então
GetInfoFromXml = Falso
AddErr “Objeto Dom é nulo”
Função de saída
Fim Se Se CStr(m_intId) = "-1" Então
GetInfoFromXml = Falso
AddErr “O atributo ID do objeto de contato não foi definido corretamente”
Função de saída
Outro
I = m_intId - 1 'Para ler o nó positionEnd If 'Selecione e leia as informações do nó, atribua cada atributo Set objNodeList = objXmlDoc.getElementsByTagName("Person")
Se objNodeList.length - m_intId ＞= 0 Então
Em caso de erro, retomar o próximo
m_strName = objNodeList(I).selectSingleNode("Nome").Texto
m_strNick = objNodeList(I).selectSingleNode("Nick").Texto
m_strMobile = objNodeList(I).selectSingleNode("Mobile").Texto
m_strTel = objNodeList(I).selectSingleNode("Tel").Texto
m_strEmail = objNodeList(I).selectSingleNode("E-mail").Texto
m_strQQ = objNodeList(I).selectSingleNode("QQ").Texto
m_strCompany = objNodeList(I).selectSingleNode("Empresa").Texto
GetInfoFromXml = Verdadeiro
Outro
GetInfoFromXml = Falso
AddErr "Ocorreu um erro ao recuperar informações de contato"
Definir objNodeList = Nada
Função de saída
Terminar se
Definir objNodeList = Nada
End Function 'Adiciona informações ao arquivo XML
'Você precisa definir os atributos a serem preenchidos primeiro
Função pública AddToXml(objXmlDoc)
Dim objPerson, objNode ClearError Se objXmlDoc não for nada, então
AddToXml = Falso
AddErr “Objeto Dom é nulo”
Função de saída
End If ' Criar nó Pessoa Set objPerson = objXmlDoc.createElement("Pessoa")
objXmlDoc.documentElement.appendChild objPerson 'Criar cada nó filho'-------------------------------------- --- ---------------
Definir objNode = objXmlDoc.createElement("Nome")
objNode.Text = m_strNome
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("E-mail")
objNode.Text = m_strEmail
objPerson.appendChild objNode Definir objNode = objXmlDoc.createElement("QQ")
objNode.Text = m_strQQ
objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Empresa")
objNode.Text = m_strEmpresa
objPerson.appendChild objNode
'------------------------------------------------ - --- Definir objNode = Nada
Definir objPerson = Nada em caso de erro Retomar próximo
objXmlDoc.save Server.MapPath(C_XMLFILE) 'Salvar arquivo XMLSe Err.Number = 0 Então
AddToXml = Verdadeiro
Outro
AddToXml = Falso
AddErr Err.Descrição
Terminar se
End Function 'Remover dados do arquivo XML
'Você precisa definir o Id primeiro
Função pública DeleteFromXml(objXmlDoc)
Dim objNodeList, objNode ClearError Se objXmlDoc não for nada, então
DeleteFromXml = Falso
AddErr “Objeto Dom é nulo”
Função de saída
Fim Se Se CStr(m_intId) = "-1" Então
DeleteFromXml = Falso
AddErr “O atributo ID do objeto de contato não foi definido corretamente”
Função de saída
End If Set objNodeList = objXmlDoc.getElementsByTagName("Pessoa")
Se objNodeList.length - m_intId <0 Então
DeleteFromXml = Falso
AddErr "O contato correspondente não foi encontrado"
Definir objNodeList = Nada
Função de saída
Terminar se houver erro, continuar em seguida
Definir objNode = objXmlDoc.documentElement.removeChild(objNodeList(intId-1))
Se objNode não for nada, então
DeleteFromXml = Falso
AddErr "Falha ao excluir contato"
Definir objNodeList = Nada
Função de saída
Outro
objXmlDoc.save Servidor.MapPath(C_XMLFILE)
Terminar se
Definir objNode = Nada
Definir objNodeList = Nada Se Err.Number = 0 Então
DeleteFromXml = Verdadeiro
Outro
DeleteFromXml = Falso
AddErr Err.Descrição
Terminar se
End Function 'Modifica dados no arquivo XML
'Você precisa definir o Id primeiro
Função pública EditToXml(objXmlDoc)
Dim objPersonList, objOldPerson, objNewPerson, objNode ClearError Se objXmlDoc não for nada, então
EditToXml = Falso
AddErr “Objeto Dom é nulo”
Função de saída
Fim Se Se CStr(m_intId) = "-1" Então
EditToXml = Falso
AddErr “O atributo ID do objeto de contato não foi definido corretamente”
Função de saída
End If Set objPersonList = objXmlDoc.getElementsByTagName("Pessoa")
Se objPersonList.length - m_intId <0 Então
DeleteFromXml = Falso
AddErr "O contato correspondente não foi encontrado"
Definir objPersonList = Nada
Função de saída
End If Set objOldPerson = objPersonList(m_intId-1) ' O nó antigo a ser modificado Set objNewPerson = objXmlDoc.createElement("Person") ' O novo nó usado para substituir o nó antigo Set objNode = objXmlDoc.createElement("Name")
objNode.Text = m_strNome
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("E-mail")
objNode.Text = m_strEmail
objNewPerson.appendChild objNode Definir objNode = objXmlDoc.createElement("QQ")
objNode.Text = m_strQQ
objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Empresa")
objNode.Text = m_strEmpresa
objNewPerson.appendChild objNode em caso de erro, retomar próximo
'Substituir conjunto objNode = objXmlDoc.documentElement.replaceChild(objNewPerson, objOldPerson)
Se objNode não for nada, então
EditToXml = Falso
AddErr "Falha ao modificar contato"
Definir objOldPerosn = Nada
Definir objNewPerson = Nada
Definir objPersonList = Nada
Função de saída
Outro
objXmlDoc.save Servidor.MapPath(C_XMLFILE)
End If Set objOldPerson = Nada
Definir objNewPerson = Nada
Definir objPersonList = Nada Se Err.Number = 0 Então
EditToXml = Verdadeiro
Outro
EditToXml = Falso
AddErr Err.Descrição
Terminar se
Função Final Classe Final | 