1

I am working on an Excel VBA program, and at some point, I need the proxy to be used when accessing a specific url, proxy that is computed from the .pac file provided by my company. For that, I intend to use WinINet (I know I could also use WinHTTP more easily, and even how to make it work)

I know I am missing some cleaning in my examples (InternetDeInitializeAutoProxyDll, etc.), but for now, I am just trying to successfully retrieve the proxy info.

Step 1 - C++

I found this, which gave me a sample to start with:

What initialization should be made prior to calling InternetGetProxyInfo()?

The accepted answer gives 2 ways. But I think that :

  • the first one is wrong, it does not allow to retrieve the auto proxy from a pac file.
  • the second one, is partially wrong too, since there is no need for providing any helper functions, some are provided by default and used internally.

Anyway, the following C++ example allows me to retrieve the string containing the proxies to be used for a specific url:

char *str = 0;
DWORD len = 0;

pfnInternetInitializeAutoProxyDll pIIAPD;
pfnInternetGetProxyInfo pIGPI;

HMODULE hModJS;

hModJS = LoadLibrary(TEXT("jsproxy.dll"));
pIIAPD = (pfnInternetInitializeAutoProxyDll)GetProcAddress(hModJS, "InternetInitializeAutoProxyDll");
pIGPI = (pfnInternetGetProxyInfo)GetProcAddress(hModJS, "InternetGetProxyInfo");

BOOL b;
DWORD dw;

b = pIIAPD(0, "D:\\Users\\SC5071\\Desktop\\proxy.pac", 0, 0, 0);
dw = GetLastError();

b = pIGPI("https://www.google.fr/", sizeof(URL) - 1, "www.google.fr", sizeof(HOST) - 1, &str, &len);
dw = GetLastError();

return 0;

Works fine, str contains something like:

PROXY 123.123.55.55:10455; PROXY 123.123.56.56:10455; DIRECT

Step 2 - VBA

Moving from C++ to Excel VBA using Declare statements for the Win32 API functions InternetInitializeAutoProxyDll and InternetGetProxyInfo.

[I am not posting the code here for now]

InternetGetProxyInfo fails with error code ERROR_CAN_NOT_COMPLETE (1003L)

Step 3 - ASM

At first I thought this might be related to how Excel VBA loads and calls DLL functions, since MSDN for InternetGetProxyInfo states that:

This function can only be called by dynamically linking to "JSProxy.dll".

So I made my own x86 assembly code to make the call (__stdcall convention):

Private Declare Function GetModuleHandleW Lib "kernel32.dll" (ByVal moduleName As String) As Long
Private Declare Function GetModuleHandleA Lib "kernel32.dll" (ByVal moduleName As String) As Long
Private Declare Function LoadLibraryExW Lib "kernel32.dll" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Integer) As Long
Private Declare Function LoadLibraryExA Lib "kernel32.dll" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Integer) As Long
Private Declare Function LoadLibraryW Lib "kernel32.dll" (ByVal lpFileName As Long) As Long
Private Declare Function LoadLibraryA Lib "kernel32.dll" (ByVal lpFileName As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hModule As Long) As Integer
Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As Long) As Long
Private Declare Function GetProcAddress_String Lib "kernel32.dll" Alias "GetProcAddress" (ByVal hModule As Long, ByVal ProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Private Declare Function GetLastError Lib "kernel32.dll" () As Long

Private Const MEM_COMMIT As Long = &H1000&
Private Const MEM_RESERVE As Long = &H2000&
Private Const MEM_RELEASE As Long = &H8000&
Private Const MEM_EXECUTE_READWRITE As Long = &H40&

Dim FunctionAddress As Long
Dim MemAddressOffset As Long

Private Sub AddByte(ByVal Data As Byte)
    RtlMoveMemory MemAddressOffset, VarPtr(Data), 1
    MemAddressOffset = CLng(MemAddressOffset) + 1
End Sub

Private Sub AddBytes(Data() As Byte)
    RtlMoveMemory MemAddressOffset, VarPtr(Data(0)), UBound(Data) + 1
    MemAddressOffset = CLng(MemAddressOffset) + UBound(Data) + 1
End Sub

Sub Main()

    Dim b As Long

    Dim MemAddress As Long

    Dim LstrBytes1() As Byte
    LstrBytes1 = "jsproxy.dll"
    ReDim Preserve LstrBytes1(UBound(LstrBytes1) + 2)
    hLib = LoadLibraryW(VarPtr(LstrBytes1(0)))
    Dim NstrBytes1() As Byte
    NstrBytes1 = StrConv("InternetInitializeAutoProxyDll", vbFromUnicode)
    ReDim Preserve NstrBytes1(UBound(NstrBytes1) + 1)
    FunctionAddress = GetProcAddress(hLib, VarPtr(NstrBytes1(0)))
    If FunctionAddress = 0 Then Stop

    MemAddress = VirtualAlloc(0&, 256, MEM_COMMIT Or MEM_RESERVE, MEM_EXECUTE_READWRITE)
    MemAddressOffset = MemAddress

    Dim strTemp1 As String
    strTemp1 = "D:\Users\SC5071\Desktop\proxy.pac"
    Dim bytTemp1() As Byte
    bytTemp1 = StrConv(strTemp1, vbFromUnicode)
    ReDim Preserve bytTemp1(UBound(bytTemp1) + 1)

    AddByte &H55                                                'push        ebp
    AddByte &H8B: AddByte &HEC                                  'mov         ebp,esp
    AddByte &H83: AddByte &HEC: AddByte &H18                    'sub         esp,18h

    AddByte &H6A: AddByte &H0                                   'push        0
    AddByte &H6A: AddByte &H0                                   'push        0
    AddByte &H6A: AddByte &H0                                   'push        0
    AddByte &H68: AddBytes LongToByteArray(VarPtr(bytTemp1(0))) 'push        DWORD PTR
    AddByte &H6A: AddByte &H0                                   'push        0

    AddByte &HE8                                                'call        InternetInitializeAutoProxyDll
    AddBytes LongToByteArray(CLng(FunctionAddress) - (CLng(MemAddressOffset) + 4))

    AddByte &H89: AddByte &H45: AddByte &HFC                    'mov         dword ptr [ebp-4],eax
    AddByte &H8B: AddByte &H45: AddByte &HFC                    'mov         eax,dword ptr [ebp-4]

    AddByte &HC9                                                'leave
    AddByte &HC3                                                'ret

    l = CallWindowProc(MemAddress, 0, 0, 0, 0)
    Debug.Print GetLastError()

    b = VirtualFree(MemAddress, 0, MEM_RELEASE)
    Debug.Print Err.LastDllError

    If l = 0 Then Exit Sub

'--------------------------------------------------------------------------------------------------------------------------------

    FunctionAddress = 0
    Dim NstrBytes2() As Byte
    NstrBytes2 = StrConv("InternetGetProxyInfo", vbFromUnicode)
    ReDim Preserve NstrBytes2(UBound(NstrBytes2) + 1)
    FunctionAddress = GetProcAddress(hLib, VarPtr(NstrBytes2(0)))
    If FunctionAddress = 0 Then Stop

    MemAddress = VirtualAlloc(0&, 256, MEM_COMMIT Or MEM_RESERVE, MEM_EXECUTE_READWRITE)
    MemAddressOffset = MemAddress

    strUrlW$ = "https://www.google.fr/"
    strHostNameW$ = "www.google.fr"

    Dim szUrlA()        As Byte
    Dim szHostNameA()   As Byte

    szUrlA = StrConv(strUrlW, vbFromUnicode)
    szHostNameA = StrConv(strHostNameW, vbFromUnicode)

    ReDim Preserve szUrlA(UBound(szUrlA) + 1)
    ReDim Preserve szHostNameA(UBound(szHostNameA) + 1)

    len1& = Len("https://www.google.fr/") + 1
    len2& = Len("www.google.fr") + 1

    Dim strProxyHostName() As Byte
    ReDim strProxyHostName(2048 - 1)

    Dim lpszProxyHostName As Long
    Dim lplpszProxyHostName As Long

    lpszProxyHostName = VarPtr(strProxyHostName(0))
    lplpszProxyHostName = VarPtr(lpszProxyHostName)

    Dim dwProxyHostNameLength As Long
    Dim lpdwProxyHostNameLength As Long

    dwProxyHostNameLength = UBound(strProxyHostName)
    lpdwProxyHostNameLength = VarPtr(dwProxyHostNameLength)

    AddByte &H55                                                    'push        ebp
    AddByte &H8B: AddByte &HEC                                      'mov         ebp,esp
    AddByte &H83: AddByte &HEC: AddByte &H1C                        'sub         esp,1ch

    AddByte &H68: AddBytes LongToByteArray(lpdwProxyHostNameLength) 'push        DWORD PTR
    AddByte &H68: AddBytes LongToByteArray(lplpszProxyHostName)     'push        DWORD PTR PTR
    AddByte &H68: AddBytes LongToByteArray(len2)                    'push        DWORD
    AddByte &H68: AddBytes LongToByteArray(VarPtr(szHostNameA(0)))  'push        DWORD PTR
    AddByte &H68: AddBytes LongToByteArray(len1)                    'push        DWORD
    AddByte &H68: AddBytes LongToByteArray(VarPtr(szUrlA(0)))       'push        DWORD PTR

    AddByte &HE8                                                    'call        InternetGetProxyInfo
    AddBytes LongToByteArray(CLng(FunctionAddress) - (CLng(MemAddressOffset) + 4))

    AddByte &H89: AddByte &H45: AddByte &HFC                        'mov         dword ptr [ebp-4],eax
    AddByte &H8B: AddByte &H45: AddByte &HFC                        'mov         eax,dword ptr [ebp-4]

    AddByte &HC9                                                    'leave
    AddByte &HC3                                                    'ret

    l = CallWindowProc(MemAddress, 0, 0, 0, 0)
    Debug.Print GetLastError()

    Debug.Print Mem_ReadHex(MemAddress, CLng(MemAddressOffset) - CLng(MemAddress))

    b = VirtualFree(MemAddress, 0, MEM_RELEASE)
    Debug.Print Err.LastDllError

    If l = 0 Then Exit Sub

    Debug.Print strProxyHostName

End Sub

A bit heavy, but it works without crashing Excel (as does any "CallAPIByName" code in VB I could find over the internet), but still getting ERROR_CAN_NOT_COMPLETE 1003L.

Step 4 - The problem

1/ Then, I discovered that if one calls InternetGetProxyInfo from a "Single-Thread Apartment" thread, it will apparently inevitably fail with ERROR_CAN_NOT_COMPLETE.

WinINet InternetGetProxyInfo : error 1003 ERROR_CAN_NOT_COMPLETE

2/ I have also come to understand that Excel's process is actually single-threaded, and more precisely lives in a Single-Threaded Apartment (meaning COM has been initialized with OleInitialize/CoInitialize)

Multi-threading in VBA

3/ Another source below explains that:

"JSProxy uses COM and it can not work properly in case other appartement COM initialization is performed on the same thread."

http://microsoft.public.win32.programmer.networks.narkive.com/RMOcV126/internetgetproxyinfo-fails-with-error-can-not-complete-result

So, here is my last foolish attempt:

hThread = CreateThread(0, 0, MemAddress, 0, 0, 0)
Call WaitForSingleObject(hThread, INFINITE)
Dim lpExitCode As Long
b = GetExitCodeThread(hThread, lpExitCode)
CloseHandle hThread

Obviously it still does not return the string with proxy info.

In my C++ example above, I noticed that indeed, adding the following gives the same behavior than in Excel:

HRESULT o = OleInitialize(NULL); // S_OK  = 0x0
// after that, InternetGetProxyInfo fails with 1003L

I am not really familiar with OLE/COM/Threading concepts, and I fail to see how to easily go further. In light of everything I've said here, I guess I could sum up my question to :

How to call InternetGetProxyInfo from a non-"Single-Threaded Apartment" thread from Excel VBA using Win32 APIs ?

Windows 10 64-bit + Excel 2016 32-bit

hymced
  • 570
  • 5
  • 19
  • Couldn't use this instead https://msdn.microsoft.com/en-us/library/windows/desktop/aa384240(v=vs.85).aspx? – Ryan Wildry May 16 '18 at 13:19
  • As I said, I want to use WinINet. I know I could use WinHTTP, and I have already successfully make it work to retrieve the proxy info. Let's assume WinHTTP does not exist :) – hymced May 16 '18 at 13:24

1 Answers1

0

Never mind, it is solved:

Private Const INFINITE = &HFFFFFFFF
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateThread _
    Lib "kernel32" ( _
        ByVal lpThreadAttributes As Long, _
        ByVal dwStackSize As Long, _
        ByVal lpStartAddress As Long, _
        ByVal lpParameter As Long, _
        ByVal dwCreationFlags As Long, _
        ByRef lpThreadld As Long) _
As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function GetLastError Lib "kernel32.dll" () As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, ByRef dwExitCode As Long) As Long

Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

Private Const MEM_COMMIT As Long = &H1000&
Private Const MEM_RESERVE As Long = &H2000&
Private Const MEM_RELEASE As Long = &H8000&
Private Const MEM_EXECUTE_READWRITE As Long = &H40&

Private Declare PtrSafe Function MultiByteToWideChar _
    Lib "kernel32.dll" _
    ( _
        ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        ByVal lpMultiByteStr As Long, _
        ByVal cbMultiByte As Long, _
        ByVal lpWideCharStr As Long, _
        ByVal cchWideChar As Long) _
As Long

'################################################################################################################################

Private Declare Function InternetInitializeAutoProxyDll_String _
    Lib "JSProxy.dll" _
    Alias "InternetInitializeAutoProxyDll" _
    ( _
        ByVal dwVersion As Long, _
        ByVal lpszDownloadedTempFile As String, _
        ByVal lpszMime As Long, _
        ByVal lpAutoProxyCallbacks As Long, _
        ByVal lpAutoProxyScriptBuffer As Long) _
As Boolean

Private Declare Function InternetGetProxyInfo_Long _
    Lib "JSProxy.dll" _
    Alias "InternetGetProxyInfo" _
    ( _
        ByVal lpszUrl As Long, _
        ByVal dwUrlLength As Long, _
        ByVal lpszUrlHostName As Long, _
        ByVal dwUrlHostNameLength As Long, _
        ByVal lplpszProxyHostName As Long, _
        ByVal lpdwProxyHostNameLength As Long) _
As Boolean

'################################################################################################################################

Public g_ptrProxyHostName As Long 'thread-shared variable allocated/stored in process global memory
Public g_strProxyHostName As String 'idem
Public g_lngProxyHostNameLength As Long 'idem
Public g_MainThreadId As Long

Public WinINet_InternetGetProxyInfo_ThreadProc_Error As Long

Public globalVar1 As Long
Public globalVar2 As Long

'################################################################################################################################

Function WinINet_InternetGetProxyInfo_ThreadProc() As Long

    Dim bResult As Boolean

    'Dim strProxyHostName As String 'useless, see below
    'strProxyHostName = Space(1024)
    Dim lpszProxyHostName As Long
    Dim lplpszProxyHostName As Long

    lpszProxyHostName = StrPtr(strProxyHostName)
    lplpszProxyHostName = VarPtr(lpszProxyHostName)

    Dim dwProxyHostNameLength As Long
    Dim lpdwProxyHostNameLength As Long

    dwProxyHostNameLength = LenB(strProxyHostName)
    lpdwProxyHostNameLength = VarPtr(dwProxyHostNameLength)

    Dim strUrlW         As String
    Dim strHostNameW    As String

    Dim strUrlA         As String
    Dim strHostNameA    As String

    strUrlW = "https://www.google.fr/"
    strHostNameW = "www.google.fr"

    strUrlA = StrConv(strUrlW, vbFromUnicode)
    strHostNameA = StrConv(strHostNameW, vbFromUnicode)

    Dim szUrlA()        As Byte
    Dim szHostNameA()   As Byte

    szUrlA = StrConv(strUrlW, vbFromUnicode)
    szHostNameA = StrConv(strHostNameW, vbFromUnicode)

    ReDim Preserve szUrlA(UBound(szUrlA) + 1)
    ReDim Preserve szHostNameA(UBound(szHostNameA) + 1)

    bResult = InternetInitializeAutoProxyDll_String(0, "D:\Users\SC5071\Desktop\proxy.pac", 0, 0, 0)

    'check state before
    'globalVar1 = lpszProxyHostName
    'globalVar1 = lplpszProxyHostName
    'globalVar1 = dwProxyHostNameLength
    'globalVar1 = lpdwProxyHostNameLength

    bResult = InternetGetProxyInfo_Long(VarPtr(szUrlA(0)), Len("https://www.google.fr/") + 1, _
                                        VarPtr(szHostNameA(0)), Len("www.google.fr") + 1, _
                                        lplpszProxyHostName, lpdwProxyHostNameLength)

    m_ThreadProcId = GetCurrentThreadId()

    If m_ThreadProcId = g_MainThreadId Then 'otherwise Excel crahes when using Debug.Print from another thread than the STA thread
        Debug.Print "bResult = "; bResult
        Debug.Print "Err.LastDllError = "; Err.LastDllError
        Debug.Print "GetLastError() = "; GetLastError()
    End If

    'check state after
    'globalVar2 = lpszProxyHostName
    'globalVar2 = lplpszProxyHostName
    'globalVar2 = dwProxyHostNameLength
    'globalVar2 = lpdwProxyHostNameLength

    '~~> checking the state of the variable passed to InternetGetProxyInfo before and after the call reveals that
    '    InternetGetProxyInfo_Long actually allocates a buffer holding the computed string and returns the new pointer to it in
    '    lpszProxyHostName, and its length in dwProxyHostNameLength; lplpszProxyHostName and lpdwProxyHostNameLength are unchanged.
    '    that is why strProxyHostName contains only blank spaces (200020002000...) after the call, it is simply unchanged.

    WinINet_InternetGetProxyInfo_ThreadProc = bResult
    'WinINet_InternetGetProxyInfo_ThreadProc = Err.LastDllError

    WinINet_InternetGetProxyInfo_ThreadProc_Error = Err.LastDllError

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    g_ptrProxyHostName = lpszProxyHostName
    g_lngProxyHostNameLength = dwProxyHostNameLength

    Dim strWideCharStr As String
    Dim cRequiredBuffer As Long
    cRequiredBuffer = MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, g_ptrProxyHostName, -1, StrPtr(strWideCharStr), 0)
    cchWideChar = cRequiredBuffer - 1
    strWideCharStr = Space(cchWideChar)
    Dim lngResult As Long
    lngResult = MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, g_ptrProxyHostName, -1, StrPtr(strWideCharStr), cchWideChar)

    g_strProxyHostName = strWideCharStr

End Function

Sub Main()

    g_MainThreadId = GetCurrentThreadId()

    Dim hThread As Long
    hThread = CreateThread(0, 0, AddressOf WinINet_InternetGetProxyInfo_ThreadProc, 0, 0, 0)
    Call WaitForSingleObject(hThread, INFINITE)
    Dim dwExitCode As Long
    b = GetExitCodeThread(hThread, dwExitCode)
    CloseHandle hThread

    If dwExitCode = 1 And WinINet_InternetGetProxyInfo_ThreadProc_Error = 0 Then
        'Debug.Print globalVar1
        'Debug.Print globalVar2

        Debug.Print "PAC file result for URL is:"
        Debug.Print g_strProxyHostName
        Debug.Print "THE END"
    Else
        Debug.Print dwExitCode
        Debug.Print WinINet_InternetGetProxyInfo_ThreadProc_Error
    End If

End Sub

In this end, the problem was that InternetGetProxyInfo allocates its own buffer (which should be freed later on, as many WinINet functions returning Strings), so my "foolish" attempt was not that foolish!!! It was in fact working!

I forgot to mention in my question, that I made an ASM code because CallWindowProc does not allow to call a function pointer that expects more than 4 parameters. Anyway, it was useless, the problem came from elsewhere, Declare statements for Win32 APIs are correctly doing the Dynamic Linking required to call the WinINet/JSProxy function.

As you can see, it is pretty easy to create another thread from the main Excel STA thread, but if I get it right about the COM Threading Model, one must avoid using objects that have been created in that main thread, it is very likely it will cause Excel to crash.

hymced
  • 570
  • 5
  • 19