如何在VB6中通过HttpRequest发送SOAP

Question

Now I'm working with SOAP in VB6 and I have some trouble. What I need is to send SOAP to web server and save the result into a XML file.

Here is HttpRequest sample scraped from the site.

For more detailed information, please see the URL. https://www.ftq360.net/Collect/ExportSvc_JRJC.asmx?op=ExportJRJC

I installed SOAP Toolkit3.0 and added Microsoft SOAP3.0 Library in VB reference dialog. After googling, I wrote some code as below and there is no error.

My trouble is that what I have to do after that! I'm good at VB but don't know anything about Web Service. I hope your quick help. Thanks everybody.

Answer 1

As long as you are the client only you can use the MSXML-API for handling the HTTP communication to the SOAP-Server.

Here an example class for HTTP-handling:

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