如何使用 Win32 API 从 Excel VBA 的非“单线程单元”线程调用 InternetGetProxyInfo

Question

我正在开发一个 Excel VBA 程序，并且在某些时候，我需要在访问特定 url 时使用代理，该代理是根据我公司提供的 .pac 文件计算的。为此，我打算使用 WinINet（我知道我也可以更轻松地使用 WinHTTP，以及如何使它工作）

我知道我的示例中缺少一些清理（InternetDeInitializeAutoProxyDll 等），但现在，我只是尝试成功检索代理信息。

第 1 步 - C++

我找到了这个，它给了我一个示例：

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

接受的答案有两种方法。但我认为：

• 第一个错误，它不允许从 pac 文件中检索自动代理。
• 第二个也是部分错误，因为不需要提供任何辅助函数，有些是默认提供并在内部使用。

无论如何，下面的 C++ 示例允许我检索包含要用于特定 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;

工作正常，str 包含类似：

代理 123.123.55.55:10455;代理 123.123.56.56:10455；直接

第 2 步 - VBA

使用 Win32 API 函数 InternetInitializeAutoProxyDll 和 InternetGetProxyInfo 的 Declare 语句从 C++ 迁移到 Excel VBA。

[我暂时不在这里发布代码]

InternetGetProxyInfo 失败，错误代码为 ERROR_CAN_NOT_COMPLETE (1003L)

第 3 步 - ASM

起初我认为这可能与 Excel VBA 如何加载和调用 DLL 函数有关，因为 InternetGetProxyInfo 的 MSDN 声明：

该函数只能通过动态链接到“JSProxy.dll”来调用。

所以我编写了自己的 x86 汇编代码来进行调用（__stdcall 约定）：

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

有点重，但它不会导致 Excel 崩溃（我可以在 Internet 上找到任何 VB 中的“CallAPIByName”代码），但仍然得到ERROR_CAN_NOT_COMPLETE 1003L。

第 4 步 - 问题

1/ 然后，我发现如果从“单线程单元”线程调用InternetGetProxyInfo，显然不可避免地会以ERROR_CAN_NOT_COMPLETE 失败。

WinINet InternetGetProxyInfo : error 1003 ERROR_CAN_NOT_COMPLETE

2/ 我也开始明白 Excel 的进程实际上是单线程的，更准确地说是在单线程单元中（意思是 COM 已经初始化为OleInitialize/CoInitialize）

Multi-threading in VBA

3/ 下面的另一个来源解释说：

"JSProxy 使用 COM，如果在同一线程上执行其他 appartement COM 初始化，它不能正常工作。"

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

所以，这是我最后一次愚蠢的尝试：

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

显然它仍然没有返回带有代理信息的字符串。

在我上面的 C++ 示例中，我注意到确实，添加以下内容会产生与 Excel 中相同的行为：

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

我对 OLE/COM/Threading 概念并不十分熟悉，而且我看不到如何轻松地走得更远。鉴于我在这里所说的一切，我想我可以将我的问题总结为：

如何使用 Win32 API 从 Excel VBA 中的非“单线程单元”线程调用 InternetGetProxyInfo？

Windows 10 64 位 + Excel 2016 32 位

Answer 1

没关系，解决了：

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

最后，问题在于 InternetGetProxyInfo 分配了自己的缓冲区（稍后应该释放，因为许多 WinINet 函数返回字符串），所以我的“愚蠢”尝试并没有那么愚蠢！它实际上正在工作！

我忘了在我的问题中提到，我制作了一个 ASM 代码，因为 CallWindowProc 不允许调用需要超过 4 个参数的函数指针。无论如何，它没用，问题来自其他地方，Win32 API 的Declare 语句正确执行调用 WinINet/JSProxy 函数所需的动态链接。

如您所见，从 Excel STA 主线程创建另一个线程非常容易，但如果我对 COM 线程模型的理解正确，则必须避免使用在该主线程中创建的对象，它很有可能会导致 Excel 崩溃。