Mega Code Archive
Windows hooks
<![CDATA[
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
]]>