Public Function PostXML(sBuffer As String, strUrl As String, Optional sResponse As String) As String

Dim iRetVal     As Integer

Dim lBufferLen  As Long

Dim vDllVersion As tWinInetDLLVersion

Dim sStatus     As String

Dim sOptionBuffer   As String

Dim lOptionBufferLen As Long

Dim lblMajor As String

Dim lblMinor As String

Dim dwTimeOut As Long

Dim bDoLoop             As Boolean

Dim sReadBuffer         As String * 2048

Dim lNumberOfBytesRead  As Long

Dim sResponseBuffer             As String

'***************************************************

Const username As String = "demo22"

Const password As String = "demo22"

'Normally you would take the strUrl parameter and parse it but for example purposes we are using constants.

Const URL As String = "ups.com"

Const URLObject As String = "/ups.app/xml/TimeInTransit"

'This portion of the URL will not always have 'TimeInTransit' in it. The last 'word will change base on the tool you are using.

'***************************************************

'Set the Time out value for the INTERNET_OPTION_CONNECT_TIMEOUT, 'INTERNET_OPTION_RECEIVE_TIMEOUT,INTERNET_OPTION_SEND_TIMEOUT

dwTimeOut = 60000

If Len(Trim(strUrl)) <> 0 Then mvtxtUrl = strUrl

lBufferLen = Len(sBuffer)

hInternetSession = 0

hHttpOpenRequest = 0

hInternetConnect = 0

' Open session

hInternetSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, "proxy.ups.com:8080", vbNullString, 0)

If CBool(hInternetSession) Then

    'Set DLL Major/Minor version variables

    InternetQueryOption hInternetSession, INTERNET_OPTION_VERSION, vDllVersion, Len(vDllVersion)

    lblMajor = vDllVersion.lMajorVersion

    lblMinor = vDllVersion.lMinorVersion

   'Open Connection

    hInternetConnect = InternetConnect(hInternetSession, URL, INTERNET_DEFAULT_HTTPS_PORT, _

    vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)

    If hInternetConnect > 0 Then

            sOptionBuffer = sBuffer

            lOptionBufferLen = Len(sOptionBuffer)

            hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "POST", URLObject, "HTTP/1.0", vbNullString, 0, _

            INTERNET_FLAG_RELOAD Or INTERNET_FLAG_MULTIPART Or INTERNET_FLAG_SECURE Or INTERNET_FLAG_IGNORE_CERT_CN_INVALID Or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID, 0)

        If CBool(hHttpOpenRequest) Then

            sHeader = "Content-Length: " & lOptionBufferLen & vbCrLf

            iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)

            sHeader = "Accept-Language: en" & vbCrLf

            iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)

            sHeader = "Connection: Keep-Alive" & vbCrLf

            iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)

            sHeader = "Content-Type: application/x-www-form-urlencoded" & vbCrLf

            iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)

           iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PROXY_USERNAME, username, Len(username) + 1)

            iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PROXY_PASSWORD, password, Len(password) + 1)

            iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_CONNECT_TIMEOUT, dwTimeOut, 4)

            iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_RECEIVE_TIMEOUT, dwTimeOut, 4)

            iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_SEND_TIMEOUT, dwTimeOut, 4)

Resend:

            iRetVal = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, sOptionBuffer, lOptionBufferLen)

            Dim dwStatus As Long, dwStatusSize As Long

            dwStatusSize = Len(dwStatus)

            HttpQueryInfo hHttpOpenRequest, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, dwStatus, dwStatusSize, 0

            Select Case dwStatus

                Case HTTP_STATUS_PROXY_AUTH_REQ

'If you want to establish Proxy Authentication only when necessary 'you would place it here. The go to statement would resend the 'request with the Proxy Authentication.

                'GoTo Resend

              Case HTTP_STATUS_DENIED

                iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_USERNAME, _

        username, Len(username) + 1)

                iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PASSWORD, _

        password, Len(password) + 1)

            GoTo Resend

           End Select

       Else

            ' HttpOpenRequest failed

           sResponse = "HttpOpenRequest call failed; Error code: " & Err.LastDllError & "."

           PostXML = False

        End If

    Else

        ' InternetConnect failed

       sResponse = "InternetConnect call failed; Error code: " & Err.LastDllError & "."

        PostXML = False

    End If

Else

    ' hInternetSession handle not allocated

    sResponse = "InternetOpen call failed: Error code: " & Err.LastDllError & "."

    PostXML = False

End If

'This code will capture the response from the server and passes it back out through the sResponse variable

On Error GoTo ErrHand

bDoLoop = True

While bDoLoop

    sReadBuffer = vbNullString

    bDoLoop = InternetReadFile(hHttpOpenRequest, sReadBuffer, Len(sReadBuffer), TotalBytesRead)

    sResponseBuffer = sResponseBuffer & Left$(sReadBuffer, TotalBytesRead)

    If Not CBool(TotalBytesRead) Then bDoLoop = False

Wend

sResponse = sResponseBuffer

PostXML = True

Exit Function

ErrHand:

sResponse = "There was a problem processing the XML response."

PostXML = False

End Function