Electron-x/WinINet.bas

## WinINet.bas
Option Explicit
#Const conDebug = 0 ' <0|1>
#Const conHostApplication = "Excel" ' <"Access"|"Excel"|"Word">

' This VBA module for Microsoft Excel, Word, and Access provides functions for accessing Internet resources through the Microsoft
' Windows Internet API (WinINet) as an low-level alternative to using MSXML2.XMLHTTP60 from the Microsoft XML v6.0 object library.
'
' UrlEncode:        Encodes a string using percent-encoding
' GetErrorMessage:  Obtains the error message string for a given system error code
' InternetRequest:  Requests an Internet resource via FTP, HTTP or HTTPS and returns it as a string
' HttpRequest:      Sends a Web request via HTTP or HTTPS and returns the response in a string
'

' Windows API declarations
Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Const INTERNET_ERROR_BASE = 12000
Const INTERNET_ERROR_LAST = 12999

Const ERROR_SUCCESS = 0
Const ERROR_INTERNET_FORCE_RETRY = 12032

Const INTERNET_NO_CALLBACK = 0
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Const INTERNET_FLAG_SECURE = &H800000
Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Const INTERNET_FLAG_RELOAD = &H80000000
Const INTERNET_SERVICE_HTTP = 3
Const INTERNET_DEFAULT_HTTP_PORT = 80
Const INTERNET_DEFAULT_HTTPS_PORT = 443
Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6

Const HTTP_QUERY_STATUS_CODE = 19
Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Const HTTP_QUERY_FLAG_NUMBER = &H20000000
Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

Const FLAGS_ERROR_UI_FILTER_FOR_ERRORS = &H1
Const FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS = &H2
Const FLAGS_ERROR_UI_FLAGS_GENERATE_DATA = &H4

Private Declare Function GetActiveWindow Lib "user32" () As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal 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 InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxy As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, ByVal lpBuffer As Any, ByVal dwBufferLength As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternet As Long, ByVal lpszServerName As String, ByVal nServerPort 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 InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, ByRef lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Any, ByVal dwNumberOfBytesToRead As Long, ByRef lpdwNumberOfBytesRead As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInternet As Long) As Long
Private Declare Function InternetErrorDlg Lib "wininet.dll" (ByVal hWnd As Long, ByVal hRequest As Long, ByVal dwError As Long, ByVal dwFlags As Long, ByRef lppvData As Any) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hConnect As Long, ByVal lpszVerb As String, ByVal lpszObjectName As String, ByVal lpszVersion As String, ByVal lpszReferrer As String, ByVal lplpszAcceptTypes As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwModifiers As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal lpOptional As Any, ByVal dwOptionalLength As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpBuffer As Any, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long

' GetWindowHandle function
'
' Determines the window handle of the host application
'
Private Function GetWindowHandle()
#If conHostApplication = "Excel" Then
    GetWindowHandle = Application.hWnd
#ElseIf conHostApplication = "Word" Then
    GetWindowHandle = GetActiveWindow
#ElseIf conHostApplication = "Access" Then
    GetWindowHandle = Application.hWndAccessApp
#End If
End Function

' DebugPrintHeaders procedure
'
' Retrieves and displays the request and response headers
'
Private Sub DebugPrintHeaders(ByVal lngRequest As Long)
    Dim lngFlags As Long
    Dim lngSize As Long
    Dim lngIndex As Long
    Dim strBuffer As String * 8192

    lngIndex = 0
    lngSize = Len(strBuffer)
    lngFlags = HTTP_QUERY_RAW_HEADERS_CRLF Or HTTP_QUERY_FLAG_REQUEST_HEADERS

    ' Retrieves the request headers
    If HttpQueryInfo(lngRequest, lngFlags, ByVal strBuffer, lngSize, lngIndex) Then
        Debug.Print "Request Headers:" & vbCrLf & Left$(strBuffer, lngSize)
    End If

    lngIndex = 0
    lngSize = Len(strBuffer)
    lngFlags = HTTP_QUERY_RAW_HEADERS_CRLF

    ' Retrieves the response headers
    If HttpQueryInfo(lngRequest, lngFlags, ByVal strBuffer, lngSize, lngIndex) Then
        Debug.Print "Response Headers:" & vbCrLf & Left$(strBuffer, lngSize)
    End If
End Sub

' UrlEncode function
'
' Encodes a string using percent-encoding. Required for form data because the Excel method WorksheetFunction.EncodeUrl cannot encode
' the space as a plus sign. Source: https://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba/24301379
'
Public Function UrlEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
    Dim StringLen As Long
    StringLen = Len(StringVal)

    If StringLen > 0 Then
        ReDim Result(StringLen) As String
        Dim i As Long, CharCode As Integer
        Dim Char As String, Space As String

        If SpaceAsPlus Then Space = "+" Else Space = "%20"

        For i = 1 To StringLen
            Char = Mid$(StringVal, i, 1)
            CharCode = Asc(Char)
            Select Case CharCode
                Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                    Result(i) = Char
                Case 32
                    Result(i) = Space
                Case 0 To 15
                    Result(i) = "%0" & Hex(CharCode)
                Case Else
                    Result(i) = "%" & Hex(CharCode)
            End Select
        Next i
        UrlEncode = Join(Result, "")
    End If
End Function

' GetErrorMessage function
'
' Returns the error message string for a given system error code.
' Supports additional error messages from the WinINet module.
'
Public Function GetErrorMessage(ByVal lngMessageId As Long) As String
    Const BUFFER_SIZE As Long = 512

    Dim lngFlags As Long
    Dim lngSource As Long
    Dim strBuffer As String
    Dim lngLen As Long

    lngFlags = FORMAT_MESSAGE_IGNORE_INSERTS
    If lngMessageId < INTERNET_ERROR_BASE Or lngMessageId > INTERNET_ERROR_LAST Then
        lngFlags = lngFlags Or FORMAT_MESSAGE_FROM_SYSTEM
    Else
        lngFlags = lngFlags Or FORMAT_MESSAGE_FROM_HMODULE
    End If

    strBuffer = String$(BUFFER_SIZE, vbNullChar)
    lngSource = GetModuleHandle("wininet.dll")

    lngLen = FormatMessage(lngFlags, lngSource, lngMessageId, 0, strBuffer, BUFFER_SIZE, 0)

    GetErrorMessage = Left$(strBuffer, lngLen)
End Function

' InternetRequest function
'
' Requests an Internet resource via FTP, HTTP or HTTPS and returns it as a string.
' This function is suitable for simple downloading of individual web pages
' and text files from the Internet. There is no support for authentication.
'
' Parameters:
'   lngStatus = [out] Receives the HTTP status code sent by the server
'   strData = [out] Receives the user data transmitted by the server
'   strUrl = [in] Complete URL of the resource you want to download
'
' Return value:
'   System error code (or 0 for success)
'
Public Function InternetRequest(lngStatus As Long, strData As String, ByVal strUrl As String) As Long
    Const TIMEOUT As Long = 10000   ' 10 seconds

    lngStatus = 0
    strData = ""

    Dim lngInternet As Long
    Dim lngInternetFile As Long

    lngInternet = 0
    lngInternetFile = 0

    On Error GoTo ExitFunction

    ' Initialization of the WinINet functions
    lngInternet = InternetOpen(Application.Name & "/" & Application.Version, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If lngInternet = 0 Then
        InternetRequest = Err.LastDllError
        Exit Function
    End If

    Dim lngTimeout As Long
    lngTimeout = TIMEOUT

    ' Set timeout values
    Call InternetSetOption(lngInternet, INTERNET_OPTION_CONNECT_TIMEOUT, lngTimeout, Len(lngTimeout))
    Call InternetSetOption(lngInternet, INTERNET_OPTION_RECEIVE_TIMEOUT, lngTimeout, Len(lngTimeout))

    ' Open the URL resource
    lngInternetFile = InternetOpenUrl(lngInternet, strUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, INTERNET_NO_CALLBACK)
    If lngInternetFile = 0 Then
        InternetRequest = Err.LastDllError
        GoTo ExitFunction
    End If

    Dim lngIndex As Long
    Dim lngLenStatus As Long

    lngIndex = 0
    lngLenStatus = Len(lngStatus)

    ' Retrieve the HTTP status code
    If HttpQueryInfo(lngInternetFile, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, lngStatus, lngLenStatus, lngIndex) = 0 Then
        InternetRequest = Err.LastDllError
        GoTo ExitFunction
    End If

#If conDebug = 1 Then
    ' Print the request and response headers
    DebugPrintHeaders lngInternetFile
#End If

    Dim lngNumberOfBytesAvailable As Long
    lngNumberOfBytesAvailable = 0

    ' Determine the number of bytes that can be read immediately by InternetReadFile
    If InternetQueryDataAvailable(lngInternetFile, lngNumberOfBytesAvailable, 0, 0) = 0 Then
        InternetRequest = Err.LastDllError
        GoTo ExitFunction
    End If

    If lngNumberOfBytesAvailable > 0 Then
        Dim strBuffer As String
        Dim lngNumberOfBytesRead As Long

        strBuffer = String$(lngNumberOfBytesAvailable, vbNullChar)
        lngNumberOfBytesRead = 0

        Do
            ' Transfer the data
            If InternetReadFile(lngInternetFile, strBuffer, lngNumberOfBytesAvailable, lngNumberOfBytesRead) = 0 Then
                InternetRequest = Err.LastDllError
                GoTo ExitFunction
            End If

            If lngNumberOfBytesRead = 0 Then Exit Do

            strData = strData & Left$(strBuffer, lngNumberOfBytesRead)
        Loop While lngNumberOfBytesRead <> 0
    End If

    InternetRequest = ERROR_SUCCESS

ExitFunction:
    If lngInternetFile <> 0 Then Call InternetCloseHandle(lngInternetFile)
    If lngInternet <> 0 Then Call InternetCloseHandle(lngInternet)
End Function

' HttpRequest function
'
' Sends a Web request via HTTP or HTTPS and returns the response in a string.
' This function supports HTTP authentication and submitting of form data.
' Before you access the received user data, you should first check whether the function
' returns ERROR_SUCCESS and then check whether the HTTP status code is 200 (OK).
'
' Parameters:
'   lngStatus = [out] Receives the HTTP status code sent by the server
'   strData = [out] Receives the user data transmitted by the server
'   bUseSSL = [in] Specifies whether the data is to be transmitted encrypted
'   strHost = [in] Host name of the Internet server (e.g. www.microsoft.com)
'   strResource = [in, opt] Target file of the specified HTTP verb (e.g. /path/index.html)
'   strMethod = [in, opt] The HTTP verb to be used in the request (GET, POST)
'   strForm = [in, opt] Optional form data transferred to the server (for POST operations)
'   strUser = [in, opt] The name of the user to be logged in
'   strPass = [in, opt] The password used to log in
'
' Return value:
'   System error code (or 0 for success)
'
Public Function HttpRequest(lngStatus As Long, strData As String, ByVal bUseSSL As Boolean, ByVal strHost As String, Optional ByVal strResource As String = "/", _
    Optional ByVal strMethod As String = "GET", Optional ByVal strForm As String = "", Optional ByVal strUser As String = "", Optional ByVal strPass As String = "") As Long
    Const TIMEOUT As Long = 10000   ' 10 seconds

    Dim lngError As Long
    Dim lngSuccess As Long
    Dim lngInternet As Long
    Dim lngConnect As Long
    Dim lngRequest As Long
    Dim lngFlags As Long

    lngError = ERROR_SUCCESS

    lngStatus = 0
    strData = ""

    lngInternet = 0
    lngConnect = 0
    lngRequest = 0

    On Error GoTo ExitFunction

    Dim strUserAgent As String
    strUserAgent = Application.Name & "/" & Application.Version

    ' Initialization of the WinINet functions
    lngInternet = InternetOpen(strUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If lngInternet = 0 Then
        HttpRequest = Err.LastDllError
        Exit Function
    End If

    Dim lngTimeout As Long
    lngTimeout = TIMEOUT

    ' Set timeout values
    Call InternetSetOption(lngInternet, INTERNET_OPTION_CONNECT_TIMEOUT, lngTimeout, Len(lngTimeout))
    Call InternetSetOption(lngInternet, INTERNET_OPTION_RECEIVE_TIMEOUT, lngTimeout, Len(lngTimeout))

    Dim intPort As Integer
    intPort = IIf(bUseSSL, INTERNET_DEFAULT_HTTPS_PORT, INTERNET_DEFAULT_HTTP_PORT)

    ' Open the HTTP session
    lngConnect = InternetConnect(lngInternet, strHost, intPort, strUser, strPass, INTERNET_SERVICE_HTTP, 0, INTERNET_NO_CALLBACK)
    If lngConnect = 0 Then
        HttpRequest = Err.LastDllError
        GoTo ExitFunction
    End If

    lngFlags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
    If bUseSSL Then lngFlags = lngFlags Or INTERNET_FLAG_SECURE

    ' Create a HTTP request handle
    lngRequest = HttpOpenRequest(lngConnect, strMethod, strResource, vbNullString, vbNullString, vbNullString, lngFlags, INTERNET_NO_CALLBACK)
    If lngRequest = 0 Then
        HttpRequest = Err.LastDllError
        GoTo ExitFunction
    End If

    Dim strHeaders As String
    lngFlags = HTTP_ADDREQ_FLAG_ADD Or HTTP_ADDREQ_FLAG_REPLACE

    ' Add HTTP request headers
    strHeaders = "Accept: text/*" & vbCrLf
    lngSuccess = HttpAddRequestHeaders(lngRequest, strHeaders, Len(strHeaders), lngFlags)

    Dim lngIndex As Long
    Dim lngLenStatus As Long
    Dim lngLenForm As Long

    lngLenForm = Len(strForm)
    strHeaders = IIf(lngLenForm > 0, "Content-Type: application/x-www-form-urlencoded" & vbCrLf, "")

    Do
        lngError = ERROR_SUCCESS
        ' Send the request to the HTTP server
        lngSuccess = HttpSendRequest(lngRequest, strHeaders, Len(strHeaders), strForm, lngLenForm)
        ' Save the error code for passing to InternetErrorDlg
        If lngSuccess = 0 Then lngError = Err.LastDllError

        lngIndex = 0
        lngLenStatus = Len(lngStatus)

        ' Retrieve the HTTP status code
        Call HttpQueryInfo(lngRequest, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, lngStatus, lngLenStatus, lngIndex)

#If conDebug = 1 Then
        ' Print the request and response headers
        DebugPrintHeaders lngRequest
#End If

        lngFlags = FLAGS_ERROR_UI_FILTER_FOR_ERRORS Or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS Or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
        ' If necessary, display authentication or certificate error dialog boxes
        lngSuccess = InternetErrorDlg(GetWindowHandle, lngRequest, lngError, lngFlags, vbNullString)
    Loop While lngSuccess = ERROR_INTERNET_FORCE_RETRY

    If lngSuccess <> ERROR_SUCCESS Or lngError <> ERROR_SUCCESS Then
        HttpRequest = IIf(lngSuccess <> ERROR_SUCCESS, lngSuccess, lngError)
        GoTo ExitFunction
    End If

    Dim lngNumberOfBytesAvailable As Long
    lngNumberOfBytesAvailable = 0

    ' Determine the number of bytes that can be read immediately by InternetReadFile
    If InternetQueryDataAvailable(lngRequest, lngNumberOfBytesAvailable, 0, 0) = 0 Then
        HttpRequest = Err.LastDllError
        GoTo ExitFunction
    End If

    If lngNumberOfBytesAvailable > 0 Then
        Dim strBuffer As String
        Dim lngNumberOfBytesRead As Long

        strBuffer = String$(lngNumberOfBytesAvailable, vbNullChar)
        lngNumberOfBytesRead = 0

        Do
            ' Transfer the data
            If InternetReadFile(lngRequest, strBuffer, lngNumberOfBytesAvailable, lngNumberOfBytesRead) = 0 Then
                HttpRequest = Err.LastDllError
                GoTo ExitFunction
            End If

            If lngNumberOfBytesRead = 0 Then Exit Do

            strData = strData & Left$(strBuffer, lngNumberOfBytesRead)
        Loop While lngNumberOfBytesRead <> 0
    End If

    HttpRequest = ERROR_SUCCESS

ExitFunction:
    If lngRequest <> 0 Then Call InternetCloseHandle(lngRequest)
    If lngConnect <> 0 Then Call InternetCloseHandle(lngConnect)
    If lngInternet <> 0 Then Call InternetCloseHandle(lngInternet)
End Function
	Option Explicit
	#Const conDebug = 0 ' <0\|1>
	#Const conHostApplication = "Excel" ' <"Access"\|"Excel"\|"Word">

	' This VBA module for Microsoft Excel, Word, and Access provides functions for accessing Internet resources through the Microsoft
	' Windows Internet API (WinINet) as an low-level alternative to using MSXML2.XMLHTTP60 from the Microsoft XML v6.0 object library.
	'
	' UrlEncode: Encodes a string using percent-encoding
	' GetErrorMessage: Obtains the error message string for a given system error code
	' InternetRequest: Requests an Internet resource via FTP, HTTP or HTTPS and returns it as a string
	' HttpRequest: Sends a Web request via HTTP or HTTPS and returns the response in a string
	'

	' Windows API declarations
	Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
	Const FORMAT_MESSAGE_FROM_HMODULE = &H800
	Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

	Const INTERNET_ERROR_BASE = 12000
	Const INTERNET_ERROR_LAST = 12999

	Const ERROR_SUCCESS = 0
	Const ERROR_INTERNET_FORCE_RETRY = 12032

	Const INTERNET_NO_CALLBACK = 0
	Const INTERNET_OPEN_TYPE_PRECONFIG = 0
	Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
	Const INTERNET_FLAG_SECURE = &H800000
	Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
	Const INTERNET_FLAG_RELOAD = &H80000000
	Const INTERNET_SERVICE_HTTP = 3
	Const INTERNET_DEFAULT_HTTP_PORT = 80
	Const INTERNET_DEFAULT_HTTPS_PORT = 443
	Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
	Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6

	Const HTTP_QUERY_STATUS_CODE = 19
	Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
	Const HTTP_QUERY_FLAG_NUMBER = &H20000000
	Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
	Const HTTP_ADDREQ_FLAG_ADD = &H20000000
	Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

	Const FLAGS_ERROR_UI_FILTER_FOR_ERRORS = &H1
	Const FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS = &H2
	Const FLAGS_ERROR_UI_FLAGS_GENERATE_DATA = &H4

	Private Declare Function GetActiveWindow Lib "user32" () As Long

	Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
	Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal 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 InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxy As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
	Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
	Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, ByVal lpBuffer As Any, ByVal dwBufferLength As Long) As Long
	Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternet As Long, ByVal lpszServerName As String, ByVal nServerPort 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 InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, ByRef lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
	Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Any, ByVal dwNumberOfBytesToRead As Long, ByRef lpdwNumberOfBytesRead As Long) As Long
	Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInternet As Long) As Long
	Private Declare Function InternetErrorDlg Lib "wininet.dll" (ByVal hWnd As Long, ByVal hRequest As Long, ByVal dwError As Long, ByVal dwFlags As Long, ByRef lppvData As Any) As Long
	Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hConnect As Long, ByVal lpszVerb As String, ByVal lpszObjectName As String, ByVal lpszVersion As String, ByVal lpszReferrer As String, ByVal lplpszAcceptTypes As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
	Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwModifiers As Long) As Long
	Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal lpOptional As Any, ByVal dwOptionalLength As Long) As Long
	Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpBuffer As Any, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long

	' GetWindowHandle function
	'
	' Determines the window handle of the host application
	'
	Private Function GetWindowHandle()
	#If conHostApplication = "Excel" Then
	GetWindowHandle = Application.hWnd
	#ElseIf conHostApplication = "Word" Then
	GetWindowHandle = GetActiveWindow
	#ElseIf conHostApplication = "Access" Then
	GetWindowHandle = Application.hWndAccessApp
	#End If
	End Function

	' DebugPrintHeaders procedure
	'
	' Retrieves and displays the request and response headers
	'
	Private Sub DebugPrintHeaders(ByVal lngRequest As Long)
	Dim lngFlags As Long
	Dim lngSize As Long
	Dim lngIndex As Long
	Dim strBuffer As String * 8192

	lngIndex = 0
	lngSize = Len(strBuffer)
	lngFlags = HTTP_QUERY_RAW_HEADERS_CRLF Or HTTP_QUERY_FLAG_REQUEST_HEADERS

	' Retrieves the request headers
	If HttpQueryInfo(lngRequest, lngFlags, ByVal strBuffer, lngSize, lngIndex) Then
	Debug.Print "Request Headers:" & vbCrLf & Left$(strBuffer, lngSize)
	End If

	lngIndex = 0
	lngSize = Len(strBuffer)
	lngFlags = HTTP_QUERY_RAW_HEADERS_CRLF

	' Retrieves the response headers
	If HttpQueryInfo(lngRequest, lngFlags, ByVal strBuffer, lngSize, lngIndex) Then
	Debug.Print "Response Headers:" & vbCrLf & Left$(strBuffer, lngSize)
	End If
	End Sub

	' UrlEncode function
	'
	' Encodes a string using percent-encoding. Required for form data because the Excel method WorksheetFunction.EncodeUrl cannot encode
	' the space as a plus sign. Source: https://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba/24301379
	'
	Public Function UrlEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
	Dim StringLen As Long
	StringLen = Len(StringVal)

	If StringLen > 0 Then
	ReDim Result(StringLen) As String
	Dim i As Long, CharCode As Integer
	Dim Char As String, Space As String

	If SpaceAsPlus Then Space = "+" Else Space = "%20"

	For i = 1 To StringLen
	Char = Mid$(StringVal, i, 1)
	CharCode = Asc(Char)
	Select Case CharCode
	Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
	Result(i) = Char
	Case 32
	Result(i) = Space
	Case 0 To 15
	Result(i) = "%0" & Hex(CharCode)
	Case Else
	Result(i) = "%" & Hex(CharCode)
	End Select
	Next i
	UrlEncode = Join(Result, "")
	End If
	End Function

	' GetErrorMessage function
	'
	' Returns the error message string for a given system error code.
	' Supports additional error messages from the WinINet module.
	'
	Public Function GetErrorMessage(ByVal lngMessageId As Long) As String
	Const BUFFER_SIZE As Long = 512

	Dim lngFlags As Long
	Dim lngSource As Long
	Dim strBuffer As String
	Dim lngLen As Long

	lngFlags = FORMAT_MESSAGE_IGNORE_INSERTS
	If lngMessageId < INTERNET_ERROR_BASE Or lngMessageId > INTERNET_ERROR_LAST Then
	lngFlags = lngFlags Or FORMAT_MESSAGE_FROM_SYSTEM
	Else
	lngFlags = lngFlags Or FORMAT_MESSAGE_FROM_HMODULE
	End If

	strBuffer = String$(BUFFER_SIZE, vbNullChar)
	lngSource = GetModuleHandle("wininet.dll")

	lngLen = FormatMessage(lngFlags, lngSource, lngMessageId, 0, strBuffer, BUFFER_SIZE, 0)

	GetErrorMessage = Left$(strBuffer, lngLen)
	End Function

	' InternetRequest function
	'
	' Requests an Internet resource via FTP, HTTP or HTTPS and returns it as a string.
	' This function is suitable for simple downloading of individual web pages
	' and text files from the Internet. There is no support for authentication.
	'
	' Parameters:
	' lngStatus = [out] Receives the HTTP status code sent by the server
	' strData = [out] Receives the user data transmitted by the server
	' strUrl = [in] Complete URL of the resource you want to download
	'
	' Return value:
	' System error code (or 0 for success)
	'
	Public Function InternetRequest(lngStatus As Long, strData As String, ByVal strUrl As String) As Long
	Const TIMEOUT As Long = 10000 ' 10 seconds

	lngStatus = 0
	strData = ""

	Dim lngInternet As Long
	Dim lngInternetFile As Long

	lngInternet = 0
	lngInternetFile = 0

	On Error GoTo ExitFunction

	' Initialization of the WinINet functions
	lngInternet = InternetOpen(Application.Name & "/" & Application.Version, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
	If lngInternet = 0 Then
	InternetRequest = Err.LastDllError
	Exit Function
	End If

	Dim lngTimeout As Long
	lngTimeout = TIMEOUT

	' Set timeout values
	Call InternetSetOption(lngInternet, INTERNET_OPTION_CONNECT_TIMEOUT, lngTimeout, Len(lngTimeout))
	Call InternetSetOption(lngInternet, INTERNET_OPTION_RECEIVE_TIMEOUT, lngTimeout, Len(lngTimeout))

	' Open the URL resource
	lngInternetFile = InternetOpenUrl(lngInternet, strUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, INTERNET_NO_CALLBACK)
	If lngInternetFile = 0 Then
	InternetRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	Dim lngIndex As Long
	Dim lngLenStatus As Long

	lngIndex = 0
	lngLenStatus = Len(lngStatus)

	' Retrieve the HTTP status code
	If HttpQueryInfo(lngInternetFile, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, lngStatus, lngLenStatus, lngIndex) = 0 Then
	InternetRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	#If conDebug = 1 Then
	' Print the request and response headers
	DebugPrintHeaders lngInternetFile
	#End If

	Dim lngNumberOfBytesAvailable As Long
	lngNumberOfBytesAvailable = 0

	' Determine the number of bytes that can be read immediately by InternetReadFile
	If InternetQueryDataAvailable(lngInternetFile, lngNumberOfBytesAvailable, 0, 0) = 0 Then
	InternetRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	If lngNumberOfBytesAvailable > 0 Then
	Dim strBuffer As String
	Dim lngNumberOfBytesRead As Long

	strBuffer = String$(lngNumberOfBytesAvailable, vbNullChar)
	lngNumberOfBytesRead = 0

	Do
	' Transfer the data
	If InternetReadFile(lngInternetFile, strBuffer, lngNumberOfBytesAvailable, lngNumberOfBytesRead) = 0 Then
	InternetRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	If lngNumberOfBytesRead = 0 Then Exit Do

	strData = strData & Left$(strBuffer, lngNumberOfBytesRead)
	Loop While lngNumberOfBytesRead <> 0
	End If

	InternetRequest = ERROR_SUCCESS

	ExitFunction:
	If lngInternetFile <> 0 Then Call InternetCloseHandle(lngInternetFile)
	If lngInternet <> 0 Then Call InternetCloseHandle(lngInternet)
	End Function

	' HttpRequest function
	'
	' Sends a Web request via HTTP or HTTPS and returns the response in a string.
	' This function supports HTTP authentication and submitting of form data.
	' Before you access the received user data, you should first check whether the function
	' returns ERROR_SUCCESS and then check whether the HTTP status code is 200 (OK).
	'
	' Parameters:
	' lngStatus = [out] Receives the HTTP status code sent by the server
	' strData = [out] Receives the user data transmitted by the server
	' bUseSSL = [in] Specifies whether the data is to be transmitted encrypted
	' strHost = [in] Host name of the Internet server (e.g. www.microsoft.com)
	' strResource = [in, opt] Target file of the specified HTTP verb (e.g. /path/index.html)
	' strMethod = [in, opt] The HTTP verb to be used in the request (GET, POST)
	' strForm = [in, opt] Optional form data transferred to the server (for POST operations)
	' strUser = [in, opt] The name of the user to be logged in
	' strPass = [in, opt] The password used to log in
	'
	' Return value:
	' System error code (or 0 for success)
	'
	Public Function HttpRequest(lngStatus As Long, strData As String, ByVal bUseSSL As Boolean, ByVal strHost As String, Optional ByVal strResource As String = "/", _
	Optional ByVal strMethod As String = "GET", Optional ByVal strForm As String = "", Optional ByVal strUser As String = "", Optional ByVal strPass As String = "") As Long
	Const TIMEOUT As Long = 10000 ' 10 seconds

	Dim lngError As Long
	Dim lngSuccess As Long
	Dim lngInternet As Long
	Dim lngConnect As Long
	Dim lngRequest As Long
	Dim lngFlags As Long

	lngError = ERROR_SUCCESS

	lngStatus = 0
	strData = ""

	lngInternet = 0
	lngConnect = 0
	lngRequest = 0

	On Error GoTo ExitFunction

	Dim strUserAgent As String
	strUserAgent = Application.Name & "/" & Application.Version

	' Initialization of the WinINet functions
	lngInternet = InternetOpen(strUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
	If lngInternet = 0 Then
	HttpRequest = Err.LastDllError
	Exit Function
	End If

	Dim lngTimeout As Long
	lngTimeout = TIMEOUT

	' Set timeout values
	Call InternetSetOption(lngInternet, INTERNET_OPTION_CONNECT_TIMEOUT, lngTimeout, Len(lngTimeout))
	Call InternetSetOption(lngInternet, INTERNET_OPTION_RECEIVE_TIMEOUT, lngTimeout, Len(lngTimeout))

	Dim intPort As Integer
	intPort = IIf(bUseSSL, INTERNET_DEFAULT_HTTPS_PORT, INTERNET_DEFAULT_HTTP_PORT)

	' Open the HTTP session
	lngConnect = InternetConnect(lngInternet, strHost, intPort, strUser, strPass, INTERNET_SERVICE_HTTP, 0, INTERNET_NO_CALLBACK)
	If lngConnect = 0 Then
	HttpRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	lngFlags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
	If bUseSSL Then lngFlags = lngFlags Or INTERNET_FLAG_SECURE

	' Create a HTTP request handle
	lngRequest = HttpOpenRequest(lngConnect, strMethod, strResource, vbNullString, vbNullString, vbNullString, lngFlags, INTERNET_NO_CALLBACK)
	If lngRequest = 0 Then
	HttpRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	Dim strHeaders As String
	lngFlags = HTTP_ADDREQ_FLAG_ADD Or HTTP_ADDREQ_FLAG_REPLACE

	' Add HTTP request headers
	strHeaders = "Accept: text/*" & vbCrLf
	lngSuccess = HttpAddRequestHeaders(lngRequest, strHeaders, Len(strHeaders), lngFlags)

	Dim lngIndex As Long
	Dim lngLenStatus As Long
	Dim lngLenForm As Long

	lngLenForm = Len(strForm)
	strHeaders = IIf(lngLenForm > 0, "Content-Type: application/x-www-form-urlencoded" & vbCrLf, "")

	Do
	lngError = ERROR_SUCCESS
	' Send the request to the HTTP server
	lngSuccess = HttpSendRequest(lngRequest, strHeaders, Len(strHeaders), strForm, lngLenForm)
	' Save the error code for passing to InternetErrorDlg
	If lngSuccess = 0 Then lngError = Err.LastDllError

	lngIndex = 0
	lngLenStatus = Len(lngStatus)

	' Retrieve the HTTP status code
	Call HttpQueryInfo(lngRequest, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, lngStatus, lngLenStatus, lngIndex)

	#If conDebug = 1 Then
	' Print the request and response headers
	DebugPrintHeaders lngRequest
	#End If

	lngFlags = FLAGS_ERROR_UI_FILTER_FOR_ERRORS Or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS Or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
	' If necessary, display authentication or certificate error dialog boxes
	lngSuccess = InternetErrorDlg(GetWindowHandle, lngRequest, lngError, lngFlags, vbNullString)
	Loop While lngSuccess = ERROR_INTERNET_FORCE_RETRY

	If lngSuccess <> ERROR_SUCCESS Or lngError <> ERROR_SUCCESS Then
	HttpRequest = IIf(lngSuccess <> ERROR_SUCCESS, lngSuccess, lngError)
	GoTo ExitFunction
	End If

	Dim lngNumberOfBytesAvailable As Long
	lngNumberOfBytesAvailable = 0

	' Determine the number of bytes that can be read immediately by InternetReadFile
	If InternetQueryDataAvailable(lngRequest, lngNumberOfBytesAvailable, 0, 0) = 0 Then
	HttpRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	If lngNumberOfBytesAvailable > 0 Then
	Dim strBuffer As String
	Dim lngNumberOfBytesRead As Long

	strBuffer = String$(lngNumberOfBytesAvailable, vbNullChar)
	lngNumberOfBytesRead = 0

	Do
	' Transfer the data
	If InternetReadFile(lngRequest, strBuffer, lngNumberOfBytesAvailable, lngNumberOfBytesRead) = 0 Then
	HttpRequest = Err.LastDllError
	GoTo ExitFunction
	End If

	If lngNumberOfBytesRead = 0 Then Exit Do

	strData = strData & Left$(strBuffer, lngNumberOfBytesRead)
	Loop While lngNumberOfBytesRead <> 0
	End If

	HttpRequest = ERROR_SUCCESS

	ExitFunction:
	If lngRequest <> 0 Then Call InternetCloseHandle(lngRequest)
	If lngConnect <> 0 Then Call InternetCloseHandle(lngConnect)
	If lngInternet <> 0 Then Call InternetCloseHandle(lngInternet)
	End Function