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?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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
rpoCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.