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在测试的时候是最烦心的，因为每一个环节的失败都将直接导致你最终结果的错误，不论是在发送、接收以及返回包的任何一个步骤上都必须准确无误。所以我在每一个类中都有一个相似的方法--打印包的函数，就是把要发送的包、接收到的包以及返回的包都先打印出来，最笨的方法了，处理之前抓取这个包，看看到底包的内容和你预计的是否完全一样。