Call Webservice from VB6

Category:

C#, VB.NET, ASP.NET

Type:

Snippets

Difficulty:

Intermediate

Author:

Anonymous

Version Compatibility: Visual Basic 6

More information:

I needed to call a webservice I built in C# from an old application made in VB6. Using SOAP was not an option, so I decided to use MSXML2 to prepare and send my own XML code. MSXML2 comes with IE6, and most users already have it installed, but just in case, I used late binding for MSXML2. Comments preceed each block of code. See comments in Command1_Click method for further details.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Private Sub Command1_Click()
    ' Start Internet Explorer and type in the url of your webservice page
    ' i.e.: http://localhost/myweb/mywebService.asmx
    ' In that page, click on the link to the method you want to call from your application
    ' Select in upper POST section the xml code from <?xml.. to </soap:Envelope>
    ' Copy this into the strXml variable, escape all quotes and replace "string" your parameter value
    ' Copy the url to your webservice page (asmx) to the strUrl variable
    ' Copy the SOAPAction value to the strSoapAction variable

Dim strSoapAction As String
    Dim strUrl As String
    Dim strXml As String
    Dim strParam As String
    
    txtOutput.Text = ""
    strParam = "MyParameterString"
    strUrl = "http://localhost/myweb/mywebService.asmx"
    strSoapAction = "http://tempuri.org/MyMethod"

strXml = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
             "<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/"">" & _
             "<soap:Body>" & _
             "<CheckActCode xmlns=""http://tempuri.org/"">" & _
             "<actCode>" & strParam & "</actcode>" & _
             "</checkactcode>" & _
             "</soap:body>" & _
             "</soap:envelope>"

' Call PostWebservice and put result in text box
    Debug.Print PostWebservice(strUrl, strSoapAction, strXml)

End Sub

Private Function PostWebservice(ByVal AsmxUrl As String, ByVal SoapActionUrl As String, ByVal XmlBody As String) As String
    Dim objDom As Object
    Dim objXmlHttp As Object
    Dim strRet As String
    Dim intPos1 As Integer
    Dim intPos2 As Integer
    
    On Error GoTo Err_PW
    
    ' Create objects to DOMDocument and XMLHTTP
    Set objDom = CreateObject("MSXML2.DOMDocument")
    Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")
    
    ' Load XML
    objDom.async = False
    objDom.loadXML XmlBody

' Open the webservice
    objXmlHttp.open "POST", AsmxUrl, False
    
    ' Create headings
    objXmlHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
    objXmlHttp.setRequestHeader "SOAPAction", SoapActionUrl
    
    ' Send XML command
    objXmlHttp.send objDom.xml

' Get all response text from webservice
    strRet = objXmlHttp.responseText
    
    ' Close object
    Set objXmlHttp = Nothing
    
    ' Extract result
    intPos1 = InStr(strRet, "Result>") + 7
    intPos2 = InStr(strRet, " 7 And intPos2 > 0 Then
        strRet = Mid(strRet, intPos1, intPos2 - intPos1)
    End If
    
    ' Return result
    PostWebservice = strRet
    
Exit Function
Err_PW:
    PostWebservice = "Error: " & Err.Number & " - " & Err.Description

End Function