ASP之SOAP的发送、接收与处理类

本人研究SOAP，源于06年工作时在ASP下跨域的数据传递，当时公司的主站需要与二级域名进行数据通信，经过对动网一段时间的研究，最后自己整理出几个类，用于处理这种数据包的收发和处理。

我们不谈SOAP是什么，只谈用来干嘛，简单的说就是通过HTTP进行数据包（XML文档格式数据）传递，比如有两个站点：A和B，如果A想读取B中某些数据，必须具备两个条件：一是，B必须对A开放这些功能，另外一个是，A必须具备读取和处理的能力。所以，B必须能够识别出A，因为基于HTTP协议是“开放”性的，任何人都可以访问，那就需要对用户进行身份验证，除此之外，就是如果对数据进行打包，很简单--XML文档，在SOAP中所有的包都是XML的文档格式，也就是说，在传递数据时必须进行“打包”，制作成XML文档进行传递，接收时装载这个XML文档，然后处理，最后打包需要返回的数据，再返回。

看看我的SOAP收发和处理类(ASP)

'+++++++++++++++++++++++++++++++++++++++
'类说明
'   OpenXML：XML数据常用发送函数类
'   SendXML：XML数据发送类
'   InceptXML：XML数据接收类
'   ReturnXML：XML数据返回类
'   ManageXML：XML数据处理类
'依赖性
'
'==================== 类声明 ====================

'XML数据  发送类
Class SendXML
Public Estate,GetData,GetAppid,MessageCode,myXML_AppID,myXML_Urls
'Estate：最终结果状态。-1：失败；1：成功。
'GetData：保存返回的 Dictionary 对象数据（键：系统程序标识；值：响应XML数据）。
'MessageCode：发送数据并返回后的处理信息。
Private XmlDoc,XmlHttp,ArrUrls,mXML

'构造函数
Private Sub Class_Initialize()
myXML_AppID = "haowai"                                  '当前系统的程序标识
myXML_Urls = "http://localhost/include/myXml.asp"       '整合的其它程序的接口文件路径
Set mXML=New ManageXML
ArrUrls = Split(Trim(myXML_Urls),"|")
MessageCode = ""
Estate = "0"
Set GetData = Server.Createobject("Scripting.Dictionary")
Set XmlDoc=mXML.createDocument("<?xml version=""1.0"" encoding=""gb2312""?><root/>")
mXML.AddNode XmlDoc.documentElement,mXML.CreateNode(XmlDoc,"appid",1,myXML_AppID)
End Sub
'析构函数
Private Sub Class_Terminate()
If IsObject(XmlDoc) Then Set XmlDoc = Nothing
If IsObject(GetData) Then Set GetData = Nothing
If IsObject(mXML) Then Set mXML = Nothing
End Sub

'创建新节点，并返回
'nName：节点名称
'nType：节点类型
'nValue：节点值
Public Property Get CreateNode(nName,nType,nValue)
Set CreateNode=mXML.CreateNode(XmlDoc,nName,nType,nValue)
End Property

'获取发送包XML中的节点对象
'XPath：XPath查询语法字符串
Public Property Get GetSendNode(XPath)
Set GetSendNode=mXML.GetNode(XmlDoc.documentElement,XPath)
End Property
'获取返回包XML中的节点对象
'GetAppid：要获取的系统标识
'XPath：XPath查询语法字符串
Public Property Get GetReturnNode(GetAppid,XPath)
Set GetReturnNode=mXML.GetNode(GetReturnXml(GetAppid).documentElement,XPath)
End Property

'获取发送的XML文档对象
Public Property Get GetSendXml()
Set GetSendXml=XmlDoc
End Property
'获取返回XML文档对象，当该值不为NULL时，其为XML对象。
'GetAppid：要获取的系统标识
Public Property Get GetReturnXml(GetAppid)
Dim GetXmlDoc
GetReturnXml = Null
If GetAppid <> "" Then
GetAppid = Lcase(GetAppid)
If GetData.Exists(GetAppid) Then
Set GetReturnXml = GetData(GetAppid)
End If
End If
End Property

'打印发送请求XML文档对象
Public Sub PrintSendXml()
mXML.PrintXML XmlDoc
End Sub
'打印返回XML文档对象
'GetAppid：要获取的系统标识
'myApi_Obj.PrintReturnXml
Public Sub PrintReturnXml(GetAppid)
mXML.PrintXML GetReturnXml(GetAppid)
End Sub

'发送 XML 数据包
Public Sub Send()
Dim i,GetXmlDoc,LoadAppid,iEstate,EstateStr
Set Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
Set GetXmlDoc = mXML.createDocument("")
For i = 0 to Ubound(ArrUrls)
XmlHttp.Open "POST", Trim(ArrUrls(i)), false
XmlHttp.SetRequestHeader "content-type", "text/xml"
XmlHttp.Send XmlDoc
'Response.Write mXML.strAnsi2Unicode(xmlhttp.responseBody)
If GetXmlDoc.LoadXml(XmlHttp.responseText) Then
LoadAppid = Lcase(GetXmlDoc.documentElement.selectSingleNode("appid").Text)
GetData.add LoadAppid,GetXmlDoc
iEstate = GetXmlDoc.documentElement.selectSingleNode("status").Text
Select Case CStr(iEstate)
Case "-1"  EstateStr="失败"
Case "0"   EstateStr="部分成功"
Case Else  EstateStr="成功"
End Select
If iEstate="-1" Then
Estate="-1"
Else
Estate="1"
End If
MessageCode = MessageCode & "程序标识：" & LoadAppid & " 状态：" & EstateStr & "<br>"
MessageCode = MessageCode & GetXmlDoc.documentElement.selectSingleNode("message").Text & "<br>"
If iEstate = "-1" Then
Exit For
End If
Else
Estate="-1"
MessageCode = "请求数据错误！"
Exit For
End If
Next
Set GetXmlDoc = Nothing
Set XmlHttp = Nothing
End Sub
End Class

'XML数据  接收类
Class InceptXML
Public Estate
'Estate：获取状态。1：数据接收成功；0：数据接收失败。
Private XmlDoc,mXML

'构造函数
Private Sub Class_Initialize()
Set mXML=New ManageXML
Set XmlDoc = mXML.createDocument("")
XmlDoc.Load(Request)
If XmlDoc.parseError.errorCode <> 0 Then
Estate="0"  '数据接收失败
Else
Estate="1"  '数据接收成功
End If
End Sub
'析构函数
Private Sub Class_Terminate()
If IsObject(XmlDoc) Then Set XmlDoc = Nothing
If IsObject(mXML) Then Set mXML = Nothing
End Sub

'获取接收的XML文档对象
Public Property Get GetInceptXml()
Set GetInceptXml=XmlDoc
End Property
'打印接收的XML文档对象
Public Sub PrintInceptXml()
mXML.PrintXML XmlDoc
End Sub

'获取接收包XML中的节点对象
'XPath：XPath查询语法字符串
Public Property Get GetNode(XPath)
Set GetNode=mXML.GetNode(XmlDoc.documentElement,XPath)
End Property
End Class

'XML数据  返回类
Class ReturnXML
Private XmlDoc,mXML

'构造函数
Private Sub Class_Initialize()
Set mXML=New ManageXML
Set XmlDoc=mXML.createDocument("<?xml version=""1.0"" encoding=""gb2312""?><root/>")
End Sub
'析构函数
Private Sub Class_Terminate()
If IsObject(XmlDoc) Then Set XmlDoc = Nothing
If IsObject(mXML) Then Set mXML = Nothing
End Sub

'返回 XML 数据包
'appid：当前程序标识
'estate：程序执行状态。-1：失败；0：部分成功；1：成功。
'message：响应信息
Public Function Return(appid,estate,message)
mXML.AddNode XmlDoc.documentElement,mXML.CreateNode(XmlDoc,"appid",1,appid)
mXML.AddNode XmlDoc.documentElement,mXML.CreateNode(XmlDoc,"status",1,estate)
mXML.AddNode XmlDoc.documentElement,mXML.CreateNode(XmlDoc,"message",1,message)
mXML.PrintXML XmlDoc
End Function

'获取返回的XML文档对象
Public Property Get GetReturnXml()
Set GetReturnXml=XmlDoc
End Property
'打印返回的XML文档对象
Public Sub PrintReturnXml()
mXML.PrintXML XmlDoc
End Sub

'获取返回包XML中的节点对象
'XPath：XPath查询语法字符串
Public Property Get GetNode(XPath)
Set GetNode=mXML.GetNode(XmlDoc.documentElement,XPath)
End Property

'创建新节点，并返回
'nName：节点名称
'nType：节点类型
'nValue：节点值
Public Property Get CreateNode(nName,nType,nValue)
Set CreateNode=mXML.CreateNode(XmlDoc,nName,nType,nValue)
End Property
End Class

'XML数据  处理类
Class ManageXML
'用字符串或XML文档创建Document对象，并返回
'Str：要加载的字符串或XML文件路径
Public Property Get CreateDocument(Str)
Dim XmlDoc
Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
XmlDoc.ASYNC = False
If Reg(Str,"^.*/.xml$",True,True)=True Then
XmlDoc.Load(Str)
ElseIf Len(Str)<8 Or Left(Str,2)<>"<?" Then
Str="<?xml version=""1.0"" encoding=""gb2312""?>"&Str
XmlDoc.LoadXml Str
ElseIf Len(Str)>0 Then
XmlDoc.LoadXml Str
End If
Set CreateDocument=XmlDoc
End Property
'获取节点对象
'Node：目标节点的父节点对象，如Document对象的根节点为：XmlDoc.documentElement
'XPath：XPath查询语法字符串
Public Property Get GetNode(Node,XPath)
If Node.selectSingleNode(XPath) is Nothing Then
Set GetNode = Nothing
Else
Set GetNode = Node.selectSingleNode(XPath)
End If
End Property
'创建新节点，并返回
'XmlDoc：Document对象
'nName：节点名称
'nType：节点类型
'nValue：节点值
Public Property Get CreateNode(XmlDoc,nName,nType,nValue)
Dim Node
Set Node=XmlDoc.CreateNode(nType,nName,"")
Node.Text=nValue
Set CreateNode=Node
End Property
'添加新节点
'Parent：父节点
'Node：要添加的节点对象
Public Sub AddNode(Parent,Node)
Parent.AppendChild(Node)
End Sub
'打印XML数据
'obj：要打印的XML数据对象 或 XML文档的字符串表现形式
Public Sub PrintXML(obj)
Response.Clear
'Response.ContentType = "text/xml"
Response.CharSet = "gb2312"
Response.Expires = 0
If VarType(obj)=8 Then
If Reg(obj,"^</?xml.*$",True,True)=False Then obj="<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine&obj
Response.Write obj
Else
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine&obj.documentElement.XML
End If
Response.End()
End Sub
'字符串编码
'str：要编码的字符串
Public 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
'字符串解码
'asContents：要解码的字符串
Public 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
'正则表达式模式匹配，成功返回：True；否则返回False
'strng：要测试的字符串
'patrn：匹配的正则表达式模式
'ignore：是否区分大小写。False：区分；True：不区分。
'global：全部匹配还是只匹配第一个。True：全局；False：只匹配第一个。
Public Function Reg(strng,patrn,ignore,global)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = ignore
regEx.Global = global
Reg = regEx.Test(strng)
End Function
End Class

先看发送类：SendXML

使用前先配置构造函数中的两个参数：

myXML_AppID = "www1" '当前系统的程序标识

myXML_Urls = "http://localhost/include/myXml.asp" '整合的其它程序的接口文件路径

myXML_AppID参数表示当前站点的标识，在接收类中用此标识来唯一的验证身份， myXML_Urls参数表示数据包发送的地址路径。该参数可以存储多个地址，中间用“,”逗号分隔，其实有点像“广播”，发送的时候会向所有的地址都发送这个包。

当创建该类后，可以通过CreateNode方法先对数据包进行设置，然后使用Send方法发送。这里我们不讨论如果打包，你必须非常的熟悉如果处理XML文档。

接收类：InceptXML

该类中最重要的一个方法：GetNode接收数据函数。成功接收后，可以通过GetInceptXml函数读取数据包，至于如何处理我们也不讨论（还是那句话，你必须非常的熟悉如果处理XML文档）。

返回类：ReturnXML

其实该类就是打印出返回的包--XML文档。

处理类：ManageXML

该类只是集成了对XML常用操作的一些方法。

最后，还有二个问题，第一个就是乱码，你在使用SOAP前，要统一一种编码，否则在处理的时候你会经常遇到乱码。另外一个，也是最最重要的一点，就是耐心，SOAP在测试的时候是最烦心的，因为每一个环节的失败都将直接导致你最终结果的错误，不论是在发送、接收以及返回包的任何一个步骤上都必须准确无误。所以我在每一个类中都有一个相似的方法--打印包的函数，就是把要发送的包、接收到的包以及返回的包都先打印出来，最笨的方法了，处理之前抓取这个包，看看到底包的内容和你预计的是否完全一样。