'************************************************ * *
' Description : classe de personne
' Auteur : gwd 2002-11-06
' Référence : pub/constpub.asp
'************************************************ * * Class Cls_Person Private m_intId 'Id, correspondant à la position du nœud Person dans la collection Persons
Privé m_strName ' Nom
Privé m_strNick ' Nom anglais
Privé m_strMobile 'Téléphone portable
Privé m_strTel 'Téléphone
Privé m_strEmail 'E-mail
Numéro QQ privé m_strQQ '
Privé m_strCompany ' Entreprise
Initialisation de la classe privée m_strError 'message d'erreur '
Sous-classe privée_Initialize()
m_strErreur = ""
m_intId = -1
Fin de la sortie de Sub'Class
Sous-classe privée_Terminate()
m_strErreur = ""
End Sub '-----Lire et écrire chaque propriété---------------------------------------- Propriété publique Obtenir l'identifiant
identifiant = m_intId
Propriété de fin Propriété publique Let Id(intId)
m_intId = intId
Propriété de fin Propriété publique Obtenir le nom
Nom = m_strName
Propriété de fin Propriété publique Let Name(strName)
m_strName = strName
Fin de la propriété Propriété publique Obtenir Nick
Nick = m_strNick
Fin de la propriété Propriété publique Laisser Nick(strNick)
m_strNick = strNick
Fin de la propriété Propriété publique Devenez mobile
Mobile = m_strMobile
Fin de la propriété Propriété publique Louer Mobile (strMobile)
m_strMobile = strMobile
Fin de la propriété Propriété publique Obtenir un numéro de téléphone
Tél = m_strTel
Fin de la propriété Propriété publique Let Tel(strTel)
m_strTel = strTel
Fin de la propriété Propriété publique Recevoir un e-mail
E-mail = m_strEmail
Fin de la propriété Propriété publique Laisser l'e-mail(strEmail)
m_strEmail = strEmail
Propriété de fin Propriété publique Obtenir QQ
QQ = m_strQQ
Propriété de fin Propriété publique Soit QQ(strQQ)
m_strQQ = strQQ
Terminer la propriété Propriété publique Obtenir la société
Entreprise = m_strCompany
Fin de la propriété Propriété publique Société louée (strCompany)
m_strCompany = strCompany
Fin de la propriété '----------------------------------------------- -- 'Obtenir des informations sur l'erreur
Fonction publique GetLastError()
GetLastError = m_strError
End Function 'méthode privée, ajouter un message d'erreur
Sous-AddErr privé (strEcho)
m_strError = m_strError + "＜Div CLASS=""alerte""＞" & strEcho & "＜/Div＞"
End Sub 'Effacer le message d'erreur
Fonction publique ClearError()
m_strErreur = ""
End Function 'Lire les données du nœud spécifié à partir de XML et remplir chaque attribut
'Vous devez d'abord définir l'identifiant
Fonction publique GetInfoFromXml(objXmlDoc)
Dim objNodeList
Dim I ClearError Si objXmlDoc n'est rien alors
GetInfoFromXml = Faux
AddErr "L'objet Dom est nul"
Fonction de sortie
Fin Si Si CStr(m_intId) = "-1" Alors
GetInfoFromXml = Faux
AddErr "L'attribut ID de l'objet contact n'a pas été défini correctement"
Fonction de sortie
Autre
I = m_intId - 1 'Pour lire la position du nœudEnd If 'Sélectionnez et lisez les informations du nœud, attribuez chaque attribut Set objNodeList = objXmlDoc.getElementsByTagName("Person")
Si objNodeList.length - m_intId ＞= 0 Alors
En cas d'erreur, reprendre ensuite
m_strName = objNodeList(I).selectSingleNode("Nom").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("Société").Text
GetInfoFromXml = Vrai
Autre
GetInfoFromXml = Faux
AddErr "Une erreur s'est produite lors de la récupération des informations de contact"
Définir objNodeList = Rien
Fonction de sortie
Fin si
Définir objNodeList = Rien
End Function 'Ajouter des informations au fichier XML
'Vous devez d'abord définir les attributs à remplir
Fonction publique AddToXml(objXmlDoc)
Dim objPerson, objNode ClearError Si objXmlDoc n'est rien alors
AddToXml = Faux
AddErr "L'objet Dom est nul"
Fonction de sortie
End If ' Créer un nœud de personne Set objPerson = objXmlDoc.createElement("Person")
objXmlDoc.documentElement.appendChild objPerson 'Créer chaque nœud enfant'-------------------------------------- --- ---------------
Définir objNode = objXmlDoc.createElement("Nom")
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("Société")
objNode.Text = m_strCompany
objPerson.appendChild objNode
'------------------------------------------------ - --- Définir objNode = Rien
Définir objPerson = Rien en cas d'erreur Reprendre ensuite
objXmlDoc.save Server.MapPath(C_XMLFILE) 'Enregistrer le fichier XMLSi Err.Number = 0 Alors
AddToXml = Vrai
Autre
AddToXml = Faux
AddErr Err.Description
Fin si
End Function 'Supprimer les données du fichier XML
'Vous devez d'abord définir l'identifiant
Fonction publique DeleteFromXml(objXmlDoc)
Dim objNodeList, objNode ClearError Si objXmlDoc n'est rien alors
SupprimerFromXml = Faux
AddErr "L'objet Dom est nul"
Fonction de sortie
Fin Si Si CStr(m_intId) = "-1" Alors
SupprimerFromXml = Faux
AddErr "L'attribut ID de l'objet contact n'a pas été défini correctement"
Fonction de sortie
Fin si Set objNodeList = objXmlDoc.getElementsByTagName("Person")
Si objNodeList.length - m_intId < 0 Alors
SupprimerFromXml = Faux
AddErr "Le contact correspondant n'a pas été trouvé"
Définir objNodeList = Rien
Fonction de sortie
Terminer en cas d'erreur Reprendre suivant
Définir objNode = objXmlDoc.documentElement.removeChild(objNodeList(intId-1))
Si objNode n'est rien alors
SupprimerFromXml = Faux
AddErr "Échec de la suppression du contact"
Définir objNodeList = Rien
Fonction de sortie
Autre
objXmlDoc.save Server.MapPath(C_XMLFILE)
Fin si
Définir objNode = Rien
Définir objNodeList = Rien Si Err.Number = 0 Alors
SupprimerFromXml = Vrai
Autre
SupprimerFromXml = Faux
AddErr Err.Description
Fin si
End Function 'Modifier les données dans le fichier XML
'Vous devez d'abord définir l'identifiant
Fonction publique EditToXml(objXmlDoc)
Dim objPersonList, objOldPerson, objNewPerson, objNode ClearError Si objXmlDoc n'est rien alors
EditToXml = Faux
AddErr "L'objet Dom est nul"
Fonction de sortie
Fin Si Si CStr(m_intId) = "-1" Alors
EditToXml = Faux
AddErr "L'attribut ID de l'objet contact n'a pas été défini correctement"
Fonction de sortie
Fin si Set objPersonList = objXmlDoc.getElementsByTagName("Person")
Si objPersonList.length - m_intId < 0 Alors
SupprimerFromXml = Faux
AddErr "Le contact correspondant n'a pas été trouvé"
Définir objPersonList = Rien
Fonction de sortie
End If Set objOldPerson = objPersonList(m_intId-1) ' L'ancien nœud à modifier Set objNewPerson = objXmlDoc.createElement("Person") ' Le nouveau nœud utilisé pour remplacer l'ancien nœud 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("Société")
objNode.Text = m_strCompany
objNewPerson.appendChild objNode en cas d'erreur Reprendre suivant
'Remplacer Set objNode = objXmlDoc.documentElement.replaceChild(objNewPerson, objOldPerson)
Si objNode n'est rien alors
EditToXml = Faux
AddErr "Échec de la modification du contact"
Définir objOldPerosn = Rien
Définir objNewPerson = Rien
Définir objPersonList = Rien
Fonction de sortie
Autre
objXmlDoc.save Server.MapPath(C_XMLFILE)
Fin si Set objOldPerson = Rien
Définir objNewPerson = Rien
Définir objPersonList = Rien Si Err.Number = 0 Alors
EditToXml = Vrai
Autre
EditToXml = Faux
AddErr Err.Description
Fin si
Classe de fin de fonction de fin | 