zoukankan      html  css  js  c++  java
  • Delphi HOOK示例

    本应用程序的Hook:

    unit UFrmMain;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;
    
    type
      TForm1 = class(TForm)
        btnClose: TButton;
        btnSetHook: TButton;
        btnSizeLongInt: TButton;
        procedure btnCloseClick(Sender: TObject);
        procedure btnSetHookClick(Sender: TObject);
        procedure btnSizeLongIntClick(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    var
        hHookKeyboard : HHOOK;
    
    procedure TForm1.btnCloseClick(Sender: TObject);
    begin
        close;
    end;
    
    function MouseHook(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
    begin
        result := 1;
    end;
    
    function KeyHook(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
    begin
        if (wparam = vk_f4) and ((lparam and (1 shl 29)) > 0) then
            result := 1
        else
            result := CallNextHookEx(hHookKeyboard, code, wparam, lparam);
    end;
    
    procedure TForm1.btnSetHookClick(Sender: TObject);
    begin
        SetWindowsHookEx(WH_MOUSE,@MouseHook,HInstance,GetCurrentThreadId());
        hHookKeyboard := SetWindowsHookEx(WH_KEYBOARD,@KeyHook,HInstance,GetCurrentThreadId());
    end;
    
    procedure TForm1.btnSizeLongIntClick(Sender: TObject);
    begin
        ShowMessageFmt('sizeof longint:%d',[sizeof(longint)]);
    end;
    
    end.
    

    //HookLibInterface.pas
    unit HookLibInterface;
    
    interface
    USES
        windows;
    {$IFNDEF HookLibInterface}
        procedure SetHook(hwnd1:HWND); stdcall;
        procedure UnHook(); stdcall;
    {$ENDIF}
    
    implementation
    {$IFNDEF HookLibInterface}
        procedure SetHook(hwnd1:HWND); external 'HookLib.dll' name 'SetHook';
        procedure UnHook(); external 'HookLib.dll' name 'UnHook';
    {$ENDIF}
    
    end.
    

      

    //HookLib.dpr
    library HookLib;
    
    { Important note about DLL memory management: ShareMem must be the
      first unit in your library's USES clause AND your project's (select
      Project-View Source) USES clause if your DLL exports any procedures or
      functions that pass strings as parameters or function results. This
      applies to all strings passed to and from your DLL--even those that
      are nested in records and classes. ShareMem is the interface unit to
      the BORLNDMM.DLL shared memory manager, which must be deployed along
      with your DLL. To avoid using BORLNDMM.DLL, pass string information
      using PChar or ShortString parameters. }
    
    uses
      SysUtils,
      Classes,
      Windows,
      Messages,
      Dialogs,
      HookLibInterface in 'HookLibInterface.pas';
    
    {$R *.res}
    var
        hMouseHook : HHOOK;
        hKeyboardHook : HHOOK;
    var
        g_hwnd : HWND;
        
    function MouseHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
    begin
        result := 1;
    end;
    function KeyboardHookProc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
    begin
        if vk_f2 = wparam then
        begin
            PostMessage(g_hwnd,wm_close,0,0);
            //UnhookWindowsHookEx(hMouseHook);
            UnhookWindowsHookEx(hKeyboardHook);
        end;
        result := 1;
    end;
    
    procedure SetHook(hwnd1 : HWND); stdcall;
    begin
        g_hwnd := hwnd1;
        //hMouseHook := SetWindowsHookEx(WH_MOUSE, MouseHookProc, GetModuleHandle('HookLib.dll'),0);
        hKeyboardHook := SetWindowsHookEx(WH_KEYBOARD, KeyboardHookProc, GetModuleHandle('HookLib.dll'),0);
        showmessage('成功加载勾子程序!');
    end;
    
    procedure UnHook(); stdcall;
    begin
        //UnhookWindowsHookEx(hMouseHook);
        UnhookWindowsHookEx(hKeyboardHook);
        showmessage('成功取消勾子程序!');
    end;
    exports
        SetHook,
        Unhook;
    end.
    

    使用:

    unit UMain;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;
    
    type
      TFrmMain = class(TForm)
        btnClose: TButton;
        btnHookMouse: TButton;
        btnUnHookMouse: TButton;
        procedure btnCloseClick(Sender: TObject);
        procedure btnHookMouseClick(Sender: TObject);
        procedure btnUnHookMouseClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      FrmMain: TFrmMain;
    
    implementation
    uses
        HookLibInterface;
    {$R *.dfm}
    
    procedure TFrmMain.btnCloseClick(Sender: TObject);
    begin
        close;
    end;
    
    procedure TFrmMain.btnHookMouseClick(Sender: TObject);
    begin                         
        SetHook(application.Handle);
    end;
    
    procedure TFrmMain.btnUnHookMouseClick(Sender: TObject);
    begin
        UnHook;
    end;
    
    procedure TFrmMain.FormCreate(Sender: TObject);
    begin
        SetWindowPos(self.Handle,HWND_TOPMOST,0,0,screen.Width,Screen.Height,SWP_SHOWWINDOW	);
    end;
    
    end.
    

      


     HookLib.dll共享内存最终版:

    //HookLib.dpr
    library HookLib;
    
    { Important note about DLL memory management: ShareMem must be the
      first unit in your library's USES clause AND your project's (select
      Project-View Source) USES clause if your DLL exports any procedures or
      functions that pass strings as parameters or function results. This
      applies to all strings passed to and from your DLL--even those that
      are nested in records and classes. ShareMem is the interface unit to
      the BORLNDMM.DLL shared memory manager, which must be deployed along
      with your DLL. To avoid using BORLNDMM.DLL, pass string information
      using PChar or ShortString parameters. }
    
    uses
      SysUtils,
      Classes,
      Windows,
      Messages,
      Dialogs,
      HookLibInterface in 'HookLibInterface.pas';
    
    {$R *.res}
    const
      cMMFileName: PChar = 'SharedMapData';
    var
        hMouseHook : HHOOK;
        hKeyboardHook : HHOOK;
    
    type
        TGlobalDLLData = HWND;
        PGlobalDLLData = ^HWND;
    var
      GlobalData : PGlobalDLLData;
      MapHandle  : THandle;
    {
    var
        g_hwnd : HWND;
    }
    function MouseHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
    begin
        result := 1;
    end;
    function KeyboardHookProc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
    begin
        if vk_f2 = wparam then
        begin
            messagebeep(0);
            PostMessage(GlobalData^,wm_close,0,0);
            //UnhookWindowsHookEx(hMouseHook);
            UnhookWindowsHookEx(hKeyboardHook);
        end;
        result := 1;
    end;
    
    procedure SetHook(aHwnd : HWND); stdcall;
    begin
        //g_hwnd := aHwnd;
        GlobalData^ := aHwnd;
        //hMouseHook := SetWindowsHookEx(WH_MOUSE, MouseHookProc, GetModuleHandle('HookLib.dll'),0);
        hKeyboardHook := SetWindowsHookEx(WH_KEYBOARD, KeyboardHookProc, GetModuleHandle('HookLib.dll'),0);
        showmessage('成功加载勾子程序!');
    end;
    
    procedure UnHook(); stdcall;
    begin
        //UnhookWindowsHookEx(hMouseHook);
        UnhookWindowsHookEx(hKeyboardHook);
        showmessage('成功取消勾子程序!');
    end;
    exports
        SetHook,
        Unhook;
    
    
    
    procedure OpenSharedData;
    var
       Size: Integer;
    begin
      { Get the size of the data to be mapped. }
      Size := SizeOf(TGlobalDLLData);
     
      { Now get a memory-mapped file object. Note the first parameter passes
        the value $FFFFFFFF or DWord(-1) so that space is allocated from the system's
        paging file. This requires that a name for the memory-mapped
        object get passed as the last parameter. }
     
      MapHandle := CreateFileMapping(DWord(-1), nil, PAGE_READWRITE, 0, Size, cMMFileName);
     
      if MapHandle = 0 then
        RaiseLastWin32Error;
      { Now map the data to the calling process's address space and get a
        pointer to the beginning of this address }
      GlobalData := MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size);
      
      if GlobalData = nil then
      begin
        CloseHandle(MapHandle);
        RaiseLastWin32Error;
      end;
    end;
     
    procedure CloseSharedData;
    { This procedure un-maps the memory-mapped file and releases the memory-mapped
      file handle }
    begin
      UnmapViewOfFile(GlobalData);
      CloseHandle(MapHandle);
    end;
     
    procedure DLLEntryPoint(dwReason: DWord);
    begin
      case dwReason of
        DLL_PROCESS_ATTACH: OpenSharedData;
        DLL_PROCESS_DETACH: CloseSharedData;
      end;
    end;
    begin
      { First, assign the procedure to the DLLProc variable }
      DllProc := @DLLEntryPoint;
      { Now invoke the procedure to reflect that the DLL is attaching
        to the process }
      DLLEntryPoint(DLL_PROCESS_ATTACH);
    end.
  • 相关阅读:
    10年学到的编程经验总结
    测试框架 Mocha 实例教程
    在 Flutter 中玩转 Objective-C Block
    使用Gulp压缩混淆JS的相关配置
    Gulp前端自动化构建工具
    常用的十大 NodeJS 框架
    如何使用Vue中的嵌套插槽(包括作用域插槽)
    通过Python代码操作MySQL:
    使用python发邮件:
    jquery:
  • 原文地址:https://www.cnblogs.com/wucg/p/4261275.html
Copyright © 2011-2022 走看看