This asp class can be used to handle the sending and receiving of xml packages. It can be used for communication between API interfaces between various heterogeneous systems, and for processing the invocation and reception of Web Services.
property:
String
for sending xml
Write only
Message: system error message
String
Read-only
XmlNode: Get the value of the node in the sent package XML
String
Read-only parameters: Str: node name
GetXmlData: Get the returned XML data object
XMLDom
read only
Method:
LoadXmlFromFile: Fill the XmlDoc object parameter Path:xml path from an external xml file
Void
LoadXmlFromString: Fill the XmlDoc object parameter Str:xml string with a string
Void
NodeValue sets the parameters of node
Parameter
NodeName Node name
NodeText Value
NodeType Save type [text=0,cdata=1]
blnEncode Whether to encode [true, false]
Void
SendHttpData: Send xml package
PrintSendXmlData: Print send request XML data
PrintGetXmlData: Print return XML data
SaveSendXmlDataToFile: Save send request xml data to a file, the file name is sendxml_date.txt
SaveGetXmlDataToFile: Save the returned XML data to a file, the file name is getxml_date.txt
GetSingleNode: Get the node information parameter Nodestring of the returned xml: node name
AcceptHttpData: Receive XML package, error information is obtained through the Message object
AcceptSingleNode: Return the received XML package node information Parameter Nodestring: node name
PrintAcceptXmlData: print the XML data received by the receiving end
SaveAcceptXmlDataToFile: save the received XML packet data to a file, the file name is acceptxml_date.txt
SaveDebugStringToFile: Save debugging data to a file named debugnote_date.txt
Parameter Debugstr: debugging information
Code:
xmlcls.asp
<%
Rem handles sending and receiving classes of xml data
'------------------------------------------------ -
'Please retain the copyright information when reprinting
'Author: walkman
'Company: Bubuweiying Technology Co., Ltd.
'Website: http://www.shouji138.com
'Version: ver1.0
'------------------------------------------------ -
Class XmlClass
Rem variable definition
Private XmlDoc,XmlHttp
Private MessageCode,SysKey,XmlPath
Private m_GetXmlDoc,m_url
Private m_XmlDocAccept
Rem initialization
Private Sub Class_Initialize()
On Error Resume Next
MessageCode = ""
XmlPath = ""
Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
XmlDoc.ASYNC = False
End Sub
Rem destroys the object
Private Sub Class_Terminate()
If IsObject(XmlDoc) Then Set XmlDoc = Nothing
If IsObject(m_XmlDocAccept) Then Set m_XmlDocAccept = Nothing
If IsObject(m_GetXmlDoc) Then Set m_GetXmlDoc = Nothing
End Sub
'Public attribute definition starts--------------------------
Rem error message
Public Property Get Message()
Message = MessageCode
End Property
Rem the address to send xml to
Public Property Let URL(str)
m_url = str
End Property
'End of public attribute definition--------------------------
'Private process and method start--------------------------
Rem load xml
Private Sub LoadXmlData()
If XmlPath <> "" Then
If Not XmlDoc.Load(XmlPath) Then
XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>"
End If
Else
XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>"
End If
End Sub
Rem character conversion
Private Function AnsiToUnicode(ByVal str)
Dim i, j, c, i1, i2, u, fs, f, p
AnsiToUnicode = ""
p = ""
For i = 1 To Len(str)
c = Mid(str, i, 1)
j = AscW(c)
If j < 0 Then
j = j + 65536
End If
If j >= 0 And j <= 128 Then
If p = "c" Then
AnsiToUnicode = " " & AnsiToUnicode
p = "e"
End If
AnsiToUnicode = AnsiToUnicode & c
Else
If p = "e" Then
AnsiToUnicode = AnsiToUnicode & " "
p = "c"
End If
AnsiToUnicode = AnsiToUnicode & ("&#" & j & ";")
End If
Next
End Function
Rem character conversion
Private Function strAnsi2Unicode(asContents)
Dim len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(asContents)
If len1=0 Then Exit Function
For i=1 to len1
varchar=MidB(asContents,i,1)
varasc=AscB(varchar)
If varasc > 127 Then
If MidB(asContents,i+1,1)<>"" Then
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
End If
i=i+1
Else
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
End If
Next
End Function
Rem appends characters to the file
Private Sub WriteStringToFile(filename,str)
On Error Resume Next
Dim fs,ts
Set fs= createobject("script_ing.filesystemobject")
If Not IsObject(fs) Then Exit Sub
Set ts=fs.OpenTextFile(Server.MapPath(filename),8,True)
ts.writeline(str)
ts.close
Set ts=Nothing
Set fs=Nothing
End Sub
'Private process and method end--------------------------
'Public method starts--------------------------
''''''''''' Send the xml part to start
Rem populate XmlDoc object from external xml file
Public Sub LoadXmlFromFile(path)
XmlPath = Server.MapPath(path)
LoadXmlData()
End Sub
Rem fills the XmlDoc object with a string
Public Sub LoadXmlFromString(str)
XmlDoc.LoadXml str
End Sub
Rem Set node parameters such as NodeValue "appID",AppID,1,False
'------------------------------------------------ -
'parameter:
'NodeName node name
'NodeText value
'NodeType save type [text=0,cdata=1]
'blnEncode whether to encode [true, false]
'------------------------------------------------ -
Public Sub NodeValue(Byval NodeName,Byval NodeText,Byval NodeType,Byval blnEncode)
Dim ChildNode,CreateCDATASection
NodeName = Lcase(NodeName)
If XmlDoc.documentElement.selectSingleNode(NodeName) is nothing Then
Set ChildNode = XmlDoc.documentElement.appendChild(XmlDoc.createNode(1,NodeName,""))
Else
Set ChildNode = XmlDoc.documentElement.selectSingleNode(NodeName)
End If
If blnEncode = True Then
NodeText = AnsiToUnicode(NodeText)
End If
If NodeType = 1 Then
ChildNode.Text = ""
Set CreateCDATASection = XmlDoc.createCDATASection(Replace(NodeText,"]]>","]]>"))
ChildNode.appendChild(createCDATASection)
Else
ChildNode.Text = NodeText
End If
End Sub
'------------------------------------------------ -
'Get the value of the node in the sent packet XML
'parameter:
'Str node name
'------------------------------------------------ -
Public Property GetXmlNode(Byval Str)
If XmlDoc.documentElement.selectSingleNode(Str) is Nothing Then
XmlNode = "Null"
Else
XmlNode = XmlDoc.documentElement.selectSingleNode(Str).text
End If
End Property
'------------------------------------------------- ---
'Get the returned XML data object
'example:
'When GetXmlData is not NULL, GetXmlData is an XML object
'------------------------------------------------ -
Public Property Get GetXmlData()
Set GetXmlData = m_GetXmlDoc
End Property
'------------------------------------------------ -
'Send xml package to http://www.devdao.com/
'------------------------------------------------ -
Public Sub SendHttpData()
Dim i,GetXmlDoc,LoadAppid
Set Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
Set GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") ' Return xml package
XmlHttp.Open "POST", m_url, false
XmlHttp.SetRequestHeader "content-type", "text/xml"
XmlHttp.Send XmlDoc
'Response.Write strAnsi2Unicode(xmlhttp.responseBody)
If GetXmlDoc.load(XmlHttp.responseXML) Then
Set m_GetXmlDoc = GetXmlDoc
Else
MessageCode = "Error in requesting data!"
Exit Sub
End If
Set GetXmlDoc = Nothing
Set XmlHttp = Nothing
End Sub
'------------------------------------------------ -
'Print send request XML data
'------------------------------------------------ -
Public Sub PrintSendXmlData()
Response.Clear
Response.ContentType = "text/xml"
Response.CharSet = "gb2312"
Response.Expires = 0
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write XmlDoc.documentElement.XML
End Sub
'------------------------------------------------- ---
'Print returned XML data
'------------------------------------------------ -
Public Sub PrintGetXmlData()
Response.Clear
Response.ContentType = "text/xml"
Response.CharSet = "gb2312"
Response.Expires = 0
If IsObject(m_GetXmlDoc) Then
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write m_GetXmlDoc.documentElement.XML
Else
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"
End If
End Sub
Rem saves the send request xml data to a file named sendxml_date.txt
Public Sub SaveSendXmlDataToFile()
Dim filename,str
filename = "sendxml_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "------------------------------------------------ "& vbNewLine
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & XmlDoc.documentElement.XML & vbNewLine
str = str & "------------------------------------------------ "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub
Rem saves the returned XML data to a file named getxml_date.txt
Public Sub SaveGetXmlDataToFile()
Dim filename,str
filename = "getxml_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "------------------------------------------------ "& vbNewLine
If IsObject(m_GetXmlDoc) Then
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & m_GetXmlDoc.documentElement.XML
Else
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
End If
str = str & vbNewLine
str = str & "------------------------------------------------ "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub
'------------------------------------------------ -
'Get the node information of the returned xml
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Public Function GetSingleNode(nodestring)
If IsObject(m_GetXmlDoc) Then
GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).text
Else
GetSingleNode = ""
End If
End Function
''''''''''''''''''End of sending xml part
''''''''''''''''''The receiving xml part starts
'------------------------------------------------ -
'Receive XML package, error information is obtained through Message object
'------------------------------------------------ -
Public Function AcceptHttpData()
Dim XMLdom
Set XMLdom = Server.CreateObject("Microsoft.XMLDOM")
XMLdom.Async = False
XMLdom.Load(Request)
If XMLdom.parseError.errorCode <> 0 Then
MessageCode = "Unable to receive data correctly" & "Descript_ion: " & XMLdom.parseError.reason & "<br>Line: " & XMLdom.parseError.Line
Set m_XmlDocAccept = Null
Else
Set m_XmlDocAccept = XMLdom
End If
End Function
'------------------------------------------------- ---
'Return to receive XML package node information
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Public Function AcceptSingleNode(nodestring)
If IsObject(m_XmlDocAccept) Then
AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).text
Else
AcceptSingleNode = ""
End If
End Function
'------------------------------------------------ -
'Print the XML data received by the receiving end
'------------------------------------------------ -
Public Sub PrintAcceptXmlData()
Response.Clear
Response.ContentType = "text/xml"
Response.CharSet = "gb2312"
Response.Expires = 0
If IsObject(m_XmlDocAccept) Then
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write m_XmlDocAccept.documentElement.XML
Else
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"
End If
End Sub
Rem saves the received XML packet data to a file named acceptxml_date.txt
Public Sub SaveAcceptXmlDataToFile()
Dim filename,str
filename = "acceptxml_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "------------------------------------------------ "& vbNewLine
If IsObject(m_XmlDocAccept) Then
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
str = str & m_XmlDocAccept.documentElement.XML
Else
str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
End If
str = str & vbNewLine
str = str & "------------------------------------------------ "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub
''''''''''''''''''Receive the xml part and end
Rem Save the debugging data to a file named debugnote_date.txt
Public Sub SaveDebugStringToFile(debugstr)
Dim filename,str
filename = "debugnote_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "------------------------------------------------ "& vbNewLine
str = str & debugstr & vbNewLine
str = str & "------------------------------------------------ "
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub
'End of public method--------------------------
End Class
%>
Test case:
sendxml.asp
<%
Option Explicit
Response.buffer = True
Response.Expires=-1
%>
<!--#include file="xmlcls.asp"-->
<%
Const Apisysno = "23498927347234234987"
Const ActionURL = " http://www.shouji138.com/aspnet2/acceptxml.asp " Rem responds to the file writing URL address
DimXmlClassObj
Set XmlClassObj = new XmlClass 'Create object
XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" encoding=""gb2312""?><root/>") 'Fill the XMLDOC object with xml characters and use it to send xml
XmlClassObj.URL = ActionURL 'Set the response url
Rem xml format
Rem "<?xml version="1.0" encoding="gb2312"?>
Rem <root>
Rem <sysno></sysno>
Rem <username></username>
Rem <pwd></pwd>
Rem <email></email>
Rem <pagename></pagename>
Rem <pageurl></pageurl>
Rem </root>
XmlClassObj.NodeValue "sysno",Apisysno,0,False
XmlClassObj.NodeValue "username","testusername",0,False
XmlClassObj.NodeValue "pwd","pwd",0,False
XmlClassObj.NodeValue "email"," [email protected]",0,False
XmlClassObj.NodeValue "pagename","site",0,False
XmlClassObj.NodeValue "pageurl"," http://www.shouji138.com",1,False
)
'Save the sent xml database package into a txt
file .PrintGetXmlData() 'Print the received xml data
'response.write XmlClassObj.Message 'Print error message
XmlClassObj.SaveGetXmlDataToFile() 'Save the received xml database into a txt file
response.write XmlClassObj.GetSingleNode("//message") 'Display the value of the msg node of the received xml data
Set XmlClassObj = Nothing 'Destroy object instance
%>
acceptxml.asp
<%
Rem Api user registration interface
%>
<%
Response.Expires= -1
Response.Addheader "pragma","no-cache"
Response.AddHeader "cache-control","no-store"
%>
<!--#Include File="xmlcls.asp"-->
<%
Rem xml format
Rem "<?xml version="1.0" encoding="gb2312"?>
Rem <root>
Rem <sysno></sysno>
Rem <username></username>
Rem <pwd></pwd>
Rem <email></email>
Rem <pagename></pagename>
Rem <pageurl></pageurl>
Rem </root>
Const Apisysno = "23498927347234234987"
On Error Resume Next
DimXmlClassObj
Set XmlClassObj = new XmlClass 'Create object
XmlClassObj.AcceptHttpData() 'Receive xml data
XmlClassObj.SaveAcceptXmlDataToFile() 'Save the received xml data into a txt file
Err.clear
Dim message
Dim sysno,username,pwd,email,PageName,PageURL
sysno = XmlClassObj.AcceptSingleNode("//sysno")
username = XmlClassObj.AcceptSingleNode("//username")
pwd = XmlClassObj.AcceptSingleNode("//pwd")
email = XmlClassObj.AcceptSingleNode("//email")
PageName = XmlClassObj.AcceptSingleNode("//pagename")
PageURL = XmlClassObj.AcceptSingleNode("//pageurl")
XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) 'Save to debug log file
If Err Then
message = message & Err.Descript_ion
Else
Err.clear
If sysno <> Apisysno Then
message = "Please do not use it illegally!"
Else
message = regUser(username,pwd,email,PageName,PageURL)
End If
End If
'XmlClassObj.SaveDebugStringToFile("message=" & message) 'Save the message value into the debug log file
Set XmlClassObj = Nothing 'Destroy the object instance
Response.ContentType = "text/xml" 'Output the xml data stream to the sender
Response.Charset = "gb2312"
Response.Clear
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline
Response.Write "<root>" & vbnewline
Response.Write "<message>" & message & "</message>" & vbnewline
Response.Write "<nowtime>" & Now() & "</nowtime>" & vbnewline
Response.Write "</root>" & vbnewline
Function regUser(username,pwd,email,PageName,PageURL)
'''''''''''''''''
''''''''''''''''
''''''''''''''''
'Operate database registered users
''''''''''''''''
''''''''''''''
regUser = "OK"
End Function
%>
Download address:/u/info_img/2009-06/25/Xmlcls.rarDemo
address:http://www.shouji138.com/aspnet2/sendxml.asp