直接使用XML做SOAP请求
'保持属性值的局部变量
Private mvarServerURL As String '局部复制
![](https://www.cnblogs.com/Images/OutliningIndicators/None.gif)
Public Property Let ServerURL(ByVal vData As String)
'向属性指派值时使用,位于赋值语句的左边。
'Syntax: X.ServerURL = 5
mvarServerURL = vData
End Property
![](https://www.cnblogs.com/Images/OutliningIndicators/None.gif)
Public Property Get ServerURL() As String
'检索属性值时使用,位于赋值语句的右边。
'Syntax: Debug.Print X.ServerURL
ServerURL = mvarServerURL
End Property
![](https://www.cnblogs.com/Images/OutliningIndicators/None.gif)
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, "<", "<")
' Command = Replace(Command, ">", "&rt;")
' Command = Replace(Command, "&", "&")
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
|