http://delphi.about.com/od/windowsshellapi/a/delphi-hooks.htm

 

 

 http://blog.csdn.net/youthon/article/details/43762965

delphi下支持64位的钩子实现

标签: hook钩子64位Delphi
 分类:
 

从delphi.about.com上找了一个钩子的实现代码,写得很不错,可惜不支持64位,后来有一个帖子里说参考classes单元改改,就自己改了一下,现在分享给大家

修改部分如下

 

[delphi] view plain copy
 
 在CODE上查看代码片派生到我的代码片
  1. const  
  2. {$IF Defined(CPUX86)}  
  3.   CodeBytes = 2;  
  4. {$ELSEIF Defined(CPUX64)}  
  5.   CodeBytes = 8;  
  6. {$IFEND}  
  7.   
  8.   
  9. type  
  10.   pObjectInstance = ^TObjectInstance;  
  11.   TObjectInstance = packed record  
  12.     Code: Byte;  
  13.     Offset: Integer;  
  14.     case Integer of  
  15.       0: (Next: pObjectInstance);  
  16.       1: (Method: THookMethod);  
  17.   end;  
  18. const  
  19. //  InstanceCount = 313; // set so that sizeof (TInstanceBlock) < PageSize  
  20.   InstanceCount = (4096 - SizeOf(Pointer) * 2 - CodeBytes) div SizeOf(TObjectInstance) - 1;  
  21. type  
  22.   pInstanceBlock = ^TInstanceBlock;  
  23.   TInstanceBlock = packed record  
  24.     Next: pInstanceBlock;  
  25.     Code: array[1..CodeBytes] of Byte;  
  26.     WndProcPtr: Pointer;  
  27.     Instances: array[0..InstanceCount] of TObjectInstance;  
  28.   end;  
  29.   
  30. var  
  31.   InstBlockList: pInstanceBlock = nil;  
  32.   InstFreeList: pObjectInstance = nil;  
  33.   
  34.   
  35. function StdHookProc(Code: UINT; WParam: WPARAM; LParam: WPARAM): LResult; stdcall;  
  36. {$IF Defined(CPUX86)}  
  37. { In    ECX = Address of method pointer }  
  38. { Out   EAX = Result }  
  39. asm  
  40.         XOR     EAX,EAX  
  41.         PUSH    EAX  
  42.         PUSH    LParam  
  43.         PUSH    WParam  
  44.         PUSH    Code  
  45.         MOV     EDX,ESP  
  46.         MOV     EAX,[ECX].Longint[4]  
  47.         CALL    [ECX].Pointer  
  48.         ADD     ESP,12  
  49.         POP     EAX  
  50. end;  
  51. {$ELSEIF Defined(CPUX64)}  
  52. { In    R11 = Address of method pointer }  
  53. { Out   RAX = Result }  
  54. var  
  55.   HookMsg: THookMsg;  
  56. asm  
  57.         .PARAMS 2  
  58.         MOV     HookMsg.Code,Code  
  59.         MOV     HookMsg.WParam,WParam  
  60.         MOV     HookMsg.LParam,LParam  
  61.         MOV     HookMsg.Result,0  
  62.         LEA     RDX,HookMsg  
  63.         MOV     RCX,[R11].TMethod.Data  
  64.         CALL    [R11].TMethod.Code  
  65.         MOV     RAX,HookMsg.Result  
  66. end;  
  67. {$IFEND}  
  68.   
  69. { Allocate a hook method instance }  
  70.   
  71. function CalcJmpOffset(Src, Dest: Pointer): Longint;  
  72. begin  
  73.   Result := IntPtr(Dest) - (IntPtr(Src) + 5);  
  74. end;  
  75.   
  76. function MakeHookInstance(Method: THookMethod): Pointer;  
  77. const  
  78.   BlockCode: array[1..CodeBytes] of Byte = (  
  79. {$IF Defined(CPUX86)}  
  80.     $59,                       { POP ECX }  
  81.     $E9);                      { JMP StdWndProc }  
  82. {$ELSEIF Defined(CPUX64)}  
  83.     $41,$5b,                   { POP R11 }  
  84.     $FF,$25,$00,$00,$00,$00);  { JMP [RIP+0] }  
  85. {$IFEND}  
  86.   PageSize = 4096;  
  87. var  
  88.   Block: PInstanceBlock;  
  89.   Instance: PObjectInstance;  
  90. begin  
  91.   if InstFreeList = nil then  
  92.   begin  
  93.     Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);  
  94.     Block^.Next := InstBlockList;  
  95.     Move(BlockCode, Block^.Code, SizeOf(BlockCode));  
  96. {$IF Defined(CPUX86)}  
  97.     Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdHookProc));  
  98. {$ELSEIF Defined(CPUX64)}  
  99.     Block^.WndProcPtr := @StdHookProc;  
  100. {$IFEND}  
  101.     Instance := @Block^.Instances;  
  102.     repeat  
  103.       Instance^.Code := $E8;  { CALL NEAR PTR Offset }  
  104.       Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);  
  105.       Instance^.Next := InstFreeList;  
  106.       InstFreeList := Instance;  
  107.       Inc(PByte(Instance), SizeOf(TObjectInstance));  
  108.     until IntPtr(Instance) - IntPtr(Block) >= SizeOf(TInstanceBlock);  
  109.     InstBlockList := Block;  
  110.   end;  
  111.   Result := InstFreeList;  
  112.   Instance := InstFreeList;  
  113.   InstFreeList := Instance^.Next;  
  114.   Instance^.Method := Method;  
  115. end;  
  116.   
  117. { Free a hook method instance }  
  118.   
  119. procedure FreeHookInstance(ObjectInstance: Pointer);  
  120. begin  
  121.   if ObjectInstance = nil then  
  122.     Exit;  
  123.   
  124.   pObjectInstance(ObjectInstance)^.Next := InstFreeList;  
  125.   InstFreeList := ObjectInstance  
  126. end;  
使用代码示例,这个工具支持多种钩子,我用的是键盘钩子:

 

 

[delphi] view plain copy
 
 在CODE上查看代码片派生到我的代码片
  1. procedure THookManager.CreateHook(hookMethod: THookNotify);  
  2. begin  
  3.   KeyboardHook := TKeyboardHook.Create;  
  4.   KeyboardHook.OnPreExecute := KeyboardHookPreEx;  
  5.   KeyboardHook.Active := True;  
  6. end;  
  7.   
  8. procedure THookManager.KeyboardHookPreExecute(Hook: THook; var Hookmsg: THookMsg);  
  9. var  
  10.   Key: Word;  
  11.   Handled: Boolean;  
  12. begin  
  13.   Handled := false;  
  14.   Key := Hookmsg.WPARAM;  
  15.   if Hookmsg.Code = HC_ACTION then  
  16.   begin  
  17.     if (key=ord('1')) and InHotKeyState then  
  18.     begin  
  19.       //在KeyDown时发送消息,不使用keyup是因为alt等键一般被松开了  
  20.       if KeyboardHook.KeyState = ksKeyDown then  
  21.       begin  
  22.         handled := HandleNumberKey(key);  
  23.         if not handled then  
  24.           HandleKey(key); //自己的处理逻辑  
  25.       end;  
  26.       //Keyup、KeyDown都不给其他程序处理,否则可能会造成两个程序同时相应按键  
  27.       Handled := True;  
  28.     end;  
  29.   end;  
  30.   Hookmsg.Result := IfThen(Handled, 1, 0); //math单元  
  31. end;  
  32.   
  33. function IsKeyPress( KeyState: TKeyBoardState; key: Byte ): Boolean;  
  34. begin  
  35.   Result := KeyState[key] shr 7 = 1;  
  36. end;  
  37.   
  38. function THookManager.InHotKeyState(): Boolean;  
  39. var  
  40.   KeyState: TKeyBoardState;  
  41.   bAlt, bShift, bCtrl: Boolean;  
  42. begin  
  43.   GetKeyboardState(KeyState);  
  44.   bAlt := IsKeyPress(KeyState, VK_MENU);  
  45.   bCtrl := IsKeyPress(KeyState, VK_Control);  
  46.   bShift := IsKeyPress(KeyState, VK_Shift);  
  47.   Result := bAlt and not bCtrl and not bShift;  
  48. end;  

完整代码去我的资源里下载吧,我用的是Delphi XE2(第一个支持64位的版本)

 

http://download.csdn.net/detail/youthon/8442961