Esta classe asp pode ser usada para lidar com o envio e recebimento de pacotes XML. Pode ser usado para comunicação entre interfaces API entre vários sistemas heterogêneos e para processar a invocação e recepção de Web Services.
propriedade:
string
do endereço de recebimentopara enviar xml
Escrever apenas
mensagem: mensagem de erro do sistema
Corda
somente leitura
: obtém o valor do nó no pacote XML enviado
Corda
Parâmetros somente leitura: Str: nome do nó
GetXmlData: obtém o objeto de dados XML retornado
XMLDom
somente leitura
Método:
LoadXmlFromFile: Preencha o parâmetro do objeto XmlDoc Caminho: caminho xml de um arquivo xml externo
Void
LoadXmlFromString: preencha o parâmetro do objeto XmlDoc Str:xml string com uma string
Vazio
NodeValue define os parâmetros do nó
Parâmetro
NodeName Nome do nó
NodeText Valor
NodeType Tipo de salvamento [text=0,cdata=1]
blnEncode Se codificar [true, false]
Vazio
SendHttpData: Enviar pacote xml
PrintSendXmlData: Imprimir dados XML de solicitação de envio
PrintGetXmlData: Imprimir dados XML de retorno
SaveSendXmlDataToFile: Salvar dados XML de solicitação de envio em um arquivo, o nome do arquivo é sendxml_date.txt
SaveGetXmlDataToFile: salva os dados XML retornados em um arquivo, o nome do arquivo é getxml_date.txt
GetSingleNode: obtém o parâmetro de informações do nó Nodestring do xml retornado: nome do nó
AcceptHttpData: recebe o pacote XML, as informações de erro são obtidas por meio do objeto Message
AcceptSingleNode: Return as informações do nó do pacote XML recebido Parâmetro Nodestring: nome do nó
PrintAcceptXmlData: imprime os dados XML recebidos pela extremidade receptora
SaveAcceptXmlDataToFile: salva os dados do pacote XML recebido em um arquivo, o nome do arquivo é acceptxml_date.txt
SaveDebugStringToFile: salve os dados de depuração em um arquivo chamado debugnote_date.txt
Parâmetro Debugstr: informações de depuração
Código:
xmlcls.asp
<%
Rem lida com envio e recebimento de classes de dados XML
'------------------------------------------------ -
'Por favor, guarde as informações de direitos autorais ao reimprimir
'Autor: walkman
'Empresa: Bubuweiying Technology Co., Ltd.
'Site: http://www.shouji138.com
'Versão: ver1.0
'------------------------------------------------ -
de classe XmlClass
Rem
XmlDoc privado,XmlHttp
Código de mensagem privada, SysKey, XmlPath
Privado m_GetXmlDoc,m_url
Inicialização
privada m_XmlDocAccept
Rem
Subclasse Privada_Initialize()
Em caso de erro, retomar o próximo
CódigoMensagem = ""
XmlPath = ""
Definir XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
XmlDoc.ASYNC = Falso
End Sub
Rem destrói o objeto
Subclasse Privada_Terminate()
Se IsObject (XmlDoc) então defina XmlDoc = Nada
Se IsObject (m_XmlDocAccept) então defina m_XmlDocAccept = Nada
Se IsObject (m_GetXmlDoc) então defina m_GetXmlDoc = Nada
Finalizar sub
'A definição do atributo público começa--------------------------
Mensagem de erro Rem
Propriedade pública obter mensagem()
Mensagem = CódigodaMensagem
Fim da propriedade
Rem o endereço para enviar xml
Propriedade pública Deixe URL (str)
m_url=str
Fim da propriedade
'Fim da definição do atributo público--------------------------
'Início de processo e método privado--------------------------
Rem carregar xml
Sub LoadXmlData privado()
Se XmlPath <> "" Então
Se não for XmlDoc.Load (XmlPath) então
XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>"
Terminar se
Outro
XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>"
Terminar se
Fim da conversão de caracteres Sub
Rem
Função privada AnsiToUnicode (ByVal str)
Dim i, j, c, i1, i2, u, fs, f, p
AnsiToUnicode = ""
p = ""
Para i = 1 para Len(str)
c = Médio (str, i, 1)
j = AscW(c)
Se j < 0 Então
j = j + 65536
Terminar se
Se j >= 0 E j <= 128 Então
Se p = "c" Então
AnsiToUnicode = " " & AnsiToUnicode
p = "e"
Terminar se
AnsiToUnicode = AnsiToUnicode & c
Outro
Se p = "e" Então
AnsiToUnicode = AnsiToUnicode & " "
p = "c"
Terminar se
AnsiToUnicode = AnsiToUnicode & ("&#" & j & ";")
Terminar se
Próximo
Conversão de caracteres
End Function
Rem
Função privada strAnsi2Unicode(asContents)
Dim len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(asConteúdo)
Se len1 = 0, então saia da função
Para i=1 para len1
varchar=MidB(asContents,i,1)
varasc=AscB(varchar)
Se varasc > 127 Então
Se MidB(asContents,i+1,1)<>"" Então
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
Terminar se
eu=eu+1
Outro
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
Terminar se
Próximo
Função final
Rem acrescenta caracteres ao arquivo
Sub privado WriteStringToFile (nome do arquivo, str)
Em caso de erro, retomar o próximo
Dim fs,ts
Definir fs= createobject("script_ing.filesystemobject")
Se não for IsObject(fs), então saia do Sub
Definir ts=fs.OpenTextFile(Server.MapPath(nome do arquivo),8,True)
ts.writeline(str)
ts.fechar
Definir ts=Nada
Definir fs=Nada
Finalizar sub
'Fim do processo e método privado--------------------------
'O método público inicia--------------------------
''''''''''' Envie a parte xml para começar
Rem preencher o objeto XmlDoc do arquivo xml externo
Sub LoadXmlFromFile público (caminho)
XmlPath = Servidor.MapPath(caminho)
CarregarXmlData()
End Sub
Rem preenche o objeto XmlDoc com uma string
Sub LoadXmlFromString público (str)
XmlDoc.LoadXmlstr
End Sub
Rem Defina parâmetros de nó como NodeValue "appID",AppID,1,False
'------------------------------------------------ -
'parâmetro:
'NodeName nome do nó
'Valor NodeText
'Tipo de salvamento NodeType [text=0,cdata=1]
'blnEncode se deve codificar [true, false]
'------------------------------------------------ -
Sub NodeValue público (Byval NodeName, Byval NodeText, Byval NodeType, Byval blnEncode)
Dim ChildNode,CreateCDATASection
NodeName = Lcase(NodeName)
Se XmlDoc.documentElement.selectSingleNode(NodeName) não for nada, então
Definir ChildNode = XmlDoc.documentElement.appendChild(XmlDoc.createNode(1,NodeName,""))
Outro
Definir ChildNode = XmlDoc.documentElement.selectSingleNode(NodeName)
Terminar se
Se blnEncode = True então
NodeText = AnsiToUnicode(NodeText)
Terminar se
Se NodeType = 1 então
ChildNode.Text = ""
Definir CreateCDATASection = XmlDoc.createCDATASection(Replace(NodeText,"]]>","]]>"))
ChildNode.appendChild(criarCDATASection)
Outro
ChildNode.Text = NodeText
Terminar se
Finalizar sub
'------------------------------------------------ -
'Obtém o valor do nó no pacote XML enviado
'parâmetro:
'Str nome do nó
'------------------------------------------------ -
Propriedade pública GetXmlNode(ByvalStr)
Se XmlDoc.documentElement.selectSingleNode(Str) for nada, então
XmlNode = "Nulo"
Outro
XmlNode = XmlDoc.documentElement.selectSingleNode(Str).texto
Terminar se
Propriedade final
'---------------------------------------------------------- ----
'Obtém o objeto de dados XML retornado
'exemplo:
'Quando GetXmlData não é NULL, GetXmlData é um objeto XML
'------------------------------------------------ -
Propriedade Pública Obter GetXmlData()
Definir GetXmlData = m_GetXmlDoc
Fim da propriedade
'------------------------------------------------ -
'Enviar pacote xml para http://www.devdao.com/
'------------------------------------------------ -
Sub público SendHttpData()
Dim i,GetXmlDoc,LoadAppid
Definir Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
Set GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") 'Retorna pacote xml
XmlHttp.Open "POST", m_url, falso
XmlHttp.SetRequestHeader "tipo de conteúdo", "texto/xml"
XmlHttp.Enviar XmlDoc
'Response.Write strAnsi2Unicode(xmlhttp.responseBody)
Se GetXmlDoc.load(XmlHttp.responseXML) Então
Definir m_GetXmlDoc = GetXmlDoc
Outro
MessageCode = "Erro ao solicitar dados!"
Sair do sub
Terminar se
Definir GetXmlDoc = Nada
Definir XmlHttp = Nada
Finalizar sub
'------------------------------------------------ -
'Imprime dados XML da solicitação de envio
'------------------------------------------------ -
Sub PrintSendXmlData() público
Resposta.Limpar
Response.ContentType = "texto/xml"
Response.CharSet = "gb2312"
Resposta.Expira = 0
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write XmlDoc.documentElement.XML
Fim Sub
'---------------------------------------------------------- ----
'Imprime dados XML retornados
'------------------------------------------------ -
Sub PrintGetXmlData() público
Resposta.Limpar
Response.ContentType = "texto/xml"
Response.CharSet = "gb2312"
Resposta.Expira = 0
Se IsObject(m_GetXmlDoc) então
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write m_GetXmlDoc.documentElement.XML
Outro
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"
Terminar se
Finalizar sub
Rem salva os dados xml da solicitação de envio em um arquivo chamado sendxml_date.txt
Sub SaveSendXmlDataToFile() público
Dim nome do arquivo, str
nome do arquivo = "sendxml_" & DateValue (agora) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str& "--------------------------------------------- --- "& vbNovaLinha
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & XmlDoc.documentElement.XML & vbNewLine
str = str& "--------------------------------------------- --- "& vbNovaLinha
str = str & vbNovaLinha & vbNovaLinha & vbNovaLinha
Nome do arquivo WriteStringToFile,str
Finalizar sub
Rem salva os dados XML retornados em um arquivo chamado getxml_date.txt
Sub SaveGetXmlDataToFile() público
Dim nome do arquivo, str
nome do arquivo = "getxml_" & DateValue (agora) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str& "--------------------------------------------- --- "& vbNovaLinha
Se IsObject(m_GetXmlDoc) então
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & m_GetXmlDoc.documentElement.XML
Outro
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Terminar se
str = str & vbNovaLinha
str = str& "--------------------------------------------- --- "& vbNovaLinha
str = str & vbNovaLinha & vbNovaLinha & vbNovaLinha
Nome do arquivo WriteStringToFile,str
Finalizar sub
'------------------------------------------------ -
'Obtém as informações do nó do xml retornado
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Função pública GetSingleNode(nodestring)
Se IsObject(m_GetXmlDoc) então
GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).text
Outro
GetSingleNode = ""
Terminar se
Função final
'''''''''''''''''Fim do envio da parte xml
'''''''''''''''''A parte de recebimento do xml começa
'------------------------------------------------ -
'Recebe pacote XML, informações de erro são obtidas através do objeto Message
'------------------------------------------------ -
Função pública AcceptHttpData()
Dim XMLdom
Definir XMLdom = Server.CreateObject("Microsoft.XMLDOM")
XMLdom.Async = Falso
XMLdom.Load(Solicitação)
Se XMLdom.parseError.errorCode <> 0 Então
MessageCode = "Não é possível receber dados corretamente" & "Descript_ion: " & XMLdom.parseError.reason & "<br>Line: " & XMLdom.parseError.Line
Definir m_XmlDocAccept = Nulo
Outro
Definir m_XmlDocAccept = XMLdom
Terminar se
Função final
'---------------------------------------------------------- ----
'Retorna para receber informações do nó do pacote XML
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Função pública AcceptSingleNode(nodestring)
Se IsObject(m_XmlDocAccept) então
AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).text
Outro
AceitarSingleNode = ""
Terminar se
Função final
'------------------------------------------------ -
'Imprime os dados XML recebidos pelo destinatário
'------------------------------------------------ -
Sub PrintAcceptXmlData() público
Resposta.Limpar
Response.ContentType = "texto/xml"
Response.CharSet = "gb2312"
Resposta.Expira = 0
Se IsObject(m_XmlDocAccept) então
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write m_XmlDocAccept.documentElement.XML
Outro
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"
Terminar se
Finalizar sub
Rem salva os dados do pacote XML recebido em um arquivo chamado acceptxml_date.txt
Sub SaveAcceptXmlDataToFile() público
Dim nome do arquivo, str
nome do arquivo = "acceptxml_" & DateValue (agora) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str& "--------------------------------------------- --- "& vbNovaLinha
Se IsObject(m_XmlDocAccept) então
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & m_XmlDocAccept.documentElement.XML
Outro
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Terminar se
str = str & vbNovaLinha
str = str& "--------------------------------------------- --- "& vbNovaLinha
str = str & vbNovaLinha & vbNovaLinha & vbNovaLinha
Nome do arquivo WriteStringToFile,str
End Sub
'''''''''''''''''Receba a parte xml e finalize
Rem Salve os dados de depuração em um arquivo chamado debugnote_date.txt
Sub público SaveDebugStringToFile(debugstr)
Dim nome do arquivo, str
nome do arquivo = "debugnote_" & DateValue (agora) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str& "--------------------------------------------- --- "& vbNovaLinha
str = str & debugstr & vbNewLine
str = str& "--------------------------------------------- --- "
str = str & vbNovaLinha & vbNovaLinha & vbNovaLinha
Nome do arquivo WriteStringToFile,str
End Sub
'Fim do método público--------------------------
End Class
%>
Caso de teste:
sendxml.asp
<%
Opção
Response.buffer explícito = True
Resposta.Expires=-1
%>
<!--#include file="xmlcls.asp"-->
<%
Const Apisysno = "23498927347234234987"
Const ActionURL = " http://www.shouji138.com/aspnet2/acceptxml.asp " Rem responde ao arquivo escrevendo o endereço URL
DimXmlClassObj
Set XmlClassObj = new XmlClass 'Criar objeto
XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" encoding=""gb2312""?><root/>") 'Preencha o objeto XMLDOC com caracteres xml e use-o para enviar xml
XmlClassObj.URL = ActionURL 'Definir o URL de resposta
Formato Rem XML
Rem "<?xml version="1.0" encoding="gb2312"?>
Rem <raiz>
Rem <sysno></sysno>
Rem <nomedeusuário></nomedeusuário>
Rem <pwd></pwd>
Rem <e-mail></e-mail>
Rem <nome da página></nome da página>
Rem <pageurl></pageurl>
Rem </root>
XmlClassObj.NodeValue "sysno",Apisysno,0,Falso
XmlClassObj.NodeValue "nomedeusuário","nomedeusuárioteste",0,Falso
XmlClassObj.NodeValue "pwd","pwd",0,Falso
XmlClassObj.NodeValue "email"," [email protected]",0,False
XmlClassObj.NodeValue "nome da página","site",0,Falso
XmlClassObj.NodeValue "pageurl"," http://www.shouji138.com",1,False
)
'Salva o pacote de banco de dados xml enviado em um
arquivo txt .PrintGetXmlData() 'Imprime os dados xml recebidos
'response.write XmlClassObj.Message 'Imprime mensagem de erro
XmlClassObj.SaveGetXmlDataToFile() 'Salva o banco de dados xml recebido em um arquivo txt
response.write XmlClassObj.GetSingleNode("//message") 'Exibe o valor do nó msg dos dados xml recebidos
Set XmlClassObj = Nothing 'Destruir instância do objeto
%>
aceitarxml.asp
<%
Interface de registro de usuário Rem API
%>
<%
Resposta.Expires= -1
Response.Addheader "pragma","sem cache"
Response.AddHeader "controle de cache","sem armazenamento"
%>
<!--#Incluir arquivo="xmlcls.asp"-->
<%
Formato Rem XML
Rem "<?xml version="1.0" encoding="gb2312"?>
Rem <raiz>
Rem <sysno></sysno>
Rem <nomedeusuário></nomedeusuário>
Rem <pwd></pwd>
Rem <e-mail></e-mail>
Rem <nome da página></nome da página>
Rem <pageurl></pageurl>
Rem </root>
Const Apisysno = "23498927347234234987"
Em caso de erro, retomar o próximo
DimXmlClassObj
Set XmlClassObj = new XmlClass 'Criar objeto
XmlClassObj.AcceptHttpData() 'Recebe dados xml
XmlClassObj.SaveAcceptXmlDataToFile() 'Salva os dados xml recebidos em um arquivo txt
Err.claro
Mensagem escura
Dim sysno,nome de usuário,pwd,e-mail,PageName,PageURL
sysno = XmlClassObj.AcceptSingleNode("//sysno")
nome de usuário = XmlClassObj.AcceptSingleNode("//nome de usuário")
pwd = XmlClassObj.AcceptSingleNode("//pwd")
email = XmlClassObj.AcceptSingleNode("//email")
PageName = XmlClassObj.AcceptSingleNode("//nome da página")
PageURL = XmlClassObj.AcceptSingleNode("//pageurl")
XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) 'Salvar no arquivo de log de depuração
Se errar então
mensagem = mensagem & Err.Descript_ion
Outro
Err.claro
Se sysno <> Apisysno Então
mensagem = "Por favor, não use ilegalmente!"
Outro
mensagem = regUser(nome de usuário, senha, email, nome da página, URL da página)
Terminar se
Terminar se
'XmlClassObj.SaveDebugStringToFile("message=" & message) 'Salve o valor da mensagem no arquivo de log de depuração
Set XmlClassObj = Nothing 'Destrua a instância do objeto
Response.ContentType = "text/xml" 'Envie o fluxo de dados xml para o remetente
Response.Charset = "gb2312"
Resposta.Limpar
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline
Response.Write "<root>" & vbnewline
Response.Write "<message>" & mensagem & "</message>" & vbnewline
Response.Write "<nowtime>" & Now() & "</nowtime>" & vbnewline
Response.Write "</root>" e
função vbnewline regUser (nome de usuário, senha, email, nome da página, URL da página)
''''''''''''''''
'''''''''''''''
'''''''''''''''
'Operar usuários registrados no banco de dados
'''''''''''''''
'''''''''''''
regUser = "OK"
Finalizar função
%>
Endereço de download:/u/info_img/2009-06/25/Xmlcls.rarEndereço
de demonstração:http://www.shouji138.com/aspnet2/sendxml.asp