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

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

所以而不是

HttpMonitor.FInternetStatusCallback := @lpfnInternetCallback;

你需要

HttpMonitor.FInternetStatusCallback := lpfnInternetCallback;

以下行应

Result := HttpMonitor.FInternetSetStatusCallback(hInet, lpfnInternetCallback)

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

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

Answer 2

除了DavidHeffernan所说的，你还有一个更大的难题需要解决。状态回调按每{ - 1}}分配，但您将它们视为单个全局回调，这将无效。您必须跟踪传递给HINTERNET的每个HINTERNET句柄，以便您可以根据指定的InternetSetStatusCallback()从回调内部调用相应的回调。

您还需要能够在关闭时从跟踪列表中删除HINTERNET个句柄。您可以使用HINTERNET状态，但是文档说它仅针对分配了非INTERNET_STATUS_HANDLE_CLOSING值的HINTERNET句柄触发。因此，您必须将Context与InternetCloseHandle() HINTERNET的{{1}}句柄相关联。

尝试更像这样的事情：

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;的{{1}}句柄，以便您看见？ HINTERNET确实具有InternetSetStatusCallback()状态，但文档指出它仅由InternetStatusCallback()触发。还有其他WinInet函数可以创建INTERNET_STATUS_HANDLE_CREATED个句柄。因此，您可能需要额外的挂钩来说明您对挂钩状态感兴趣的所有InternetConnect()句柄。

挂钩InternetStatusCallback

2 个答案: