本asp类可以用来处理xml包的发送与接收。可用于各种异构系统之间API接口间通讯，以及处理Web Service的调用与接收。
属性：
URL : 发送xml的接收地址
String
只写
Message : 系统错误信息
String
只读
XmlNode:获取发送包XML中节点的值
String
只读
参数：Str:节点名称
GetXmlData: 获取返回XML数据对象
XMLDom
只读
方法：
LoadXmlFromFile : 从外部xml文件填充XmlDoc对象
参数 Path:xml路径
Void
LoadXmlFromString : 用字符串填充XmlDoc对象
参数 Str:xml字符串
Void
NodeValue 设置node的参数
参数
NodeName 节点名
NodeText 值
NodeType 保存类型 [text=0,cdata=1]
blnEncode 是否编码 [true,false]
Void
SendHttpData : 发送xml包
PrintSendXmlData : 打印发送请求XML数据
PrintGetXmlData : 打印返回XML数据
SaveSendXmlDataToFile : 保存发送请求xml数据到文件，文件名为sendxml_日期.txt
SaveGetXmlDataToFile : 保存返回XML数据到文件，文件名为getxml_日期.txt
GetSingleNode : 获取返回xml的节点信息
参数 Nodestring：节点名
AcceptHttpData : 接收XML包，错误信息通过Message对象获取
AcceptSingleNode: 返回接收XML包节点信息
参数 Nodestring：节点名
PrintAcceptXmlData : 打印接收端接收到的XML数据
SaveAcceptXmlDataToFile : 保存接收的XML包数据到文件，文件名为acceptxml_日期.txt
SaveDebugStringToFile : 保存调试数据到文件，文件名为debugnote_日期.txt
参数 Debugstr：调试信息
代码:
xmlcls.asp
<%
Rem 处理xml数据的发送、接收类
''--------------------------------------------------
''转载的时候请保留版权信息
''作者:walkman
''公司:步步为赢科技有限责任公司
''网址: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 销毁对象
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
''公共属性定义开始--------------------------
Rem 错误信息
Public Property Get Message()
Message = MessageCode
End Property
Rem 发送xml的地址
Public Property Let URL(str)
m_url = str
End Property
''公共属性定义结束--------------------------
''私有过程、方法开始--------------------------
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 字符转化
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 字符转化
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("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
''私有过程、方法结束--------------------------
''公共方法开始--------------------------
''''''''''''''''''''''发送xml部分开始
Rem 从外部xml文件填充XmlDoc对象
Public Sub LoadXmlFromFile(path)
XmlPath = Server.MapPath(path)
LoadXmlData()
End Sub
Rem 用字符串填充XmlDoc对象
Public Sub LoadXmlFromString(str)
XmlDoc.LoadXml str
End Sub
Rem 设置node的参数 如 NodeValue "appID",AppID,1,False
''--------------------------------------------------
''参数 ：
''NodeName 节点名
''NodeText 值
''NodeType 保存类型 [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,"]]>","]]>"))
ChildNode.appendChild(createCDATASection)
Else
ChildNode.Text = NodeText
End If
End Sub
''--------------------------------------------------
''获取发送包XML中节点的值
''参数 ：
''Str 节点名
''--------------------------------------------------
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数据对象
''例：
''当GetXmlData不为NULL时，GetXmlData为XML对象
''--------------------------------------------------
Public Property Get GetXmlData()
Set GetXmlData = m_GetXmlDoc
End Property
''--------------------------------------------------
''发送xml包 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") '' 返回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 = "请求数据错误！"
Exit Sub
End If
Set GetXmlDoc = Nothing
Set XmlHttp = Nothing
End Sub
''--------------------------------------------------
''打印发送请求XML数
