http://delphi.about.com/od/windowsshellapi/a/delphi-hooks.htm
http://blog.csdn.net/youthon/article/details/43762965
delphi下支持64位的钩子实现
分类:
版权声明:本文为博主原创文章,未经博主允许不得转载。
从delphi.about.com上找了一个钩子的实现代码,写得很不错,可惜不支持64位,后来有一个帖子里说参考classes单元改改,就自己改了一下,现在分享给大家
修改部分如下
- const
- {$IF Defined(CPUX86)}
- CodeBytes = 2;
- {$ELSEIF Defined(CPUX64)}
- CodeBytes = 8;
- {$IFEND}
- type
- pObjectInstance = ^TObjectInstance;
- TObjectInstance = packed record
- Code: Byte;
- Offset: Integer;
- case Integer of
- 0: (Next: pObjectInstance);
- 1: (Method: THookMethod);
- end;
- const
- // InstanceCount = 313; // set so that sizeof (TInstanceBlock) < PageSize
- InstanceCount = (4096 - SizeOf(Pointer) * 2 - CodeBytes) div SizeOf(TObjectInstance) - 1;
- type
- pInstanceBlock = ^TInstanceBlock;
- TInstanceBlock = packed record
- Next: pInstanceBlock;
- Code: array[1..CodeBytes] of Byte;
- WndProcPtr: Pointer;
- Instances: array[0..InstanceCount] of TObjectInstance;
- end;
- var
- InstBlockList: pInstanceBlock = nil;
- InstFreeList: pObjectInstance = nil;
- function StdHookProc(Code: UINT; WParam: WPARAM; LParam: WPARAM): LResult; stdcall;
- {$IF Defined(CPUX86)}
- { In ECX = Address of method pointer }
- { Out EAX = Result }
- 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;
- {$ELSEIF Defined(CPUX64)}
- { In R11 = Address of method pointer }
- { Out RAX = Result }
- var
- HookMsg: THookMsg;
- asm
- .PARAMS 2
- MOV HookMsg.Code,Code
- MOV HookMsg.WParam,WParam
- MOV HookMsg.LParam,LParam
- MOV HookMsg.Result,0
- LEA RDX,HookMsg
- MOV RCX,[R11].TMethod.Data
- CALL [R11].TMethod.Code
- MOV RAX,HookMsg.Result
- end;
- {$IFEND}
- { Allocate a hook method instance }
- function CalcJmpOffset(Src, Dest: Pointer): Longint;
- begin
- Result := IntPtr(Dest) - (IntPtr(Src) + 5);
- end;
- function MakeHookInstance(Method: THookMethod): Pointer;
- const
- BlockCode: array[1..CodeBytes] of Byte = (
- {$IF Defined(CPUX86)}
- $59, { POP ECX }
- $E9); { JMP StdWndProc }
- {$ELSEIF Defined(CPUX64)}
- $41,$5b, { POP R11 }
- $FF,$25,$00,$00,$00,$00); { JMP [RIP+0] }
- {$IFEND}
- 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));
- {$IF Defined(CPUX86)}
- Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdHookProc));
- {$ELSEIF Defined(CPUX64)}
- Block^.WndProcPtr := @StdHookProc;
- {$IFEND}
- Instance := @Block^.Instances;
- repeat
- Instance^.Code := $E8; { CALL NEAR PTR Offset }
- Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
- Instance^.Next := InstFreeList;
- InstFreeList := Instance;
- Inc(PByte(Instance), SizeOf(TObjectInstance));
- until IntPtr(Instance) - IntPtr(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
- Exit;
- pObjectInstance(ObjectInstance)^.Next := InstFreeList;
- InstFreeList := ObjectInstance
- end;
- procedure THookManager.CreateHook(hookMethod: THookNotify);
- begin
- KeyboardHook := TKeyboardHook.Create;
- KeyboardHook.OnPreExecute := KeyboardHookPreEx;
- KeyboardHook.Active := True;
- end;
- procedure THookManager.KeyboardHookPreExecute(Hook: THook; var Hookmsg: THookMsg);
- var
- Key: Word;
- Handled: Boolean;
- begin
- Handled := false;
- Key := Hookmsg.WPARAM;
- if Hookmsg.Code = HC_ACTION then
- begin
- if (key=ord('1')) and InHotKeyState then
- begin
- //在KeyDown时发送消息,不使用keyup是因为alt等键一般被松开了
- if KeyboardHook.KeyState = ksKeyDown then
- begin
- handled := HandleNumberKey(key);
- if not handled then
- HandleKey(key); //自己的处理逻辑
- end;
- //Keyup、KeyDown都不给其他程序处理,否则可能会造成两个程序同时相应按键
- Handled := True;
- end;
- end;
- Hookmsg.Result := IfThen(Handled, 1, 0); //math单元
- end;
- function IsKeyPress( KeyState: TKeyBoardState; key: Byte ): Boolean;
- begin
- Result := KeyState[key] shr 7 = 1;
- end;
- function THookManager.InHotKeyState(): Boolean;
- var
- KeyState: TKeyBoardState;
- bAlt, bShift, bCtrl: Boolean;
- begin
- GetKeyboardState(KeyState);
- bAlt := IsKeyPress(KeyState, VK_MENU);
- bCtrl := IsKeyPress(KeyState, VK_Control);
- bShift := IsKeyPress(KeyState, VK_Shift);
- Result := bAlt and not bCtrl and not bShift;
- end;
完整代码去我的资源里下载吧,我用的是Delphi XE2(第一个支持64位的版本)
delphi lazarus opengl
网页操作自动化, 图像分析破解,游戏开发