本asp類(lèi)可以用來(lái)處理xml包的發(fā)送與接收。可用于各種異構(gòu)系統(tǒng)之間API接口間通訊，以及處理Web Service的調(diào)用與接收。

屬性：

URL : 發(fā)送xml的接收地址

String
只寫(xiě)

Message : 系統(tǒng)錯(cuò)誤信息
String
只讀

XmlNode:獲取發(fā)送包XML中節(jié)點(diǎn)的值
String
只讀
參數(shù)：Str:節(jié)點(diǎn)名稱(chēng)

GetXmlData: 獲取返回XML數(shù)據(jù)對(duì)象
XMLDom
只讀

方法：

LoadXmlFromFile : 從外部xml文件填充XmlDoc對(duì)象
參數(shù) Path:xml路徑
Void

LoadXmlFromString : 用字符串填充XmlDoc對(duì)象
參數(shù) Str:xml字符串
Void

NodeValue 設(shè)置node的參數(shù)

參數(shù)

NodeName 節(jié)點(diǎn)名

NodeText 值

NodeType 保存類(lèi)型 [text=0,cdata=1]

blnEncode 是否編碼 [true,false]
Void

SendHttpData : 發(fā)送xml包

PRintSendXmlData : 打印發(fā)送請(qǐng)求XML數(shù)據(jù)

PrintGetXmlData : 打印返回XML數(shù)據(jù)

SaveSendXmlDataToFile : 保存發(fā)送請(qǐng)求xml數(shù)據(jù)到文件，文件名為sendxml_日期.txt

SaveGetXmlDataToFile : 保存返回XML數(shù)據(jù)到文件，文件名為getxml_日期.txt

GetSingleNode : 獲取返回xml的節(jié)點(diǎn)信息
參數(shù) Nodestring：節(jié)點(diǎn)名

AcceptHttpData : 接收XML包，錯(cuò)誤信息通過(guò)Message對(duì)象獲取

AcceptSingleNode: 返回接收XML包節(jié)點(diǎn)信息
參數(shù) Nodestring：節(jié)點(diǎn)名

PrintAcceptXmlData : 打印接收端接收到的XML數(shù)據(jù)

SaveAcceptXmlDataToFile : 保存接收的XML包數(shù)據(jù)到文件，文件名為acceptxml_日期.txt

SaveDebugStringToFile : 保存調(diào)試數(shù)據(jù)到文件，文件名為debugnote_日期.txt
參數(shù) Debugstr：調(diào)試信息

代碼:

xmlcls.asp

<%

Rem 處理xml數(shù)據(jù)的發(fā)送、接收類(lèi)
'--------------------------------------------------
'轉(zhuǎn)載的時(shí)候請(qǐng)保留版權(quán)信息
'作者:walkman
'公司:步步為贏科技有限責(zé)任公司
'網(wǎng)址:http://www.shouji138.com
'版本:ver1.0
'--------------------------------------------------

Class XmlClass

Rem 變量定義
Private XmlDoc,xmlhttp
Private MessageCode,SysKey,XmlPath
Private m_GetXmlDoc,m_url
Private m_XmlDocAccept

Rem 初始化
Private Sub Class_Initialize()
   On Error Resume Next
   MessageCode = ""
   XmlPath = ""
   Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
   XmlDoc.ASYNC = False
End Sub

Rem 銷(xiāo)毀對(duì)象
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

'公共屬性定義開(kāi)始--------------------------
Rem 錯(cuò)誤信息
Public Property Get Message()
   Message = MessageCode
End Property

Rem 發(fā)送xml的地址
Public Property Let URL(str)
   m_url = str
End Property
'公共屬性定義結(jié)束--------------------------

'私有過(guò)程、方法開(kāi)始--------------------------
Rem 加載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 字符轉(zhuǎn)化
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 字符轉(zhuǎn)化
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 往文件中追加字符
Private Sub WriteStringToFile(filename,str)
   On Error Resume Next
   Dim fs,ts
   Set fs= createobject("scr   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
'私有過(guò)程、方法結(jié)束--------------------------

'公共方法開(kāi)始--------------------------

'''''''''''發(fā)送xml部分開(kāi)始
Rem 從外部xml文件填充XmlDoc對(duì)象
Public Sub LoadXmlFromFile(path)
   XmlPath = Server.MapPath(path)
   LoadXmlData()
End Sub

Rem 用字符串填充XmlDoc對(duì)象
Public Sub LoadXmlFromString(str)
   XmlDoc.LoadXml str
End Sub

Rem 設(shè)置node的參數(shù) 如 NodeValue "appID",AppID,1,False
'--------------------------------------------------
'參數(shù) ：
'NodeName 節(jié)點(diǎn)名
'NodeText 值
'NodeType 保存類(lèi)型 [text=0,cdata=1]
'blnEncode 是否編碼 [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,"]]>","]]&gt;"))
    ChildNode.appendChild(createCDATASection)
   Else
    ChildNode.Text = NodeText
   End If
End Sub

'--------------------------------------------------
'獲取發(fā)送包XML中節(jié)點(diǎn)的值
'參數(shù) ：
'Str 節(jié)點(diǎn)名
'--------------------------------------------------
Public Property Get XmlNode(Byval Str)
   If XmlDoc.documentElement.selectSingleNode(Str) is Nothing Then
    XmlNode = "Null"
   Else
    XmlNode = XmlDoc.documentElement.selectSingleNode(Str).text
   End If
End Property

'--------------------------------------------------
'獲取返回XML數(shù)據(jù)對(duì)象
'例：
'當(dāng)GetXmlData不為NULL時(shí)，GetXmlData為XML對(duì)象
'--------------------------------------------------
Public Property Get GetXmlData()
   Set GetXmlData = m_GetXmlDoc
End Property

'--------------------------------------------------
'發(fā)送xml包 Public Sub SendHttpData()
   Dim i,GetXmlDoc,LoadAppid
   Set Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
   Set GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") ' 返回xml包
    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 = "請(qǐng)求數(shù)據(jù)錯(cuò)誤！"
     Exit Sub
    End If
   Set GetXmlDoc = Nothing
   Set XmlHttp = Nothing
End Sub

'--------------------------------------------------
'打印發(fā)送請(qǐng)求XML數(shù)據(jù)
'--------------------------------------------------
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

'--------------------------------------------------
'打印返回XML數(shù)據(jù)
'--------------------------------------------------
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 保存發(fā)送請(qǐng)求xml數(shù)據(jù)到文件，文件名為sendxml_日期.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 保存返回XML數(shù)據(jù)到文件，文件名為getxml_日期.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

'--------------------------------------------------
'獲取返回xml的節(jié)點(diǎn)信息
'XmlClassObj.GetSingleNode("http://msg")
'--------------------------------------------------
Public Function GetSingleNode(nodestring)
   If IsObject(m_GetXmlDoc) Then
    GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).text
   Else
    GetSingleNode = ""
   End If
End Function
''''''''''''''''''發(fā)送xml部分結(jié)束

''''''''''''''''''接收xml部分開(kāi)始
'--------------------------------------------------
'接收XML包，錯(cuò)誤信息通過(guò)Message對(duì)象獲取
'--------------------------------------------------
Public Function AcceptHttpData()
   Dim XMLdom
   Set XMLdom = Server.CreateObject("Microsoft.XMLDOM")
   XMLdom.Async = False
   XMLdom.Load(Request)
   If XMLdom.parseError.errorCode <> 0 Then
    MessageCode = "不能正確接收數(shù)據(jù)" & "Descript_ion: " & XMLdom.parseError.reason & "<br>Line: " & XMLdom.parseError.Line
    Set m_XmlDocAccept = Null
   Else
    Set m_XmlDocAccept = XMLdom
   End If
End Function

'--------------------------------------------------
'返回接收XML包節(jié)點(diǎn)信息
'XmlClassObj.GetSingleNode("http://msg")
'--------------------------------------------------
Public Function AcceptSingleNode(nodestring)
   If IsObject(m_XmlDocAccept) Then
    AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).text
   Else
    AcceptSingleNode = ""
   End If
End Function

'--------------------------------------------------
'打印接收端接收到的XML數(shù)據(jù)
'--------------------------------------------------
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 保存接收的XML包數(shù)據(jù)到文件，文件名為acceptxml_日期.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

''''''''''''''''''接收xml部分結(jié)束

Rem 保存調(diào)試數(shù)據(jù)到文件，文件名為debugnote_日期.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

'公共方法結(jié)束--------------------------

End Class
%>

測(cè)試用例：

sendxml.asp

<%
Option Explicit

Response.buffer = True
Response.Expires=-1
%>
<!--#include file="xmlcls.asp"-->

<%
Const Apisysno = "23498927347234234987"
Const ActionURL = "

Dim XmlClassObj
Set XmlClassObj = new XmlClass   '創(chuàng)建對(duì)象
XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" encoding=""gb2312""?><root/>") '用xml字符填充XMLDOC對(duì)象，用來(lái)發(fā)送xml
XmlClassObj.URL =    ActionURL '設(shè)置響應(yīng)的url

Rem xml格式
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","web@shouji138.com",0,False
XmlClassObj.NodeValue "pagename","站點(diǎn)",0,False
XmlClassObj.NodeValue "pageurl","數(shù)據(jù)庫(kù)包存入txt文件

XmlClassObj.SendHttpData()         '開(kāi)始發(fā)送xml數(shù)據(jù)

'XmlClassObj.PrintGetXmlData()        '打印接收到的xml數(shù)據(jù)
'response.write XmlClassObj.Message       '打印錯(cuò)誤信息
XmlClassObj.SaveGetXmlDataToFile()       '將接收到的xml數(shù)據(jù)庫(kù)存入txt文件
response.write XmlClassObj.GetSingleNode("http://message")   '顯示收到的xml數(shù)據(jù)的msg節(jié)點(diǎn)的值
Set XmlClassObj = Nothing         '銷(xiāo)毀對(duì)象實(shí)例
%>

acceptxml.asp

<%
Rem Api用戶(hù)注冊(cè)接口
%>
<%
Response.Expires= -1
Response.Addheader "pragma","no-cache"
Response.AddHeader "cache-control","no-store"
%>
<!--#Include File="xmlcls.asp"-->
<%
Rem xml格式
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
Dim XmlClassObj
Set XmlClassObj = new XmlClass    '創(chuàng)建對(duì)象
XmlClassObj.AcceptHttpData()    '接收xml數(shù)據(jù)
XmlClassObj.SaveAcceptXmlDataToFile() '將接收到的xml數(shù)據(jù)存入txt文件
Err.clear
Dim message

Dim sysno,username,pwd,email,PageName,PageURL
sysno = XmlClassObj.AcceptSingleNode("http://sysno")
username = XmlClassObj.AcceptSingleNode("http://username")
pwd = XmlClassObj.AcceptSingleNode("http://pwd")
email = XmlClassObj.AcceptSingleNode("http://email")
PageName = XmlClassObj.AcceptSingleNode("http://pagename")
PageURL = XmlClassObj.AcceptSingleNode("http://pageurl")

XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) '存入debug日志文件

If Err Then
message = message & Err.Descript_ion
Else
Err.clear
If sysno <> Apisysno Then
   message = "請(qǐng)務(wù)非法使用！"
Else
   message = regUser(username,pwd,email,PageName,PageURL)
End If
End If

'XmlClassObj.SaveDebugStringToFile("message=" & message) '將message值存入debug日志文件

Set XmlClassObj = Nothing        '銷(xiāo)毀對(duì)象實(shí)例

Response.ContentType = "text/xml"      '輸出xml數(shù)據(jù)流給發(fā)送端
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)
'''''''''''''''''''
''''''''''''''''''
'''''''''''''''''
'操作數(shù)據(jù)庫(kù)注冊(cè)用戶(hù)
'''''''''''''''''
''''''''''''''
regUser = "OK"

End Function
%>

下載地址:http://www.shouji138.com/files/Xmlcls.rar

演示地址:http://www.shouji138.com/aspnet2/sendxml.asp