本应用程序的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.