VB调用WebService（直接Post方式）并解析返回的XML

发布时间：2020-12-17 07:42:10 所属栏目：百科来源：网络整理

导读：Function TodoTaskBySOAP(postURL As String,host As String,n As Integer,FilterItem() As String,OwnerSSICID() As String,AppID() As String,ToDoID() As String,Title() As String,Url() As String,ExpireDate() As String,CreateTime() As String,Action

Function TodoTaskBySOAP(postURL As String,host As String,n As Integer,FilterItem() As String,OwnerSSICID() As String,AppID() As String,ToDoID() As String,Title() As String,Url() As String,ExpireDate() As String,CreateTime() As String,Action() As String,UpdateTime() As String,Remark1() As String,Remark2() As String,Remark3() As String) As String On Error GoTo ErrSub Dim oXMLHttp As Variant Dim errcode As String Dim errmsg As String Dim postData As String Dim responseText As String Dim resStr As String Dim sXML As String Dim i As integer Dim oXML As Variant Set oXMLHttp = CreateObject("Msxml2.XMLHTTP") Dim objNodes As Variant Dim nodeValues As Variant If Not IsObject(oXMLHttp) Then Set oXMLHttp = CreateObject("Microsoft.XMLHTTP") If Not IsObject(oXMLHttp) Then MsgBox "缺少Msxml组件!",0 + 64,"错误" Exit Function End If End If If UBound(FilterItem) = n And UBound(OwnerSSICID)= n And UBound(AppID)=n And UBound(ToDoID)=n And UBound(Title)=n And UBound(Url)=n And UBound(ExpireDate)=n And UBound(CreateTime)=n And UBound(Action)=n And UBound(UpdateTime)=n And UBound(Remark1)=n And UBound(Remark2)=n And UBound(Remark3)=n Then postData = "<?xml version=""1.0"" encoding=""utf-8""?>" postData = postData & "<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/"">" postData = postData & "<soap:Body>" postData = postData & "<SaveToDo xmlns=""http://webservice.iipa/"">" postData = postData & "<n>"& n &"</n>" postData = postData + "<FilterItem>" For i = 0 To n -1 postData = postData &"<string>" & FilterItem(i) &"</string>" Next postData = postData + "</FilterItem>" postData = postData + "<OwnerSSICID>" For i = 0 To n -1 postData = postData &"<string>" & OwnerSSICID(i) &"</string>" Next postData = postData + "</OwnerSSICID>" postData = postData + "<AppID>" For i = 0 To n -1 postData = postData &"<int>" & AppID(i) &"</int>" Next postData = postData + "</AppID>" postData = postData + "<ToDoID>" For i = 0 To n -1 postData = postData &"<string>" & ToDoID(i) &"</string>" Next postData = postData + "</ToDoID>" postData = postData + "<Title>" For i = 0 To n -1 postData = postData &"<string>" & Title(i) &"</string>" Next postData = postData + "</Title>" postData = postData + "<Url>" For i = 0 To n -1 postData = postData &"<string>" & Url(i) &"</string>" Next postData = postData + "</Url>" postData = postData + "<ExpireDate>" For i = 0 To n -1 postData = postData &"<string>" & ExpireDate(i) &"</string>" Next postData = postData + "</ExpireDate>" postData = postData + "<CreateTime>" For i = 0 To n -1 postData = postData &"<string>" & CreateTime(i) &"</string>" Next postData = postData + "</CreateTime>" postData = postData + "<Action>" For i = 0 To n -1 postData = postData &"<int>" & Action(i) &"</int>" Next postData = postData + "</Action>" postData = postData + "<UpdateTime>" For i = 0 To n -1 postData = postData &"<string>" & UpdateTime(i) &"</string>" Next postData = postData + "</UpdateTime>" postData = postData + "<Remark1>" For i = 0 To n -1 postData = postData &"<string>" & Remark1(i) &"</string>" Next postData = postData + "</Remark1>" postData = postData + "<Remark2>" For i = 0 To n -1 postData = postData &"<string>" & Remark2(i) &"</string>" Next postData = postData + "</Remark2>" postData = postData + "<Remark3>" For i = 0 To n -1 postData = postData &"<string>" & Remark3(i) &"</string>" Next postData = postData + "</Remark3>" postData = postData + "</SaveToDo>" postData = postData + "</soap:Body>" postData = postData + "</soap:Envelope>" Call logInfo(postData) Call logInfo(URLEncode(postData)) oXMLHttp.Open "Post",postURL,False oXMLHttp.setRequestHeader "Content-Type","text/xml; charset=utf-8" oXMLHttp.setRequestHeader "Content-length",Len(URLEncode(postData)) oXMLHttp.setRequestHeader "Accept-Language","zh-CN" oXMLHttp.setRequestHeader "SOAPAction","http://webservice.iipa/SaveToDo" oXMLHttp.setRequestHeader "Host",host oXMLHttp.Send URLEncode(postData) responseText = oXMLHttp.responseText Call logInfo("返回状态：" & oXMLHttp.Status) Call logInfo("返回字段：" + responseText) MsgBox responseText,"提示" If oXMLHttp.Status = 200 Then sXML = oXMLHttp.responseText resStr = StrLeft(sXML,"</SaveToDoResult>") Set oXML = CreateObject("Microsoft.XMLDOM") oXML.async = False oXML.load(oXMLHttp.responseXML) Dim values As Variant 'Set objNodes = oXML.selectNodes("//SaveToDoResult") Set objNodes = oXML.selectNodes("//string") Forall objNode In objNodes MsgBox objNode.Text Print objNode.Text End forall ' MsgBox oXML.getElementsByTagName("SaveToDoResult").Length ' ' ForAll value In oXML.documentElement.childNodes ' Print value.nodename ' Print value.text ' End ForAll Else MsgBox "服务器返回异常！返回代码：" & oXMLHttp.Status,0 + 16,"提示" End If Set oXMLHttp = Nothing Else Call logInfo("参数不对！" &" n = " & n &"FilterItem = " &UBound(FilterItem) & " OwnerSSICID = " & UBound(OwnerSSICID) &" AppID = " & UBound(AppID)&" ToDoID = " & UBound(ToDoID) &" Title = " & UBound(Title) &" Url = " & UBound(Url) & " ExpireDate = " & UBound(ExpireDate)&" CreateTime = " & UBound(CreateTime) & " Action = " & UBound(Action)&" UpdateTime = " & UBound(UpdateTime)&" Remark1 = " &UBound(Remark1)&" Remark2 = " & UBound(Remark2)&" Remark3 = " & UBound(Remark3)) End If ErrExit: Exit Function ErrSub: MsgBox "服务器异常！"& Err & " " & Error,"提示" Resume ErrExit End Function

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!