刚才我们提到了挂钩子,事实上应该说成安装钩子(Installing a hook)更加标准。在我们的程序或任务结束时,我们也应该“脱钩”,亦即卸载钩子(Unhook a hook)。这两项工作是通过调用API函数(API Call)来完成的,在Win32中,我们应该使用SetWindowsHookEx和UnhookWindowsHookEx。它们在我们的程序中的调 用方法为:
在本例中,由于我们要安装一个全局钩子,必须将和钩子有关的函数放在一个动态链接库(DLL,Dynamic Link Library)中。所谓动态链接库,就是在程序需要时可以被装入内存的函数库。通常我们把这个过程称为注入(Injection)。由于32位 Windows下的每个应用程序都拥有自己的地址空间,无法相互访问,如果我们把钩子放在EXE程序中就不能监控其它程序鼠标操作了,所以必须引入 DLL。
var hMappingFile :THandle; //Handle for Mapping file pSharedMem :^TSharedMem; //Pointer for Shared Memory HookHandle :HHook; //Handle for the hook
function StartHook(Sender:HWnd; MessageID:word):BOOL; stdcall; function StopHook:BOOL; stdcall;
implementation
function MouseProc(nCode:integer; wParam:WParam; lParam:LParam): LRESULT; stdcall; begin Result := 0; if nCode<0 then Result:=CallNextHookEx(HookHandle,nCode,wParam,lParam); //Rule of API call, which referred to Win32 Hooks topic in MSDN
if ( (wParam = WM_LBUTTONUP ) or ( wParam = WM_NCLBUTTONUP) ) then SendMessage(pSharedMem^.InstHandle,pSharedMem^.MessageID,0,0); //Sends Message to Instance to which was injected this DLL end;
function StartHook(Sender:HWnd; MessageID:word):BOOL; begin Result := False; if HookHandle<>0 then Exit; //Already Installed the hook pSharedMem^.InstHandle := Sender; pSharedMem^.MessageID := MessageID; HookHandle := SetWindowsHookEx(WH_MOUSE,MouseProc,hInstance,0); Result := HookHandle <> 0; end;
function StopHook:BOOL; begin if HookHandle <> 0 then begin UnhookWindowsHookEx(HookHandle); HookHandle := 0; end; Result := HookHandle = 0; end;
initialization
hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName); //Try to open an existing mapping file as MappingFileName specified if hMappingFile = 0 then //Not exist hMappingFile := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,sizeof(TSharedMem),MappingFileName); //Here $FFFFFFFF is a invalid file handle, which cause this file being created in Windows page file.
if hMappingFile = 0 then //Still unable to create a mapping file Exception.Create('Unable to create shared memory. Make sure your system have enough memory and page file space.');
pSharedMem := MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0); //Details of this API call, refer to MapViewOfFile in MSDN if pSharedMem = nil then //Create a pointer to the mapped file begin CloseHandle(hMappingFile); Exception.Create('Unable to map shared memory. Program halt.'); end;
HookHandle := 0; //Whether HookHandle = 0 is used to judge if this hooked was installed //In function StartHook, we will later give a value to HookHandle
var frmMain :TfrmMain; hMappingFile :THandle; pSharedMem :^TSharedMem; time_counter :integer;
implementation
{ $R *.dfm }
function StartHook(Sender:HWnd; MessageID:word):BOOL; stdcall; external DLLFileName; function StopHook:BOOL; stdcall; external DLLFileName;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); begin if not StopHook then Exception.Create('Unable to uninstall the mouse hook. Abnormal termination.'); end;
procedure TfrmMain.FormCreate(Sender: TObject); begin pSharedMem := nil; if not StartHook(frmMain.Handle,MessageID) then //Sends handle and MessageID to DLL Exception.Create('Unable to install a mouse hook. Program halt.'); time_counter := 0; end;
procedure TfrmMain.tmrMainTimer(Sender: TObject); begin inc(time_counter); lblMain.Caption := IntToStr(time_counter); end;
procedure TfrmMain.WndProc(var Messages: TMessage); //Override WndProc, see MSDN for details begin if pSharedMem = nil then begin hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName); if hMappingFile = 0 then Exception.Create('Unable to access shared memory. Program halt.'); pSharedMem := MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0); if pSharedMem = nil then begin CloseHandle(hMappingFile); Exception.Create('Unable to map to shared memory. Program halt.'); end; end; if pSharedMem = nil then exit; //Halt program if unable to create/open/map shared memory.
if Messages.Msg = MessageID then //Global mouse On_Left_Button_Up begin time_counter := 0; lblMain.Caption := 'CLICK!'; tmrMain.Interval := 0; tmrMain.Interval := 1000; //Cause timer to restart timing end else Inherited; //Do traditional WndProc without override