delphi.about.com一个钩子的实现代码

网络 Delphi

本文整理自网络，侵删。

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

修改部分如下


在CODE上查看代码片派生到我的代码片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;  

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;使用代码示例，这个工具支持多种钩子，我用的是键盘钩子： 


[delphi] view plaincopyprint?在CODE上查看代码片派生到我的代码片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 10.3 中安装程序自动升级插件autoupgrader_pro_v5.2

Delphi与汇编杂谈

Delphi 通�^窗口句柄或窗口标题得到进程句柄

Delphi简单判断程序30秒没有键盘和鼠标动作示例

Delphi 延时程序

解决Delphi程序在非中文系统下乱码

Delphi gif 动画建立

Delphi调用游戏call代码

fastmm5

Delphi xe10.x 快捷失灵解决办法

更多相关阅读请进入《Delphi》频道 >>



标签：

打赏

取消

感谢您的支持，我会继续努力的!

扫码支持
扫码打赏，您说多少就多少

打开支付宝扫一扫，即可进行扫码打赏哦

分享从这里开始，精彩与您同在

相关推荐

评论

管理员已关闭评论功能...