-3

I am trying to hook the asynchronous callback from Wininet which get's called from TWebbrowser. However there is an error after the hooking is done. Why does this happen?

First chance exception at $0018B7A2. Exception class $C000008C with message 'array bounds exceeded at 0x0018b7a2'. Process 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;
John Lewis
  • 337
  • 3
  • 12

2 Answers2

1

You are taking the address of the variable containing the function pointer. But you need to remember the function pointer.

So instead of

HttpMonitor.FInternetStatusCallback := @lpfnInternetCallback;

you need

HttpMonitor.FInternetStatusCallback := lpfnInternetCallback;

And the following line should be

Result := HttpMonitor.FInternetSetStatusCallback(hInet, lpfnInternetCallback)

You might find that enabling the typed address compiler option would help.

You also missed the stdcall in the declaration of FInternetStatusCallback.

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • Are you sure? This results in this `E2010 Incompatible types: 'Procedure' and 'PFNInternetStatusCallback'` – John Lewis Jan 19 '15 at 20:06
  • 1
    Do bear in mind that I'm missing all the type defs, knowledge of your compiler options, detailed knowledge of the detouring lib. The crux of the problem is as I saw. Surely you can see the erroneous indirection. – David Heffernan Jan 19 '15 at 20:09
  • This was the solution :) `HttpMonitor.FInternetStatusCallback := INTERNET_STATUS_CALLBACK(lpfnInternetCallback); Result := HttpMonitor.FInternetSetStatusCallback(hInet, INTERNET_STATUS_CALLBACK(@InternetStatusCallback));` – John Lewis Jan 19 '15 at 20:10
  • 1
    You would do well to stop abusing `@` in that way. Unfortunately almost all example code on the web leads you this way. Don't be fooled by that code. In general you don't need `@` to make function pointers. – David Heffernan Jan 19 '15 at 20:13
  • And if the callback were declared correctly then you should not need the `INTERNET_STATUS_CALLBACK(...)` type-cast, either. – Remy Lebeau Jan 19 '15 at 22:52
  • @RemyLebeau How exactly? – John Lewis Jan 20 '15 at 12:54
  • 1
    `INTERNET_STATUS_CALLBACK` is defined as an alias for `TFarProc` in the `WinInet` unit. I would define my own alias, ie `INTERNET_STATUS_CALLBACK_TYPE = procedure(hInet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: LPVOID; dwStatusInformationLength: DWORD); stdcall;`, and then use that everywhere. – Remy Lebeau Jan 20 '15 at 18:11
  • What @Remy says is spot on. This abuse of `TFarProc` is widespread in the Delphi header translations. It is utterly crazy because it throws away type safety for no gain at all. Unfortunately the developers and Emba won't fix this for fear of making existing code not compile. – David Heffernan Jan 20 '15 at 18:14
1

In addition to what DavidHeffernan said, you have a bigger problem to solve. Status callbacks are assigned on a per-HINTERNET basis, but you are treating them as a single global callback, which will not work. You have to keep track of each individual HINTERNET handle that is passed to InternetSetStatusCallback() so you can then call its appropriate callback from inside of your callback, based on the HINTERNET specified.

You also need to be able to remove HINTERNET handles from your tracking list when they are closed. You could use the INTERNET_STATUS_HANDLE_CLOSING status for that, however the documentation says that it is only triggered for HINTERNET handles that have a non-zero Context value assigned. So you will have to hook InternetCloseHandle() to account for HINTERNET handles that have a zero Context.

Try something more like this:

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;

With that said, there is one last problem to solve, and I do not have a solution for that - how to assign your callback to an HINTERNET handle that never gets passed to InternetSetStatusCallback() so you see it? InternetStatusCallback() does have an INTERNET_STATUS_HANDLE_CREATED status available, but the documentation states that it is only triggered by InternetConnect(). There are other WinInet function that create HINTERNET handles. So you may need additional hooks to account for all of the HINTERNET handles that you are interested in hooking status for.

Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
  • Much better in depth answer. Regards to the other problem I am aware of it. – John Lewis Jan 20 '15 at 18:46
  • However. `InternetSetStatusCallback` gets called only once? – John Lewis Jan 20 '15 at 18:53
  • If it is only getting called once, then there is only 1 `HINTERNET` handle that `TWebBrowser` is interested in getting status for, even though there could be multiple `HINTERNET` handles involved in an HTTP operation. Why are you hooking `InternetSetStatusCallback()` to begin with? What status are you looking for, that you cannot get from `TWebBrowser`'s own events? – Remy Lebeau Jan 20 '15 at 20:52