Главная » C++ » Как позвонить в InternetGetProxyInfo из не однопоточной квартиры? поток из Excel VBA с использованием Win32 API

Как позвонить в InternetGetProxyInfo из не однопоточной квартиры? поток из Excel VBA с использованием Win32 API

Я работаю над программой Excel VBA, и в какой-то момент мне нужен прокси-сервер для доступа к конкретному URL-адресу, прокси-серверу, который вычисляется из файла .pac, предоставленного моей компанией. Для этого я намереваюсь использовать WinINet (я знаю, что мог бы также использовать WinHTTP более легко, и даже как заставить это работать)

Я знаю, что мне не хватает очистки в моих примерах (InternetDeInitializeAutoProxyDll и т. Д.), Но сейчас я просто пытаюсь успешно получить информацию о прокси.

Шаг 1 — C ++

Я нашел это, который дал мне образец для начала:

Какую инициализацию следует выполнить перед вызовом InternetGetProxyInfo ()?

Принятый ответ дает 2 способа. Но я думаю, что

  • первый неверный, он не позволяет получить авто прокси из 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

Переход с C ++ в Excel VBA с помощью Declare операторы для функций Win32 API InternetInitializeAutoProxyDll а также InternetGetProxyInfo,

[Я не размещаю код здесь сейчас]

InternetGetProxyInfo не удается с кодом ошибки ERROR_CAN_NOT_COMPLETE (1003L)

Шаг 3 — ASM

Сначала я подумал, что это может быть связано с тем, как Excel VBA загружает и вызывает функции DLL, поскольку MSDN для InternetGetProxyInfo говорится, что:

Эта функция может быть вызвана только путем динамической ссылки на «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 (как и любой код «CallAPIByName» в VB, который я мог найти через Интернет), но все равно получаю ERROR_CAN_NOT_COMPLETE 1003L,

Шаг 4 — Проблема

1 / Затем я обнаружил, что если кто-то InternetGetProxyInfo из ветки «Однопоточная квартира», она, очевидно, неизбежно потерпит неудачу с ERROR_CAN_NOT_COMPLETE,

WinINet InternetGetProxyInfo: ошибка 1003 ERROR_CAN_NOT_COMPLETE

2 / Я также пришел к выводу, что процесс Excel на самом деле является однопоточным, а точнее, живет в однопоточной квартире (то есть COM был инициализирован с OleInitialize/CoInitialize)

Многопоточность в VBA

3 / Другой источник ниже объясняет, что:

«JSProxy использует COM, и он не может работать должным образом, если инициализация 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 и не могу понять, как легко пойти дальше. В свете всего, что я здесь сказал, я думаю, что могу подвести итог моему вопросу:

Как вызвать InternetGetProxyInfo из потока, не являющегося однопоточным, из Excel VBA с использованием Win32 API?

Windows 10 64-битная + Excel 2016 32-битная

0

Решение

Неважно, это решается

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 параметров. Во всяком случае, это было бесполезно, проблема пришла откуда-то, Declare операторы для Win32 API правильно выполняют динамическое связывание, необходимое для вызова функции WinINet / JSProxy.

Как видите, довольно легко создать другой поток из основного потока Excel STA, но если я правильно понял модель потоков COM, нужно избегать использования объектов, созданных в этом основном потоке, это очень вероятно это приведет к сбою Excel.

0

Другие решения

Других решений пока нет …

Источник
По вопросам рекламы [email protected]
Web-Answers © 2024 Наверх