1. 程式人生 > >VB呼叫WebService(直接Post方式)並解析返回的XML

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, 0 + 64,"提示"

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  , 0 + 16 , "提示" 
Resume ErrExit
End Function