如何在VB6中通过Http Request发送SOAP

时间:2013-05-21 04:52:28

标签: xml soap vb6 httprequest

现在我在VB6中使用SOAP,我遇到了一些麻烦。 我需要的是将SOAP发送到Web服务器并将结果保存到XML文件中。

这是从网站上删除的HttpRequest示例。

有关详细信息,请参阅URL。 https://www.ftq360.net/Collect/ExportSvc_JRJC.asmx?op=ExportJRJC

我安装了SOAP Toolkit3.0并在VB参考对话框中添加了Microsoft SOAP3.0库。 谷歌搜索后,我写了一些代码如下,没有错误。

我的麻烦是我之后要做的事情! 我擅长VB,但对Web Service一无所知。 我希望你的快速帮助。 谢谢大家。

1 个答案:

答案 0 :(得分:1)

只要您是客户端,您就可以使用MSXML-API来处理与SOAP服务器的HTTP通信。

这是HTTP处理的示例类:

Option Explicit
Private HTTPHandler As MSXML2.ServerXMLHTTP

Public Event OnReadyStateChange()

Public Sub SendSoapRequest()
Dim SoapDocument As MSXML2.DOMDocument

    'set the document
    'eigther as string
    SoapDocument.loadXML "<xml......"
    'or from file
    SoapDocument.Load "C:\Foo\SoapDoc.xml"
    'or by assembling it in code (see MSXML-documentation)
    SoapDocument.appendChild SoapDocument.createNode(NODE_ELEMENT, "SoapDocRootNode", "NamespaceURI")
    SoapDocument.documentElement SoapDocument.createNode(NODE_ELEMENT, "SoapDoc1stChild", "")
    '...

    SendRequest SoapDocument, "http://soapserver:8080/someresurce/"
End Sub

Private Sub SendRequest(XmlDoc As MSXML2.DOMDocument, URL)

On Error GoTo ErrReq
    'setting the URL and the request type (in this case POST to transmit the XML-Document)
    HTTPHandler.open "POST", URL, True
    'setting the request-header
    'optional but some servers require it
    HTTPHandler.setRequestHeader "Content-Type", "text/xml"
    HTTPHandler.setRequestHeader "Accept", "text/xml"
    HTTPHandler.setRequestHeader "Accept-Charset", "iso-8859-1" 'adapt to the server-settings


    HTTPHandler.send XmlDoc

    DoEvents

    Exit Sub
ErrReq:
    MsgBox "SendRequest: Error while sending the request" + vbCrLf + Err.Description
End Sub

Private Sub OnReadyStateChange()
'important: Procedure has to be set as default in the procedure attribites dialog
'otherwise you can only poll for readyState to become the value of 4
Dim ReceivedDoc As MSXML2.DOMDocument
Dim Start As Single

On Error GoTo ErrNewData

    'while the readyState is below 4 there is no result available yet
    If HTTPHandler.readyState <> 4 Then Exit Sub

    'check for server-result 200 (OK)
    If HTTPHandler.Status <> 200 Then 'OK
        'something went wrong at server site
        MsgBox "OnReadyStateChange: server responded with error message" + vbCrLf + _
                HTTPHandler.Status + vbCrLf + _
                HTTPHandler.statusText
        Exit Sub
    End If

    'wait for the returned document to be parsed
    Start = Timer
    Do Until ReceivedDoc.parsed
        DoEvents
        'if running over midnight
        If Start > Timer Then Start = Start - 86400

        'timeout of 5 seconds
        If Timer - Start > 5 Then
            MsgBox "OnReadyStateChange: Timeout while paring the returned document"
            Exit Sub
        End If
    Loop

    If ReceivedDoc.parseError <> 0 Then
        MsgBox "OnReadyStateChange Error while parsing the returned document" + vbCrLf + _
                ReceivedDoc.parseError.reason + vbCrLf + _
                "Position: Line" + CStr(ReceivedDoc.parseError.Line) + " row" + CStr(ReceivedDoc.parseError.linepos)
        Exit Sub
    End If

    ResponseHandler

    Exit Sub
ErrNewData:

    MsgBox "OnReadyStateChange: Error while processing the server response" + vbCrLf + Err.Description

End Sub

Private Sub ResponseHandler(XmlDoc As MSXML2.DOMDocument)
    'Handle the Response
End Sub