VB呼叫WebService(直接Post方式)並解析返回的XML
阿新 • • 發佈:2019-01-04
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
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