How to hook COM interfaces?

Question

How can I properly hook COM interfaces in Delphi? The following code should work but it crashes when I try to call the original function.

First chance exception at $725E1C46. Exception class $C0000005 with message 'access violation at 0x725e1c46: write of address 0x725de532'. Process Project.exe (6524)

unit ComHook;

interface

uses
    Winapi.Windows,
    Winapi.WinInet,
    ComObj,
    ComServ,
    ActiveX,
    UrlMon,
    MSHTML,
    SHDocVw,
    DDetours;

const
    CLSID_HttpProtocol: TGUID = '{79EAC9E2-BAF9-11CE-8C82-00AA004BA90B}';

type
  TInternetProtocol = record
    class function Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;  static;
    class function Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; static;
    class function LockRequest(dwOptions: DWORD): HResult;  static;
    class function UnlockRequest: HResult; static;
  end;

var
    FInternetProtocol: IInternetProtocol;
    FRead: function(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
    FSeek: function(dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult;
    FLockRequest: function(dwOptions: DWORD): HResult;
    FUnlockRequest: function: HResult;

implementation

{ TInternetProtocol }

class function TInternetProtocol.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
begin
  Result := FRead(pv, cb, cbRead);
end;

class function TInternetProtocol.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult;
begin
  Result := FSeek(dlibMove, dwOrigin, libNewPosition);
end;

class function TInternetProtocol.LockRequest(dwOptions: DWORD): HResult;
begin
  Result := FLockRequest(dwOptions); // Crash!
end;

class function TInternetProtocol.UnlockRequest: HResult;
begin
  Result := FUnlockRequest;
end;

initialization
  CoCreateInstance(CLSID_HttpProtocol, nil, CLSCTX_INPROC_SERVER, IID_IInternetProtocol, FInternetProtocol);
  @FRead := InterceptCreate(FInternetProtocol, 7, @TInternetProtocol.Read);
  @FSeek := InterceptCreate(FInternetProtocol, 8, @TInternetProtocol.Seek);
  @FLockRequest := InterceptCreate(FInternetProtocol, 9, @TInternetProtocol.LockRequest);
  @FUnlockRequest := InterceptCreate(FInternetProtocol, 10, @TInternetProtocol.UnlockRequest);
end.


...

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

Answer 1

Three mistakes that I can see:

1. You have missed the calling convention. These methods should all be stdcall.
2. You need to include the instance pointer as the first parameter of each method.
3. Your indices are wrong. You need to count from zero and account for the three methods of IInterface.

After the changes your code should look like this:

type
  TInternetProtocol = record
    class function Read(inst: Pointer; pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall; static;
    class function Seek(inst: Pointer; dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall; static;
    class function LockRequest(inst: Pointer; dwOptions: DWORD): HResult; stdcall; static;
    class function UnlockRequest(inst: Pointer): HResult; stdcall; static;
  end;

var
    FInternetProtocol: IInternetProtocol;
    FRead: function(inst: Pointer; pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall;
    FSeek: function(inst: Pointer; dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
    FLockRequest: function(inst: Pointer; dwOptions: DWORD): HResult; stdcall;
    FUnlockRequest: function(inst: Pointer): HResult; stdcall;

....

@FRead := InterceptCreate(FInternetProtocol, 9, @TInternetProtocol.Read);
@FSeek := InterceptCreate(FInternetProtocol, 10, @TInternetProtocol.Seek);
@FLockRequest := InterceptCreate(FInternetProtocol, 11, @TInternetProtocol.LockRequest);
@FUnlockRequest := InterceptCreate(FInternetProtocol, 12, @TInternetProtocol.UnlockRequest);

FWIW, the latest version of the Delphi Detours library allows you to hook interface methods by name which makes life a little simpler.