There's Method in My (Hook) Madness!

The Unofficial Newsletter of Delphi Users - by Robert Vivrette

There's Method in My (Hook) Madness!

by Grahame Marsh - gsmarsh@aol.com

Recently I was experimenting with an application which used a hook to monitor events. Hooks are really useful for a number of like tasks but they are unsupported directly in Delphi, so you use the (win 32) API calls, such as:

var

ThisHook : hHook;

.....

ThisHook := SetWindowsHookEx (WH_CALLWNDPROC, HookProc, HInstance, GetCurrentThreadID);

This puts a WH_CALLWNDPROC type hook in to the current application's instance and thread. When the hook fires it calls the HookProc, which is declared like this:

function HookProc (nCode: Integer; wParam, lParam: Longint): Longint; stdcall;

begin

//.... my code goes here

Result := CallNextHookEx (ThisHook, nCode, wParam, lParam);

//.... or goes in here

end;

And finally, when you are finished with the hook you disconnect it:

UnhookWindowsHookEx (ThisHook);

You'll find an example of these calls used in Borland's FORMS.PAS; also you can search the WIN32.HLP file for SetWindowsHookEx and this will show you the types of hooks available. But in this simple example you'll have noticed that I have had to use a global variable and a stand-alone function. This gives you a problem if you multiple hooks in the same application are a possibility, or if you want to refer to methods or variables inside a class, without going through yet another global variable (as in the case of FORMS.PAS).

The same problem arises when you want to write your own windows message procedures inside a class. But Borland have provided the MakeObjectInstance (and a corresponding FreeObjectInstance) to allow message procedures to be methods. So I wondered if the same technique could be used to make a hook function a method. The resulting code used the Borland code for MakeObjectInstance but substituted a call suitable for hooks. I came up with this code which is only a little modified from the Borland original (also in FORMS.PAS):

unit

HookInst;

interface

uses
Windows;

type
THookCall = packed record
    Code   : integer;
    WParam : WPARAM;
    LParam : LPARAM;
    Result : LResult
end;

THookMethod = procedure (var HookCall: THookCall) of object;

function MakeHookInstance (Method: THookMethod): pointer;
procedure FreeHookInstance (ObjectInstance: pointer);

implementation

const
InstanceCount = 313; // set so that sizeof (TInstanceBlock) < PageSize

type
PObjectInstance = ^TObjectInstance;
TObjectInstance = packed record
    Code: Byte;
    Offset: Integer;
    case Integer of
      0: (Next: PObjectInstance);
      1: (Method: THookMethod);
end;

type
PInstanceBlock = ^TInstanceBlock;
TInstanceBlock = packed record
    Next: PInstanceBlock;
    Code: array[1..2] of Byte;
    WndProcPtr: Pointer;
    Instances: array[0..InstanceCount] of TObjectInstance;
end;

var
InstBlockList : PInstanceBlock = nil;
InstFreeList : PObjectInstance = nil;

function StdHookProc (Code, WParam: WPARAM; LParam: LPARAM): LResult; stdcall; assembler;
asm
        XOR     EAX,EAX
        PUSH    EAX
        PUSH    LParam
        PUSH    WParam
        PUSH    Code
        MOV     EDX,ESP
        MOV     EAX,[ECX].Longint[4]
        CALL    [ECX].Pointer
        ADD     ESP,12
        POP     EAX
end;

{ Allocate a hook method instance }

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeHookInstance(Method: THookMethod): Pointer;
const
BlockCode: array [1..2] of Byte = ($59, $E9);
PageSize = 4096;
var
Block: PInstanceBlock;
Instance: PObjectInstance;
begin
if InstFreeList = nil then
begin
    Block := VirtualAlloc (nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
    Block^.Next := InstBlockList;
    Move(BlockCode, Block^.Code, SizeOf(BlockCode));
    Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdHookProc));
    Instance := @Block^.Instances;
    repeat
      Instance^.Code := $E8;
      Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
      Instance^.Next := InstFreeList;
      InstFreeList := Instance;
      Inc(Longint(Instance), SizeOf(TObjectInstance));
    until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
    InstBlockList := Block
end;
Result := InstFreeList;
Instance := InstFreeList;
InstFreeList := Instance^.Next;
Instance^.Method := Method
end;

{ Free a hook method instance }

procedure FreeHookInstance (ObjectInstance: Pointer);
begin
if ObjectInstance <> nil then
begin
PObjectInstance(ObjectInstance)^.Next := InstFreeList;
InstFreeList := ObjectInstance
end
end;

end.

I'm sorry that this unit is not better documented, but although I understand the principle of what is happening, I've not worked out the details! But it does work!

So how do you use it?

Let's say you want a WH_CALLWNDPROC hook in a class. You define your hook function, a pointer variable (that will be a pointer to the method) and a hook handle (so you can correctly chain the hook events):

type

TMyClass = class (TWhat)

....

private

ThisHook : hHook;

HookProc : pointer;

....

function MyHookProc (var HookCall: THookCall);

....

end;

And in the class constructor, you create a pointer to the class method and set the hook running with a call to the API:

HookProc := MakeHookInstance (MyHookProc);

ThisHook := SetWindowsHookEx (WH_CALLWNDPROC, HookProc, HInstance, GetCurrentThreadID);

And next you must define your hook function, which is now a method:

function TMyClass.MyHookProc (var HookCall: THookCall);

begin

....

with HookCall do

Result := CallNextHookEx (ThisHook, Code, wParam, lParam);

....

end;

Finally, in the destructor, you clean up:

UnhookWindowsHookEx (ThisHook);

FreeHookInstance (HookProc);

So, in conclusion...

No global variables! No stand alone hook function! The hook function can easily reference the class methods!