微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

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

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

原文地址:https://www.jb51.cc/vb/257179.html

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。

相关推荐