挂钩 InternetStatusCallback

Question

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

第一次机会异常 $0018B7A2。异常 class $C000008C，消息 'array bounds exceeded at 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.whosebug.com');
end;

Answer 1

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

所以

HttpMonitor.FInternetStatusCallback := @lpfnInternetCallback;

你需要

HttpMonitor.FInternetStatusCallback := lpfnInternetCallback;

下面一行应该是

Result := HttpMonitor.FInternetSetStatusCallback(hInet, lpfnInternetCallback)

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

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

Answer 2

除了DavidHeffernan所说的，你还有一个更大的问题要解决。状态回调是按 HINTERNET 分配的，但您将它们视为单个全局回调，这将不起作用。您必须跟踪传递给 InternetSetStatusCallback() 的每个 HINTERNET 句柄，以便您可以根据指定的 HINTERNET 从回调内部调用其适当的回调。

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

的 HINTERNET 句柄

试试像这样的东西：

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.whosebug.com');
end;

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

挂钩 InternetStatusCallback

Hooking InternetStatusCallback

delphi

wininet

delphi-xe7