Set HOOK to local method

I'm creating a component, that must process parent's messages. I would like to use hooks, but I don't know, how to set hook to local (component's) method ...

function Mycomponent.MessageHookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): lResult stdcall;
begin
 ......
end;

constructor Mycomponent.create(AOwner : TComponent);
begin

SetWindowsHookEx(WH_CallWndProc, MessageHookProc, 0, GetCurrentThreadId);

end;

Global method is not a solution, since the method is only one and I will have more than one instances on different forms. Any Hint ? thanx
AleqAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
rpoConnect With a Mentor Commented:
You can use following unit to make posiible to set a method as a hook function.

example :
-----------
TForm1 : class(TForm)
 ....
  HookProc : pointer;
  ThisHook : Handle;
....
end;

procedure TForm1.MyHook (var HookCall: THookCall);
begin
....{the hook comes here}
end;

procedure TForm1.SetHook;
begin
  HookProc := MakeHookInstance (MyHook);
  ThisHook := SetWindowsHookEx (WH_CALLWNDPROC,
                         HookProc,HInstance,GetCurrentThreadID);
end;

procedure TForm1.UnsetHook;
begin
  UnhookWindowsHookEx(ThisHook);
  FreeHookInstance(HookProk);
end;
-------- end of example ---------

-- the unit containinig MakeHookInstance and FreeHookInstance --
//------------------------------------------------------------------------------
 //                        HOOK METHOD INSTANCE
 //
 // These few lines of code implement for windows hooks what MakeObjectInstance
 // and FreeObjectInstance do for windows message functions.  They allow a method
 // to be written and passed into the SetWindowsHookEx API function rather than a
 // stand alone function which cannot directly access variables or methods.
 //
 // An example of use is in the IDE Peek expert.
 //
 // The code is based entirely on the MakeObjectInstance and FreeObjectInstance
 // in the Delphi Forms unit.  In fact my only input has been to change a few
 // names and make it work for Hook calls rather than Message calls.  So I don't
 // claim a lot.  Borland's ownership of this code is recognised and I hope
 // noone there minds my borrowing it and bodging it for this purpose!
 //
 // This way of writing a hook function is a bit wasteful of memory for what you
 // are doing (but hell, what's 4KB nowadays!, this isn't a Z80 and CPM).
 //
 // Only tested under Delphi 3.02
 //
 // Version 1.00 5-2-98 Grahame Marsh
 //
 // Freeware - you get it for free, I take nothing, I make no promises!
 //
 // Please feel free to contact me: grahame.s.marsh@courtaulds.com
 //------------------------------------------------------------------------------

 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.
---------------------------------------------------------------------

Credits to Grahame Marsh for providing the solution.

These functions chacked and they work fine.

Roman.
0
 
AleqAuthor Commented:
Or else - I need to catch form's events from my component which user puts on this form.
0
 
rwilson032697Commented:
When you say events, do you mean windows messages, or things like OnClick etc...

Cheers,

Raymond.
0
 
AleqAuthor Commented:
Wow ! It looks very promising.
I'll try it ASAP
0
 
AleqAuthor Commented:
Wow ! It looks very promising.
I'll try it ASAP
0
All Courses

From novice to tech pro — start learning today.