直接使用XML做SOAP请求

' 保持属性值的局部变量
Private  mvarServerURL  As   String   ' 局部复制

Public   Property   Let  ServerURL(ByVal vData  As   String )
' 向属性指派值时使用，位于赋值语句的左边。
' Syntax: X.ServerURL = 5
    mvarServerURL  =  vData
End Property

Public   Property   Get  ServerURL()  As   String
' 检索属性值时使用，位于赋值语句的右边。
' Syntax: Debug.Print X.ServerURL
    ServerURL  =  mvarServerURL
End Property

Public   Function  ExecuteCommandWithReturn(ByVal Command  As   String )  As   String
     Dim  safeString  As   String      ' 身份验证码
     Dim  strXML  As   String          ' SOAP查询
    
     ' On Error GoTo Errs:
     On   Error   Resume   Next
    
    
    safeString  =   LCase ( Replace ( " 592672-016767-2CC4F321-0E348AF1-AB52FF57-E07A " ,  " - " ,  "" ))
'     Command = Replace(Command, " ", " ")
'     Command = Replace(Command, "'", "'")
'     Command = Replace(Command, """", """)
'     Command = Replace(Command, "<", "&lt;")
'     Command = Replace(Command, ">", "&rt;")
'     Command = Replace(Command, "&", "&amp;")
   
    strXML  =  strXML  &   " <?xml version=""1.0"" encoding=""utf-8""?> "   &  vbCrLf
    strXML  =  strXML  &   " <soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/""> "   &  vbCrLf
    strXML  =  strXML  &   "   <soap:Body> "   &  vbCrLf
    strXML  =  strXML  &   "     <ExecuteCommandWithReturn xmlns=""http://tempuri.org/GPSService/Data""> "   &  vbCrLf
    strXML  =  strXML  &   "       <SafeCode> "   &  safeString  &   " </SafeCode> "   &  vbCrLf
    strXML  =  strXML  &   "       <CommandText> "   &  Command  &   " </CommandText> "   &  vbCrLf
    strXML  =  strXML  &   "     </ExecuteCommandWithReturn> "   &  vbCrLf
    strXML  =  strXML  &   "   </soap:Body> "   &  vbCrLf
    strXML  =  strXML  &   " </soap:Envelope> "
        
     ' 定义一个XML HTTP Request对象，用于发送请求
     Dim  soapHTTP  As   New  MSXML.XMLHTTPRequest
    
     ' 定义一个XML的文档对象，将手写的或者接受的XML内容转换成XML对象
     Dim  soapXML  As   New  MSXML.DOMDocument
    
     ' 将手写的SOAP字符串转换为XML对象
    soapXML.loadXML strXML
    
     ' 向指定的URL发送Post消息
    soapHTTP.open  " POST " , mvarServerURL  &   "" ,  False
    soapHTTP.setRequestHeader  " Content-Type " ,  " text/xml;charset=utf-8 "
     ' soapHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; MS Web Services Client Protocol 1.1.4322.2300)"
    soapHTTP.setRequestHeader  " SOAPAction " ,  " http://tempuri.org/GPSService/Data/ExecuteCommandWithReturn "
    soapHTTP.send (strXML)
    
     While  soapHTTP.readyState  <>   4    ' 等待处理完毕
     Wend
    
     ' 返回的XML信息
     Dim  strReturn  As   String
     ' Debug.Print soapHTTP.responseText
     Dim  XMLReturn  As  MSXML.DOMDocument
     Set  XMLReturn  =  soapHTTP.responseXML
    
    ExecuteCommandWithReturn  =  XMLReturn.childNodes( 1 ).Text
     Set  XMLReturn  =   Nothing
     Set  soapXML  =   Nothing
     Set  soapHTTP  =   Nothing
     Exit   Function
Errs:
     MsgBox  Err.Description
    Debug.Print Err.Description
End Function