Excel-REST auto-proxy

ProxyDetect.bas

Attribute VB_Name = "ProxyDetect"
''
' Based on code shared by Stephen Sulzer
' https://groups.google.com/forum/#!topic/microsoft.public.winhttp/ZeWN2Xig82g
'
Option Explicit
Option Private Module

Public Function autoProxy(APIclient As WebClient)
Dim ProxyInfo As ProxyInfo
ProxyInfo = GetProxyInfoForUrl(APIclient.BaseUrl)
If ProxyInfo.active Then
    APIclient.SetProxy ProxyInfo.proxy
End If
End Function

Private Type ProxyInfo
    active As Boolean
    proxy As String
    proxyBypass As String
End Type

#If VBA7 Then
' Need CopyMemory to copy BSTR pointers around
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
          Alias "RtlMoveMemory" (ByVal lpDest As LongPtr, _
          ByVal lpSource As LongPtr, ByVal cbCopy As Long)
' SysAllocString creates a UNICODE BSTR string based on a UNICODE string
Private Declare PtrSafe Function SysAllocString Lib "oleaut32" (ByVal pwsz As LongPtr) As LongPtr
' Need GlobalFree to free the pointers in the CURRENT_USER_IE_PROXY_CONFIG
' structure returned from WinHttpGetIEProxyConfigForCurrentUser,
' per the documentation
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal p As LongPtr) As LongPtr
#Else
' Need CopyMemory to copy BSTR pointers around
Private Declare Sub CopyMemory Lib "kernel32" _
          Alias "RtlMoveMemory" (ByVal lpDest As Long, _
          ByVal lpSource As Long, ByVal cbCopy As Long)
' SysAllocString creates a UNICODE BSTR string based on a UNICODE string
Private Declare Function SysAllocString Lib "oleaut32" (ByVal pwsz As Long) As Long
' Need GlobalFree to free the pointers in the CURRENT_USER_IE_PROXY_CONFIG
' structure returned from WinHttpGetIEProxyConfigForCurrentUser,
' per the documentation
Private Declare Function GlobalFree Lib "kernel32" (ByVal p As Long) As Long
#End If

#If VBA7 Then
Private Type WINHTTP_CURRENT_USER_IE_PROXY_CONFIG
    fAutoDetect As Long
    lpszAutoConfigUrl As LongPtr
    lpszProxy As LongPtr
    lpszProxyBypass As LongPtr
End Type
Private Type WINHTTP_AUTOPROXY_OPTIONS
    dwFlags As Long
    dwAutoDetectFlags As Long
    lpszAutoConfigUrl As LongPtr
    lpvReserved As LongPtr
    dwReserved As Long
    fAutoLogonIfChallenged As Long
End Type
Private Type WINHTTP_PROXY_INFO
    dwAccessType As Long
    lpszProxy As LongPtr
    lpszProxyBypass As LongPtr
End Type
#Else
Private Type WINHTTP_CURRENT_USER_IE_PROXY_CONFIG
    fAutoDetect As Long
    lpszAutoConfigUrl As Long
    lpszProxy As Long
    lpszProxyBypass As Long
End Type
Private Type WINHTTP_AUTOPROXY_OPTIONS
    dwFlags As Long
    dwAutoDetectFlags As Long
    lpszAutoConfigUrl As Long
    lpvReserved As Long
    dwReserved As Long
    fAutoLogonIfChallenged As Long
End Type
Private Type WINHTTP_PROXY_INFO
    dwAccessType As Long
    lpszProxy As Long
    lpszProxyBypass As Long
End Type
#End If

' Constants for dwFlags of WINHTTP_AUTOPROXY_OPTIONS
Const WINHTTP_AUTOPROXY_AUTO_DETECT = 1
Const WINHTTP_AUTOPROXY_CONFIG_URL = 2

' Constants for dwAutoDetectFlags
Const WINHTTP_AUTO_DETECT_TYPE_DHCP = 1
Const WINHTTP_AUTO_DETECT_TYPE_DNS = 2

#If VBA7 Then
Private Declare PtrSafe Function WinHttpGetIEProxyConfigForCurrentUser Lib "WinHTTP.dll" _
    (ByRef proxyConfig As WINHTTP_CURRENT_USER_IE_PROXY_CONFIG) As Long
Private Declare PtrSafe Function WinHttpGetProxyForUrl Lib "WinHTTP.dll" _
    (ByVal hSession As LongPtr, _
     ByVal pszUrl As LongPtr, _
     ByRef pAutoProxyOptions As WINHTTP_AUTOPROXY_OPTIONS, _
     ByRef pProxyInfo As WINHTTP_PROXY_INFO) As Long
Private Declare PtrSafe Function WinHttpOpen Lib "WinHTTP.dll" _
    (ByVal pszUserAgent As LongPtr, _
     ByVal dwAccessType As Long, _
     ByVal pszProxyName As LongPtr, _
     ByVal pszProxyBypass As LongPtr, _
     ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function WinHttpCloseHandle Lib "WinHTTP.dll" _
    (ByVal hInternet As LongPtr) As Long
#Else
Private Declare Function WinHttpGetIEProxyConfigForCurrentUser Lib "WinHTTP.dll" _
    (ByRef proxyConfig As WINHTTP_CURRENT_USER_IE_PROXY_CONFIG) As Long
Private Declare Function WinHttpGetProxyForUrl Lib "WinHTTP.dll" _
    (ByVal hSession As Long, _
     ByVal pszUrl As Long, _
     ByRef pAutoProxyOptions As WINHTTP_AUTOPROXY_OPTIONS, _
     ByRef pProxyInfo As WINHTTP_PROXY_INFO) As Long
Private Declare Function WinHttpOpen Lib "WinHTTP.dll" _
    (ByVal pszUserAgent As Long, _
     ByVal dwAccessType As Long, _
     ByVal pszProxyName As Long, _
     ByVal pszProxyBypass As Long, _
     ByVal dwFlags As Long) As Long
Private Declare Function WinHttpCloseHandle Lib "WinHTTP.dll" _
    (ByVal hInternet As Long) As Long
#End If

Private Function GetProxyInfoForUrl(Url As String) As ProxyInfo
Dim IEProxyConfig As WINHTTP_CURRENT_USER_IE_PROXY_CONFIG
Dim AutoProxyOptions As WINHTTP_AUTOPROXY_OPTIONS
Dim WinHttpProxyInfo As WINHTTP_PROXY_INFO
Dim ProxyInfo As ProxyInfo
Dim fDoAutoProxy As Boolean
#If VBA7 Then
Dim ProxyStringPtr As LongPtr
Dim ptr As LongPtr
#Else
Dim ProxyStringPtr As Long
Dim ptr As Long
#End If
Dim error As Long

AutoProxyOptions.dwFlags = 0
AutoProxyOptions.dwAutoDetectFlags = 0
AutoProxyOptions.lpszAutoConfigUrl = 0
AutoProxyOptions.dwReserved = 0
AutoProxyOptions.lpvReserved = 0
AutoProxyOptions.fAutoLogonIfChallenged = 1

IEProxyConfig.fAutoDetect = 0
IEProxyConfig.lpszAutoConfigUrl = 0
IEProxyConfig.lpszProxy = 0
IEProxyConfig.lpszProxyBypass = 0

WinHttpProxyInfo.dwAccessType = 0
WinHttpProxyInfo.lpszProxy = 0
WinHttpProxyInfo.lpszProxyBypass = 0

ProxyInfo.active = False
ProxyInfo.proxy = vbNullString
ProxyInfo.proxyBypass = vbNullString

fDoAutoProxy = False
ProxyStringPtr = 0
ptr = 0

' Check IE's proxy configuration
If (WinHttpGetIEProxyConfigForCurrentUser(IEProxyConfig) > 0) Then
    ' If IE is configured to auto-detect, then we will too.
    If (IEProxyConfig.fAutoDetect <> 0) Then
        AutoProxyOptions.dwFlags = WINHTTP_AUTOPROXY_AUTO_DETECT
        AutoProxyOptions.dwAutoDetectFlags = _
                    WINHTTP_AUTO_DETECT_TYPE_DHCP + _
                    WINHTTP_AUTO_DETECT_TYPE_DNS
        fDoAutoProxy = True
    End If

    ' If IE is configured to use an auto-config script, then
    ' we will use it too
    If (IEProxyConfig.lpszAutoConfigUrl <> 0) Then
        AutoProxyOptions.dwFlags = AutoProxyOptions.dwFlags + _
                    WINHTTP_AUTOPROXY_CONFIG_URL
        AutoProxyOptions.lpszAutoConfigUrl = IEProxyConfig.lpszAutoConfigUrl
        fDoAutoProxy = True
    End If
Else
    ' if the IE proxy config is not available, then
    ' we will try auto-detection
    AutoProxyOptions.dwFlags = WINHTTP_AUTOPROXY_AUTO_DETECT
    AutoProxyOptions.dwAutoDetectFlags = _
                    WINHTTP_AUTO_DETECT_TYPE_DHCP + _
                    WINHTTP_AUTO_DETECT_TYPE_DNS
    fDoAutoProxy = True
End If

If fDoAutoProxy Then
    #If VBA7 Then
    Dim hSession As LongPtr
    #Else
    Dim hSession As Long
    #End If

    ' Need to create a temporary WinHttp session handle
    '  Note: performance of this GetProxyInfoForUrl function can be
    '   improved by saving this hSession handle across calls
    '   instead of creating a new handle each time
    hSession = WinHttpOpen(0, 1, 0, 0, 0)

    If (WinHttpGetProxyForUrl(hSession, StrPtr(Url), AutoProxyOptions, _
            WinHttpProxyInfo) > 0) Then
        ProxyStringPtr = WinHttpProxyInfo.lpszProxy
        ' ignore WinHttpProxyInfo.lpszProxyBypass, it will not be set
    Else
        error = Err.LastDllError
        ' some possibly autoproxy errors:
        '   12166 - error in proxy auto-config script code
        '   12167 - unable to download proxy auto-config script
        '   12180 - WPAD detection failed
    End If

    WinHttpCloseHandle (hSession)
End If

' If we don't have a proxy server from WinHttpGetProxyForUrl,
' then pick one up from the IE proxy config (if given)
If (ProxyStringPtr = 0) Then
    ProxyStringPtr = IEProxyConfig.lpszProxy
End If

' If there's a proxy string, convert it to a Basic string
If (ProxyStringPtr <> 0) Then
    ptr = SysAllocString(ProxyStringPtr)
    CopyMemory VarPtr(ProxyInfo.proxy), VarPtr(ptr), 4
    ProxyInfo.active = True
End If

' Pick up any bypass string from the IEProxyConfig
If (IEProxyConfig.lpszProxyBypass <> 0) Then
    ptr = SysAllocString(IEProxyConfig.lpszProxyBypass)
    CopyMemory VarPtr(ProxyInfo.proxyBypass), VarPtr(ptr), 4
End If

' Free any strings received from WinHttp APIs
If (IEProxyConfig.lpszAutoConfigUrl <> 0) Then
    GlobalFree (IEProxyConfig.lpszAutoConfigUrl)
End If
If (IEProxyConfig.lpszProxy <> 0) Then
    GlobalFree (IEProxyConfig.lpszProxy)
End If
If (IEProxyConfig.lpszProxyBypass <> 0) Then
    GlobalFree (IEProxyConfig.lpszProxyBypass)
End If
If (WinHttpProxyInfo.lpszProxy <> 0) Then
    GlobalFree (WinHttpProxyInfo.lpszProxy)
End If
If (WinHttpProxyInfo.lpszProxyBypass <> 0) Then
    GlobalFree (WinHttpProxyInfo.lpszProxyBypass)
End If

' return the ProxyInfo struct
GetProxyInfoForUrl = ProxyInfo
End Function