Windows-hooks


            Title: Windows hooks
Question: A lot of articles has been written about windowsHooks. Here is yet an other one. The diffrence between this at all the others are that my hook implementation are done in a component, and your hook method are a method !!!!
Answer:
HOOKS
A lot of articles has been written about windowsHooks. Here is yet an other one. The diffrence between this at all the others are that my hook implementation are done in a component, and your hook method are a method !!!!
If you needd an introduction to HOOKS then I'm sure Dk3 can provide you one.
This aim of this article are to provide the reader with a new way of implementing hooks. The Object orientated way.
{
*****************************************************************************
* *
* Hooks *
* *
* By Jens Borrisholt *
* Jens@Borrisholt.com *
* *
* This file may be distributed and/or modified under the terms of the GNU *
* General Public License (GPL) version 2 as published by the Free Software *
* Foundation. *
* *
* This file has no warranty and is used at the users own peril *
* *
* Please report any bugs to Jens@Borrisholt.com or contact me if you want *
* to contribute to this unit. It will be deemed a breach of copyright if *
* you publish any source code (modified or not) herein under your own name *
* without the authors consent!!!!! *
* *
* CONTRIBUTIONS:- *
* Jens Borrisholt (Jens@Borrisholt.com) [ORIGINAL AUTHOR] *
* *
*****************************************************************************
}
unit hooks;
interface
uses
 Windows, Classes;
type
 THookMsg = packed record
 Code: Integer;
 WParam: WPARAM;
 LParam: LPARAM;
 Result: LResult
 end;
 ULONG_PTR = ^DWORD;
 KBDLLHOOKSTRUCT = packed record
 vkCode,
 scanCodem,
 flags,
 time: DWORD;
 dwExtraInfo: ULONG_PTR;
 end;
 pKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
const
 WH_KEYBOARD_LL = 13;
 WH_MOUSE_LL = 14;
 (*
 * Low level hook flags
 *)
 LLKHF_EXTENDED = $01;
 LLKHF_INJECTED = $10;
 LLKHF_ALTDOWN = $20;
 LLKHF_UP = $80;
type
 THook = class;
 THookMethod = procedure(var HookMsg: THookMsg) of object;
 THookNotify = procedure(Hook: THook; var Hookmsg: THookMsg) of object;
 THook = class(TComponent)
 private
 fHook: hHook;
 fHookProc: Pointer;
 fOnPreExecute: THookNotify;
 fOnPostExecute: THookNotify;
 fActive: Boolean;
 fLoadedActive: Boolean;
 fThreadID: Integer;
 procedure SetActive(NewState: Boolean);
 procedure SetThreadID(NewID: Integer);
 procedure HookProc(var HookMsg: THookMsg);
 protected
 procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); virtual;
 procedure PostExecute(var HookMsg: THookMsg); virtual;
 function AllocateHook: hHook; virtual; abstract;
 procedure Loaded; override;
 public
 constructor Create(Owner: TComponent); override;
 destructor Destroy; override;
 property ThreadID: Integer read fThreadID write SetThreadID stored False;
 property Active: Boolean read fActive write SetActive;
 property OnPreExecute: THookNotify read fOnPreExecute write fOnPreExecute;
 property OnPostExecute: THookNotify read fOnPostExecute write fOnPostExecute;
 published
 end;
type
 TCallWndProcHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TCallWndProcRetHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TCBTHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TDebugHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TGetMessageHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TJournalPlaybackHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TJournalRecordHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TKeyboardHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TMouseHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TMsgHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TShellHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TSysMsgHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
type
 TLowLevelKeyboardHook = class(THook)
 private
 protected
 public
 function AllocateHook: hHook; override;
 published
 property Active;
 property OnPreExecute;
 property OnPostExecute;
 end;
function MakeHookInstance(Method: THookMethod): Pointer;
procedure FreeHookInstance(ObjectInstance: Pointer);
implementation
uses
 SysUtils;
const
 InstanceCount = 313; // set so that sizeof (TInstanceBlock) 
type
 pObjectInstance = ^TObjectInstance;
 TObjectInstance = packed record
 Code: Byte;
 Offset: Integer;
 case Integer of
 0: (Next: pObjectInstance);
 1: (Method: THookMethod);
 end;
 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;
constructor THook.Create(Owner: TComponent);
begin
 inherited Create(Owner);
 fHookProc := MakeHookInstance(HookProc);
 fActive := False;
 fLoadedActive := False;
 fHook := 0;
 ThreadID := GetCurrentThreadID;
end;
destructor THook.Destroy;
begin
 Active := False;
 FreeHookInstance(fHookProc);
 inherited;
end;
procedure THook.SetActive(NewState: Boolean);
begin
 if (csLoading in componentState) then
 begin
 fLoadedActive := NewState;
 end
 else if (fActive NewState) then
 begin
 fActive := NewState;
 case (Active and (not (csDesigning in ComponentState))) of
 True:
 begin
 fHook := AllocateHook;
 if (fHook = 0) then
 begin
 fActive := False;
 raise Exception.Create(Classname + ' CREATION FAILED!');
 end;
 end;
 False:
 begin
 if (FHook 0) then
 UnhookWindowsHookEx(fHook);
 fHook := 0;
 end;
 end;
 end;
end;
procedure THook.SetThreadID(NewID: Integer);
var
 IsActive: Boolean;
begin
 IsActive := fActive;
 Active := False;
 fThreadID := NewID;
 Active := IsActive;
end;
procedure THook.Loaded;
begin
 inherited;
 Active := fLoadedActive;
end;
procedure THook.HookProc(var HookMsg: THookMsg);
var
 Handled: Boolean;
begin
 Handled := False;
 PreExecute(HookMsg, Handled);
 if not Handled then
 begin
 with HookMsg do
 Result := CallNextHookEx(fHook, Code, wParam, lParam);
 PostExecute(HookMsg);
 end;
end;
procedure THook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
 if Assigned(fOnPreExecute) then
 fOnPreExecute(Self, HookMsg);
 Handled := HookMsg.Result 0;
end;
procedure THook.PostExecute(var HookMsg: THookMsg);
begin
 if Assigned(fOnPostExecute) then
 fOnPostExecute(Self, HookMsg);
end;
function TCallWndProcHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_CALLWNDPROC, fHookProc, HInstance, ThreadID);
end;
function TCallWndProcRetHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_CALLWNDPROCRET, fHookProc, hInstance, ThreadID);
end;
function TCBTHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_CBT, fHookProc, hInstance, ThreadID);
end;
function TDebugHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_DEBUG, fHookProc, hInstance, ThreadID);
end;
function TGetMessageHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_GETMESSAGE, fHookProc, hInstance, ThreadID);
end;
function TJournalPlaybackHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_JOURNALPLAYBACK, fHookProc, hInstance, ThreadID);
end;
function TJournalRecordHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_JOURNALRECORD, fHookProc, hInstance, ThreadID);
end;
function TKeyboardHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_KEYBOARD, fHookProc, hInstance, ThreadID);
end;
function TMouseHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_MOUSE, fHookProc, hInstance, ThreadID);
end;
function TMsgHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_MSGFILTER, fHookProc, hInstance, ThreadID);
end;
function TShellHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_SHELL, fHookProc, hInstance, ThreadID);
end;
function TSysMsgHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_SYSMSGFILTER, fHookProc, hInstance, ThreadID);
end;
function TLowLevelKeyboardHook.AllocateHook: hHook;
begin
 Result := SetWindowsHookEx(WH_KEYBOARD_LL, fHookProc, hInstance, 0);
end;
end.
An example of use :
place two Tedit on a form and then the following code :
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, menus, Dialogs, Hooks, ComCtrls, clipBrd;
type
 TForm1 = class(TForm)
 Edit1: TEdit;
 Edit2: TEdit;
 procedure FormCreate(Sender: TObject);
 private
 KeyboardHook: TKeyboardHook;
 procedure KeyboardHookPreExecute(Hook: THook; var Hookmsg: THookMsg); virtual;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
 KeyboardHook := TKeyboardHook.Create(Self);
 KeyboardHook.OnPreExecute := KeyboardHookPreExecute;
 KeyboardHook.Active := True;
end;
type
 TKeyState = (ksKeyDown, ksKeyIsDown, ksDummy, ksKeyUp);
 //ksDummy are NEVER to be used, it is only made as an place holder
const
 LeftCtrlKey = $1D;
 RightCtrlKey = $1D + $100;
 LeftShiftKey = $2A;
 RightShiftKey = $36;
 AltAltGrKey = $38;
 AltKey = $2000 + AltAltGrKey;
 HoldingDown = $4000;
 GoingUp = $C000;
procedure TForm1.KeyboardHookPreExecute(Hook: THook; var Hookmsg: THookMsg);
var
 Key: Integer;
 KeyState : TKeyState;
 i: Integer;
 Shift, ShortCut: TShortCut;
 s : String;
begin
 KeyState := TKeyState(Hookmsg.lParam shr 30);
 i := Hookmsg.lParam shr 16;
 if KeyState ksKeyDown then
 exit;
 Key := Hookmsg.wParam;
 if Key in [VK_NUMPAD0..VK_NUMPAD9] then
 Key := (Key - VK_NUMPAD0) + $30
 else if Key = 188 then
 Key := VK_DECIMAL;
 Hookmsg.Result := 1;
 Shift := scNone;
 if GetKeyState(VK_SHIFT) Shift := Shift or scShift;
 if GetKeyState(VK_CONTROL) Shift := Shift or scCtrl;
 if GetKeyState(VK_MENU) Shift := Shift or scAlt;
 ShortCut := Key or Shift;
 Edit1.Text := IntToStr(ShortCut);
 Edit2.Text := ShortCutToText(ShortCut);
 Edit1.CopyToClipboard;
 s := cxTextEdit1.Text + '; //' + cxTextEdit2.Text;
 Clipboard.SetTextBuf(pointer(s));
end;
Jens Borrisholt
System Delphi
