Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
                            (ByVal dwFlags As Long, _
                            lpSource As Any, _
                            ByVal dwMessageId As Long, _
                            ByVal dwLanguageId As Long, _
                            ByVal lpBuffer As String, _
                            ByVal nSize As Long, _
                            Arguments As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function InternetOpen Lib "wininet.dll" _
         Alias "InternetOpenA" _
            (ByVal lpszCallerName As String, _
             ByVal dwAccessType As Long, _
             ByVal lpszProxyName As String, _
             ByVal lpszProxyBypass As String, _
             ByVal dwFlags As Long) As Long

Private Declare Function InternetConnect Lib "wininet.dll" _
            Alias "InternetConnectA" _
            (ByVal hInternetSession As Long, _
             ByVal lpszServerName As String, _
             ByVal nProxyPort As Integer, _
             ByVal lpszUsername As String, _
             ByVal lpszPassword As String, _
             ByVal dwService As Long, _
             ByVal dwFlags As Long, _
             ByVal dwContext As Long) As Long

Private Declare Function InternetReadFile Lib "wininet.dll" _
            (ByVal hFile As Long, _
             ByVal sBuffer As String, _
             ByVal lNumBytesToRead As Long, _
             lNumberOfBytesRead As Long) As Integer

Private Declare Function HttpOpenRequest Lib "wininet.dll" _
            Alias "HttpOpenRequestA" _
            (ByVal hInternetSession As Long, _
             ByVal lpszVerb As String, _
             ByVal lpszObjectName As String, _
             ByVal lpszVersion As String, _
             ByVal lpszReferer As String, _
             ByVal lpszAcceptTypes As Long, _
             ByVal dwFlags As Long, _
             ByVal dwContext As Long) As Long

Private Declare Function HttpSendRequest Lib "wininet.dll" _
            Alias "HttpSendRequestA" _
            (ByVal hHttpRequest As Long, _
             ByVal sHeaders As String, _
             ByVal lHeadersLength As Long, _
             ByVal sOptional As String, _
             ByVal lOptionalLength As Long) As Boolean

Private Declare Function InternetCloseHandle Lib "wininet.dll" _
            (ByVal hInternetHandle As Long) As Boolean

Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" _
             Alias "HttpAddRequestHeadersA" _
             (ByVal hHttpRequest As Long, _
             ByVal sHeaders As String, _
             ByVal lHeadersLength As Long, _
             ByVal lModifiers As Long) As Integer


Private Sub Command1_Click()
 Dim dataToSend As String
 Dim dataReceived As String
 
 ' some dummy data to send to our web service
 dataToSend = "<SomeXMLElement>SomeXMLvalue</SomeXMLElement>"
 dataReceived = PostInfo(dataToSend)
 
 MsgBox dataReceived, vbExclamation
End Sub

Public Function PostInfo$(postdat$)

  Dim hInternetConnect As Long
  Dim hHttpOpenRequest As Long
  Dim bRet As Boolean
  
  hInternetOpen = 0
  hInternetConnect = 0
  hHttpOpenRequest = 0
  
  On Error GoTo ErrorHandler
  
  Const INTERNET_OPEN_TYPE_PRECONFIG = 0

  'Open a HTTP connection
  hInternetOpen = InternetOpen("http generic", _
                  INTERNET_OPEN_TYPE_PRECONFIG, _
                  vbNullString, _
                  vbNullString, _
                  0)
  
  If hInternetOpen <> 0 Then
     'Type of service to access.
     Const INTERNET_SERVICE_HTTP = 3
     Const INTERNET_DEFAULT_HTTP_PORT = 8080

     ' connect to the remote HTTP server
     hInternetConnect = InternetConnect(hInternetOpen, _
                        "localhost", _
                        INTERNET_DEFAULT_HTTP_PORT, _
                        "", _
                        "", _
                        INTERNET_SERVICE_HTTP, _
                        0, _
                        0)
  
     If hInternetConnect <> 0 Then

      'Build the required making sure that we ignore any local caches
       Const INTERNET_FLAG_RELOAD = &H80000000
       hHttpOpenRequest = HttpOpenRequest(hInternetConnect, _
                           "POST", _
                           "/soap/servlet/rpcrouter", _
                           "HTTP/1.0", _
                           vbNullString, _
                           0, _
                           INTERNET_FLAG_RELOAD, _
                           0)
  
        If hHttpOpenRequest <> 0 Then
           ' build the request header
           Dim sHeader As String
           Const HTTP_ADDREQ_FLAG_ADD = &H20000000
           Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000
           sHeader = "Content-Type: text/xml" & vbCrLf
           bRet = HttpAddRequestHeaders(hHttpOpenRequest, _
                  sHeader, _
                  Len(sHeader), _
                  HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
            
            If (bRet = False) Then
             GoTo ErrorHandler
            End If
  
           ' build the request body
           Dim lpszPostData As String
           Dim lPostDataLen As Long
  
           lpszPostData = "<?xml version='1.0' encoding='UTF-8'?>" & _
                          "<SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" " & _
                          "xmlns:xsi=""http://www.w3.org/1999/XMLSchema-instance"" " & _
                          "xmlns:xsd=""http://www.w3.org/1999/XMLSchema"">" & _
                          "<SOAP-ENV:Body>" & _
                          "<ns1:sendMessage xmlns:ns1=""urn:B2BService"" 			                                                   SOAP-ENV:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/"">" & _
                          "<stringDocument SOAP-ENV:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/"">" & _
                          postdat$ & _
                          "</stringDocument>" & _
                          "</ns1:sendMessage>" & _
                          "</SOAP-ENV:Body>" & _
                          "</SOAP-ENV:Envelope>"

           lPostDataLen = Len(lpszPostData)
           
           ' fire the request off to the remote server
           bRet = HttpSendRequest(hHttpOpenRequest, _
                  vbNullString, _
                  0, _
                  lpszPostData, _
                  lPostDataLen)
        
            If (bRet = False) Then
             GoTo ErrorHandler
            End If
  
           ' read the response
           Dim bDoLoop             As Boolean
           Dim sReadBuffer         As String * 2048
           Dim lNumberOfBytesRead  As Long
           Dim sBuffer             As String
           bDoLoop = True
           While bDoLoop
            sReadBuffer = vbNullString
            bDoLoop = InternetReadFile(hHttpOpenRequest, _
                      sReadBuffer, _
                      Len(sReadBuffer), _
                      lNumberOfBytesRead)
            sBuffer = sBuffer & Left(sReadBuffer, lNumberOfBytesRead)
            If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
           Wend
           PostInfo = sBuffer
           bRet = InternetCloseHandle(hHttpOpenRequest)
        Else
           PostInfo = "HttpOpenRequest failed"
        End If
        bRet = InternetCloseHandle(hInternetConnect)
     Else
        PostInfo = "InternetConnect failed"
     End If
     bRet = InternetCloseHandle(hInternetOpen)
  Else
    PostInfo = "InternetOpen failed"
  End If
  
   Exit Function
  
ErrorHandler:
    Dim errorDescription As String
    
    If (Err.LastDllError < 12000) Then
        errorDescription = "Unknown Error " & Err.LastDllError
    Else
        If (Err.LastDllError = 12003) Then
            errorDescription = "WinInet Error -" & Err.LastDllError & " - " & GetLastResponse()
        Else
            errorDescription = "WinInet Error -" & Err.LastDllError & " - " & GetWinInetErrDesc(Err.LastDllError)
        End If
    End If
    
    MsgBox errorDescription, vbExclamation

End Function


Public Function GetWinInetErrDesc(dError As Long) As String
    Dim dwLength As Long
    Dim strBuffer As String * 257
    Dim hModule As Long

    hModule = GetModuleHandle("wininet.dll")
    
    Const FORMAT_MESSAGE_FROM_HMODULE = &H800

    dwLength = FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, _
                             ByVal hModule, _
                             dError, _
                             0&, _
                             ByVal strBuffer, _
                             256&, _
                             0&)

    If dwLength > 0 Then
        GetWinInetErrDesc = Left(strBuffer, dwLength - 2)
    End If
End Function


Private Function GetLastResponse() As String
'This function retrieves last server response.
    Dim lError As Long
    Dim strBuffer As String
    Dim lBufferSize As Long
    Dim retVal As Long

    retVal = InternetGetLastResponseInfo(lError, _
                                         strBuffer, _
                                         lBufferSize)
    strBuffer = String(lBufferSize + 1, 0)
    retVal = InternetGetLastResponseInfo(lError, _
                                         strBuffer, _
                                         lBufferSize)
    GetLastResponse = strBuffer
End Function