Cette classe asp peut être utilisée pour gérer l'envoi et la réception de packages XML. Il peut être utilisé pour la communication entre les interfaces API entre différents systèmes hétérogènes, ainsi que pour traiter l'invocation et la réception de services Web.
propriété:
chaîne
d'adresse de réceptionpour l'envoi de XML
en écriture seule
: message d'erreur système
Chaîne
en lecture seule
: récupère la valeur du nœud dans le package XML envoyé
Chaîne
Paramètres en lecture seule : Str : nom du nœud
GetXmlData : récupère l'objet de données XML renvoyé
XMLDom
lecture seule
Méthode :
LoadXmlFromFile : remplissez le paramètre d'objet XmlDoc Path : chemin xml à partir d'un fichier XML externe
Void
LoadXmlFromString : remplissez le paramètre d'objet XmlDoc Str:xml string avec une chaîne
Vide
NodeValue définit les paramètres du nœud
Paramètre
NodeName Nom du nœud
NodeText Valeur
NodeType Type de sauvegarde [text=0,cdata=1]
blnEncode S'il faut encoder [true, false]
Vide
SendHttpData : envoyer le package XML
PrintSendXmlData : imprimer les données XML de la demande d'envoi
PrintGetXmlData : imprimer les données XML de retour
SaveSendXmlDataToFile : enregistrer les données XML de la demande d'envoi dans un fichier, le nom du fichier est sendxml_date.txt
SaveGetXmlDataToFile : enregistre les données XML renvoyées dans un fichier, le nom du fichier est getxml_date.txt
GetSingleNode : récupère le paramètre d'informations sur le nœud Nodestring du fichier XML renvoyé : nom du nœud
AcceptHttpData : reçoit le package XML, les informations d'erreur sont obtenues via l'objet Message
AcceptSingleNode : retour les informations sur le nœud du package XML reçu Paramètre Nodestring : nom du nœud
PrintAcceptXmlData : imprime les données XML reçues par l'extrémité réceptrice
SaveAcceptXmlDataToFile : enregistre les données du paquet XML reçu dans un fichier, le nom du fichier est acceptxml_date.txt
SaveDebugStringToFile : enregistrez les données de débogage dans un fichier nommé debugnote_date.txt
Paramètre Debugstr : informations de débogage
Code :
xmlcls.asp
<%
Rem gère l'envoi et la réception de classes de données XML
'------------------------------------------------ -
'Veuillez conserver les informations de copyright lors de la réimpression
'Auteur : baladeur
'Entreprise : Bubuweiying Technology Co., Ltd.
'Site Web : http://www.shouji138.com
'Version : ver1.0
'------------------------------------------------ -
Classe XmlClass
Rem
XmlDoc privé, XmlHttp
Code de message privé, SysKey, XmlPath
Privé m_GetXmlDoc, m_url
privée m_XmlDocAccept
Rem
Sous-classe privée_Initialize()
En cas d'erreur, reprendre ensuite
CodeMessage = ""
CheminXml = ""
Définir XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
XmlDoc.ASYNC = Faux
End Sub
Rem détruit l'objet
Sous-classe privée_Terminate()
Si IsObject (XmlDoc) alors définissez XmlDoc = Nothing
Si IsObject (m_XmlDocAccept) alors définissez m_XmlDocAccept = Nothing
Si IsObject (m_GetXmlDoc) alors définissez m_GetXmlDoc = Rien
Fin du sous-marin
'La définition de l'attribut public démarre -------------------------------
Message d'erreur Rem
Propriété publique Obtenir un message()
Message = CodeMessage
Propriété de fin
Rem l'adresse à laquelle envoyer du XML
Propriété publique Let URL(str)
m_url = chaîne
Propriété de fin
'Fin de la définition de l'attribut public -------------------------------
'Démarrage du processus et de la méthode privés -------------------------------
Rem charger XML
Sous-LoadXmlData privé ()
Si XmlPath <> "" Alors
Si ce n'est pas XmlDoc.Load(XmlPath) Alors
XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>"
Fin si
Autre
XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>"
Fin si
Fin de la conversion des caractères Sub
Rem
Fonction privée AnsiToUnicode (ByVal str)
Dim i, j, c, i1, i2, u, fs, f, p
AnsiVersUnicode = ""
p = ""
Pour i = 1 À Len(str)
c = Milieu (str, i, 1)
j = AscW(c)
Si j < 0 Alors
j = j + 65536
Fin si
Si j >= 0 Et j <= 128 Alors
Si p = "c" Alors
AnsiVersUnicode = " " & AnsiVersUnicode
p = "e"
Fin si
AnsiVersUnicode = AnsiVersUnicode & c
Autre
Si p = "e" Alors
AnsiVersUnicode = AnsiVersUnicode & " "
p = "c"
Fin si
AnsiVersUnicode = AnsiVersUnicode & ("&#" & j & ";")
Fin si
Suivant
Conversion des caractères Rem
de la fonction de fin
Fonction privée strAnsi2Unicode (asContents)
Dim len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(asContents)
Si len1 = 0 alors quittez la fonction
Pour i=1 à len1
varchar=MidB(asContents,i,1)
varasc=AscB(varchar)
Si varasc > 127 Alors
Si MidB(asContents,i+1,1)<>"" Alors
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
Fin si
je=je+1
Autre
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
Fin si
Suivant
Fonction de fin
Rem ajoute des caractères au fichier
Sous-privé WriteStringToFile (nom de fichier, str)
En cas d'erreur, reprendre ensuite
Dim fs,ts
Définir fs= createobject("script_ing.filesystemobject")
Si ce n'est pas IsObject (fs), alors quittez Sub
Définir ts=fs.OpenTextFile(Server.MapPath(filename),8,True)
ts.writeline(str)
ts.fermer
Définir ts=Rien
Définir fs=Rien
Fin du sous-marin
'Fin du processus et de la méthode privés -------------------------------
'La méthode publique démarre----------------
''''''''''' Envoyer la partie XML pour démarrer
Rem remplir l'objet XmlDoc à partir d'un fichier XML externe
Sous-public LoadXmlFromFile (chemin)
XmlPath = Server.MapPath(chemin)
LoadXmlData()
End Sub
Rem remplit l'objet XmlDoc avec une chaîne
Sous-public LoadXmlFromString(str)
XmlDoc.LoadXml chaîne
End Sub
Rem Définir les paramètres du nœud tels que NodeValue "appID", AppID,1, False
'------------------------------------------------ -
'paramètre:
'NodeName nom du nœud
'Valeur NodeText
'Type de sauvegarde NodeType [text=0,cdata=1]
'blnEncode s'il faut encoder [true, false]
'------------------------------------------------ -
Sous-noeud public (Byval NodeName, Byval NodeText, Byval NodeType, Byval blnEncode)
Dim ChildNode,CréerCDATASection
Nom du nœud = Lcase (NodeName)
Si XmlDoc.documentElement.selectSingleNode(NodeName) n'est rien alors
Définir ChildNode = XmlDoc.documentElement.appendChild(XmlDoc.createNode(1,NodeName,""))
Autre
Définir ChildNode = XmlDoc.documentElement.selectSingleNode(NodeName)
Fin si
Si blnEncode = True Alors
NodeText = AnsiVersUnicode (NodeText)
Fin si
Si NodeType = 1 Alors
ChildNode.Text = ""
Définir CreateCDATASection = XmlDoc.createCDATASection(Replace(NodeText,"]]>","]]>"))
ChildNode.appendChild(createCDATASection)
Autre
ChildNode.Text = NodeText
Fin si
Fin du sous-marin
'------------------------------------------------ -
'Obtenir la valeur du nœud dans le paquet XML envoyé
'paramètre:
'Nom du nœud str
'------------------------------------------------ -
Propriété publique GetXmlNode(ByvalStr)
Si XmlDoc.documentElement.selectSingleNode(Str) n'est rien alors
XmlNode = "Nul"
Autre
XmlNode = XmlDoc.documentElement.selectSingleNode(Str).text
Fin si
Fin de la propriété
'----------------------------------------------- -- ---
'Obtenir l'objet de données XML renvoyé
'exemple:
'Lorsque GetXmlData n'est pas NULL, GetXmlData est un objet XML
'------------------------------------------------ -
Propriété publique Obtenir GetXmlData()
Définir GetXmlData = m_GetXmlDoc
Propriété de fin
'------------------------------------------------ -
'Envoyer le package XML à http://www.devdao.com/
'------------------------------------------------ -
Sous-public SendHttpData()
Dim je, GetXmlDoc, LoadAppid
Définir Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
Définir GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") ' Renvoyer le package XML
XmlHttp.Ouvrez "POST", m_url, false
XmlHttp.SetRequestHeader "type de contenu", "texte/xml"
XmlHttp.Envoyer XmlDoc
'Réponse.Write strAnsi2Unicode(xmlhttp.responseBody)
Si GetXmlDoc.load(XmlHttp.responseXML) Alors
Définir m_GetXmlDoc = GetXmlDoc
Autre
MessageCode = "Erreur lors de la demande de données !"
Quitter le sous-marin
Fin si
Définir GetXmlDoc = Rien
Définir XmlHttp = Rien
Fin du sous-marin
'------------------------------------------------ -
'Imprimer les données XML de la demande d'envoi
'------------------------------------------------ -
Sous-public PrintSendXmlData()
Réponse.Effacer
Réponse.ContentType = "texte/xml"
Réponse.CharSet = "gb2312"
Réponse.Expire = 0
Réponse.Écrivez "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Réponse.Write XmlDoc.documentElement.XML
Fin du sous-marin
'-------------------------------------------------------------- -- ---
'Imprimer les données XML renvoyées
'------------------------------------------------ -
Sous-public PrintGetXmlData()
Réponse.Effacer
Réponse.ContentType = "texte/xml"
Réponse.CharSet = "gb2312"
Réponse.Expire = 0
Si IsObject(m_GetXmlDoc) Alors
Réponse.Écrivez "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write m_GetXmlDoc.documentElement.XML
Autre
Réponse.Écrivez "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"
Fin si
Fin du sous-marin
Rem enregistre les données XML de la demande d'envoi dans un fichier nommé sendxml_date.txt
Sous-public SaveSendXmlDataToFile()
Dim nom de fichier, str
nom de fichier = "sendxml_" & DateValue (maintenant) & ".txt"
chaîne = ""
str = str & ""& Maintenant() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNouvelleLigne
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & XmlDoc.documentElement.XML & vbNewLine
str = str & "--------------------------------------------- --- "& vbNouvelleLigne
str = str & vbNouvelleLigne & vbNouvelleLigne & vbNouvelleLigne
WriteStringToFile nom de fichier, str
Fin du sous-marin
Rem enregistre les données XML renvoyées dans un fichier nommé getxml_date.txt
Sous-public SaveGetXmlDataToFile()
Dim nom de fichier, str
nom de fichier = "getxml_" & DateValue (maintenant) & ".txt"
chaîne = ""
str = str & ""& Maintenant() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNouvelleLigne
Si IsObject(m_GetXmlDoc) Alors
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & m_GetXmlDoc.documentElement.XML
Autre
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Fin si
str = str & vbNouvelleLigne
str = str & "--------------------------------------------- --- "& vbNouvelleLigne
str = str & vbNouvelleLigne & vbNouvelleLigne & vbNouvelleLigne
WriteStringToFile nom de fichier, str
Fin du sous-marin
'------------------------------------------------ -
'Obtenir les informations sur le nœud du fichier XML renvoyé
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Fonction publique GetSingleNode (nodestring)
Si IsObject(m_GetXmlDoc) Alors
GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).text
Autre
GetSingleNode = ""
Fin si
Fonction de fin
''''''''''''''''''Fin de l'envoi de la partie XML
'''''''''''''''''La partie XML de réception démarre
'------------------------------------------------ -
'Recevoir le package XML, les informations d'erreur sont obtenues via l'objet Message
'------------------------------------------------ -
Fonction publique AcceptHttpData()
Faible XMLdom
Définir XMLdom = Server.CreateObject("Microsoft.XMLDOM")
XMLdom.Async = Faux
XMLdom.Load (Demande)
Si XMLdom.parseError.errorCode <> 0 Alors
MessageCode = "Impossible de recevoir les données correctement" & "Descript_ion : " & XMLdom.parseError.reason & "<br>Line : " & XMLdom.parseError.Line
Définir m_XmlDocAccept = Null
Autre
Définir m_XmlDocAccept = XMLdom
Fin si
Fin de la fonction
'-------------------------------------------------------------- -- ---
'Revenir pour recevoir les informations sur le nœud du package XML
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Fonction publique AcceptSingleNode (nodestring)
Si IsObject(m_XmlDocAccept) Alors
AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).text
Autre
AcceptSingleNode = ""
Fin si
Fonction de fin
'------------------------------------------------ -
'Imprimer les données XML reçues par le destinataire
'------------------------------------------------ -
Sous-public PrintAcceptXmlData()
Réponse.Effacer
Réponse.ContentType = "texte/xml"
Réponse.CharSet = "gb2312"
Réponse.Expire = 0
Si IsObject(m_XmlDocAccept) Alors
Réponse.Écrivez "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write m_XmlDocAccept.documentElement.XML
Autre
Réponse.Écrivez "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"
Fin si
Fin du sous-marin
Rem enregistre les données du paquet XML reçu dans un fichier nommé acceptxml_date.txt
Sous-public SaveAcceptXmlDataToFile()
Dim nom de fichier, str
nom de fichier = "acceptxml_" & DateValue (maintenant) & ".txt"
chaîne = ""
str = str & ""& Maintenant() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNouvelleLigne
Si IsObject(m_XmlDocAccept) Alors
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & m_XmlDocAccept.documentElement.XML
Autre
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Fin si
str = str & vbNouvelleLigne
str = str & "--------------------------------------------- --- "& vbNouvelleLigne
str = str & vbNouvelleLigne & vbNouvelleLigne & vbNouvelleLigne
WriteStringToFile nom de fichier, str
End Sub
''''''''''''''''''Recevez la partie XML et terminez
Rem Enregistrez les données de débogage dans un fichier nommé debugnote_date.txt
Sous-public SaveDebugStringToFile (debugstr)
Dim nom de fichier, str
nom de fichier = "debugnote_" & DateValue (maintenant) & ".txt"
chaîne = ""
str = str & ""& Maintenant() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNouvelleLigne
str = str & debugstr & vbNewLine
str = str & "--------------------------------------------- ---"
str = str & vbNouvelleLigne & vbNouvelleLigne & vbNouvelleLigne
WriteStringToFile nom de fichier, str
End Sub
'Fin de la méthode publique-------------------------------
End Class
%>
Scénario de test :
sendxml.asp
<%
Option
Réponse explicite.buffer = True
Réponse.Expires=-1
%>
<!--#include file="xmlcls.asp"-->
<%
Const Apisysno = "23498927347234234987"
Const ActionURL = " http://www.shouji138.com/aspnet2/acceptxml.asp " Rem répond à l'adresse URL d'écriture du fichier
DimXmlClassObj
Définir XmlClassObj = new XmlClass 'Créer un objet
XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" encoding=""gb2312""?><root/>") 'Remplissez l'objet XMLDOC avec des caractères XML et utilisez-le pour envoyer du XML
XmlClassObj.URL = ActionURL 'Définir l'URL de la réponse
Format XML rem
Rem "<?xml version="1.0" encoding="gb2312"?>
Rem <racine>
Rem <sysno></sysno>
Rem <nom d'utilisateur></nom d'utilisateur>
Rem <pwd></pwd>
Rem <email></email>
Rem <pagename></pagename>
Rem <pageurl></pageurl>
Rem </root>
XmlClassObj.NodeValue "sysno",Apisysno,0,False
XmlClassObj.NodeValue "nom d'utilisateur", "nom d'utilisateur de test", 0, False
XmlClassObj.NodeValue "pwd", "pwd",0,False
XmlClassObj.NodeValue "email", " [email protected]",0,False
XmlClassObj.NodeValue "nom de la page", "site", 0, False
XmlClassObj.NodeValue "pageurl"," http://www.shouji138.com",1,False
)
'Enregistre le package de base de données XML envoyé dans un
fichier txt .PrintGetXmlData() 'Imprime les données XML reçues
'response.write XmlClassObj.Message 'Imprimer le message d'erreur
XmlClassObj.SaveGetXmlDataToFile() 'Enregistre la base de données XML reçue dans un fichier txt
réponse.write XmlClassObj.GetSingleNode("//message") 'Afficher la valeur du nœud msg des données XML reçues
Set XmlClassObj = Nothing 'Détruire l'instance d'objet
%>
acceptxml.asp
<%
Interface d'enregistrement des utilisateurs de Rem Api
%>
<%
Réponse.Expire= -1
Response.Addheader "pragma", "no-cache"
Response.AddHeader "contrôle de cache", "pas de magasin"
%>
<!--#Include File="xmlcls.asp"-->
<%
Format XML rem
Rem "<?xml version="1.0" encoding="gb2312"?>
Rem <racine>
Rem <sysno></sysno>
Rem <nom d'utilisateur></nom d'utilisateur>
Rem <pwd></pwd>
Rem <email></email>
Rem <pagename></pagename>
Rem <pageurl></pageurl>
Rem </root>
Const Apisysno = "23498927347234234987"
En cas d'erreur, reprendre ensuite
DimXmlClassObj
Définir XmlClassObj = new XmlClass 'Créer un objet
XmlClassObj.AcceptHttpData() 'Recevoir des données XML
XmlClassObj.SaveAcceptXmlDataToFile() 'Enregistrez les données XML reçues dans un fichier txt
Err.clear
Message obscur
Dim sysno, nom d'utilisateur, mot de passe, email, PageName, PageURL
sysno = XmlClassObj.AcceptSingleNode("//sysno")
nom d'utilisateur = XmlClassObj.AcceptSingleNode("//nom d'utilisateur")
mot de passe = XmlClassObj.AcceptSingleNode("//mot de passe")
email = XmlClassObj.AcceptSingleNode("//email")
Nom de la page = XmlClassObj.AcceptSingleNode("//nom de la page")
PageURL = XmlClassObj.AcceptSingleNode("//pageurl")
XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) 'Enregistrer dans le fichier journal de débogage
Si erreur alors
message = message & Err.Descript_ion
Autre
Err.clear
Si sysno <> Apisysno Alors
message = "Veuillez ne pas l'utiliser illégalement !"
Autre
message = regUser (nom d'utilisateur, mot de passe, email, PageName, PageURL)
Fin si
Fin si
'XmlClassObj.SaveDebugStringToFile("message=" & message) 'Enregistrer la valeur du message dans le fichier journal de débogage
Set XmlClassObj = Nothing 'Détruire l'instance d'objet
Response.ContentType = "text/xml" 'Envoyer le flux de données XML à l'expéditeur
Réponse.Charset = "gb2312"
Réponse.Effacer
Réponse.Écrivez "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline
Réponse.Écrivez "<root>" et vbnewline
Réponse.Écrivez "<message>" & message & "</message>" & vbnewline
Response.Write "<nowtime>" & Now() & "</nowtime>" & vbnewline
Response.Write "</root>" et
fonction vbnewline regUser (nom d'utilisateur, mot de passe, email, PageName, PageURL)
''''''''''''''''
'''''''''''''''
'''''''''''''''
'Exploiter les utilisateurs enregistrés dans la base de données
'''''''''''''''
'''''''''''''
regUser = "OK"
Fin de la fonction
%>
Adresse de téléchargement :/u/info_img/2009-06/25/Xmlcls.rarAdresse
de démonstration :http://www.shouji138.com/aspnet2/sendxml.asp