挂钩 InternetStatusCallback

Question

我正在尝试挂钩来自 Wininet 的异步回调，该回调是从 TWebbrowser 调用的。但是，挂钩完成后会出现错误。为什么会这样？

$0018B7A2 第一次机会例外。异常类 $C000008C 带有消息“数组边界超出 0x0018b7a2”。处理 Project3.exe (3292)

    THttpMonitor = class
    private
    FInternetStatusCallback: procedure(hInternet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: LPVOID; dwStatusInformationLength: DWORD);
    FInternetSetStatusCallback: function(hInet: HINTERNET; lpfnInternetCallback: PFNInternetStatusCallback): PFNInternetStatusCallback; stdcall;
    public
      class function InternetSetStatusCallback(hInet: HINTERNET; lpfnInternetCallback: PFNInternetStatusCallback): PFNInternetStatusCallback; stdcall; static;
      class procedure InternetStatusCallback(hInternet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: LPVOID; dwStatusInformationLength: DWORD); stdcall; static;
        constructor Create;
        destructor Destroy; override;
  end;

class procedure THttpMonitor.InternetStatusCallback(hInternet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: LPVOID; dwStatusInformationLength: DWORD);
begin
  HttpMonitor.FInternetStatusCallback(hInternet, dwContext, dwInternetStatus, lpvStatusInformation, dwStatusInformationLength);
end;

class function THttpMonitor.InternetSetStatusCallback(hInet: HINTERNET; lpfnInternetCallback: PFNInternetStatusCallback): PFNInternetStatusCallback; stdcall;
begin
  HttpMonitor.FInternetStatusCallback := @lpfnInternetCallback;
    Result := HttpMonitor.FInternetSetStatusCallback(hInet, @HttpMonitor.InternetStatusCallback); // ERROR!
end;

constructor THttpMonitor.Create;
begin
    FInternetSetStatusCallback := InterceptCreate('wininet.dll', 'InternetSetStatusCallback', @InternetSetStatusCallback);
end;

destructor THttpMonitor.Destroy;
begin
    InterceptRemove(FInternetSetStatusCallback);
    inherited;
end;

....

procedure TForm1.Button1Click(Sender: TObject);
begin
  Webrowser1.Navigate('www.stackoverflow.com');
end;

Answer 1

除了大卫赫弗南所说的，你还有一个更大的问题要解决。状态回调是在每个HINTERNET 的基础上分配的，但是您将它们视为单个全局回调，这是行不通的。您必须跟踪传递给 InternetSetStatusCallback() 的每个单独的 HINTERNET 句柄，以便您可以根据指定的 HINTERNET 从回调内部调用相应的回调。

当HINTERNET 句柄关闭时，您还需要能够从跟踪列表中删除它们。您可以为此使用INTERNET_STATUS_HANDLE_CLOSING 状态，但是文档说它仅针对分配了非零Context 值的HINTERNET 句柄触发。因此，您必须挂钩 InternetCloseHandle() 以说明 HINTERNET 具有零 Context 的句柄。

试试这样的：

unit HttpMonitor;

interface

uses
  Windows, WinInet, System.Generics.Collections;

type
  // The WinInet unit maps INTERNET_STATUS_CALLBACK to a mere TFarProc, so
  // let's spell out its parameters so we can actually make calls to it
  // when needed...
  INTERNET_STATUS_CALLBACK_TYPE = procedure(hInet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: LPVOID; dwStatusInformationLength: DWORD); stdcall;

  THttpMonitor = class
  private
    FCallbacks: TDictionary<HINTERNET, INTERNET_STATUS_CALLBACK_TYPE>;
    FInternetCloseHandle: function(hInet: HINTERNET): BOOL; stdcall;
    FInternetSetStatusCallback: function(hInet: HINTERNET; lpfnInternetCallback: INTERNET_STATUS_CALLBACK_TYPE): INTERNET_STATUS_CALLBACK_TYPE; stdcall;
  public
    class function InternetCloseHandle(hInet: HINTERNET): BOOL; stdcall; static;
    class function InternetSetStatusCallback(hInet: HINTERNET; lpfnInternetCallback: INTERNET_STATUS_CALLBACK_TYPE): INTERNET_STATUS_CALLBACK_TYPE; stdcall; static;
    class procedure InternetStatusCallback(hInet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: LPVOID; dwStatusInformationLength: DWORD); stdcall; static; static;
    constructor Create;
    destructor Destroy; override;
  end;

var
  HttpMonitor: THttpMonitor = nil;

implementation

class function THttpMonitor.InternetCloseHandle(hInet: HINTERNET): BOOL; stdcall;
begin
  HttpMonitor.FCallbacks.Remove(hInet);
  Result := FInternetCloseHandle(hInet);
end;

class procedure THttpMonitor.InternetStatusCallback(hInet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: LPVOID; dwStatusInformationLength: DWORD); stdcall;
var
  Callback: INTERNET_STATUS_CALLBACK_TYPE;
begin
  //...
  if HttpMonitor.FCallbacks.TryGetValue(hInet, Callback) then
  begin
    if Assigned(Callback) then
      Callback(hInet, dwContext, dwInternetStatus, lpvStatusInformation, dwStatusInformationLength);
  end;
end;

class function THttpMonitor.InternetSetStatusCallback(hInet: HINTERNET; lpfnInternetCallback: INTERNET_STATUS_CALLBACK_TYPE): INTERNET_STATUS_CALLBACK_TYPE; stdcall;
begin
  HttpMonitor.FCallbacks.TryGetValue(hInet, Result);
  HttpMonitor.FCallbacks.AddOrSetValue(hInet, lpfnInternetCallback);
  FInternetSetStatusCallback(hInet, @THttpMonitor.InternetStatusCallback);
end;

constructor THttpMonitor.Create;
begin
  inherited;
  FCallbacks := TDictionary<HINTERNET, INTERNET_STATUS_CALLBACK_TYPE>.Create;
  @FInternetCloseHandle := InterceptCreate('wininet.dll', 'InternetCloseHandle', @THttpMonitor.InternetCloseHandle);
  @FInternetSetStatusCallback := InterceptCreate('wininet.dll', 'InternetSetStatusCallback', @THttpMonitor.InternetSetStatusCallback);
end;

destructor THttpMonitor.Destroy;
var
  item: TPair<HINTERNET, INTERNET_STATUS_CALLBACK_TYPE>;
begin
  if Assigned(FInternetSetStatusCallback) then
  begin
    for item in FCallbacks do
      FInternetSetStatusCallback(item.Key, nil);
    InterceptRemove(FInternetSetStatusCallback);
  end;
  if Assigned(FInternetCloseHandle) then
    InterceptRemove(FInternetCloseHandle);
  FCallbacks.Free;
  inherited;
end;

end.

uses
  ..., HttpMonitor;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HttpMonitor := THttpMonitor.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  HttpMonitor.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Webrowser1.Navigate('www.stackoverflow.com');
end;

话虽如此，最后一个问题要解决，我没有解决方案 - 如何将回调分配给永远不会传递给 InternetSetStatusCallback() 的 HINTERNET 句柄，所以你看到了吗？ InternetStatusCallback() 确实有 INTERNET_STATUS_HANDLE_CREATED 状态可用，但文档指出它仅由 InternetConnect() 触发。还有其他创建HINTERNET 句柄的WinInet 函数。因此，您可能需要额外的挂钩来说明您对挂钩状态感兴趣的所有 HINTERNET 句柄。

Answer 2

您正在获取包含函数指针的变量的地址。但是你需要记住函数指针。

所以不是

HttpMonitor.FInternetStatusCallback := @lpfnInternetCallback;

你需要

HttpMonitor.FInternetStatusCallback := lpfnInternetCallback;

下面这行应该是

Result := HttpMonitor.FInternetSetStatusCallback(hInet, lpfnInternetCallback)

您可能会发现启用类型化地址编译器选项会有所帮助。

您还错过了FInternetStatusCallback 声明中的stdcall。