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

（编辑：李大同）

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