通過(guò)記錄鍵盤(pán)和鼠標位置和輸入信息，然后模擬發(fā)送，就能夠創(chuàng )建一個(gè)按鍵精靈！
主要代碼如下：
1 library KeyBoardHook; 2 3 { Important note about DLL memory management: ShareMem must be the 4 first unit in your library's USES clause AND your project's (select 5 Project-View Source) USES clause if your DLL exports any procedures or 6 functions that pass strings as parameters or function results. This 7 applies to all strings passed to and from your DLL--even those that 8 are nested in records and classes. ShareMem is the interface unit to 9 the BORLNDMM.DLL shared memory manager, which must be deployed along10 with your DLL. To avoid using BORLNDMM.DLL, pass string information11 using PChar or ShortString parameters. }12 13 uses14 SysUtils,15 Classes,16 Windows,17 Messages;18 19 type20 TCallBackFun=procedure(info:PChar);21 TKeyBoardHook=record22 isrun:Bool;23 hook:HHook;24 callBackFun:TCallBackFun;25 end;26 27 var28 myKeyBoardHook:TKeyBoardHook;29 {$R *.res}30 31 function GetKeyBoardInfo(code:Integer;wp:WPARAM;lp:LPARAM):LRESULT;stdcall;32 var33 info:string;34 begin35 if code<0 then36 begin37 Result:=CallNextHookEx(myKeyBoardHook.hook,code,wp,lp);38 Exit;39 end;40 info:='';41 if ((DWord(lp) shr 31)=1) and (code=HC_ACTION) then42 if ((DWord(lp) shr 29)=1) then43 info:='WM_SYSKEYUP'44 else45 info:='WM_KEYUP'46 else47 if ((DWord(lp) shr 29)=1) then48 info:='WM_SYSKEYDOWN'49 else50 info:='WM_KEYDOWN';51 info:=info+','+inttostr(wp)+','+inttostr(lp);52 if Assigned(myKeyBoardHook.callbackFun) then53 myKeyBoardHook.callbackFun(pchar(info));54 Result := CallNextHookEx(myKeyBoardHook.hook,code,wp,lp);55 end;56 57 procedure InstallKeyBoardHook(callback:TCallBackFun);stdcall;58 begin59 if not myKeyBoardHook.isrun then60 begin 61 myKeyBoardHook.hook:=SetWindowsHookEx(WH_KEYBOARD,@GetKeyBoardInfo,HInstance,0);62 myKeyBoardHook.callBackFun:=callBack;63 myKeyBoardHook.isrun:=not myKeyBoardHook.isrun;64 end;65 end;66 67 procedure UninstallKeyBoardHook();stdcall;68 begin69 if myKeyBoardHook.isrun then70 begin71 UnHookWindowsHookEx(myKeyBoardHook.hook);72 myKeyBoardHook.callBackFun:=nil;73 myKeyBoardHook.isrun:=not myKeyBoardHook.isrun;74 end;75 end;76 77 Procedure DLLEntryPoint(dwReason:DWord);78 begin79 Case dwReason of80 DLL_PROCESS_ATTACH:begin81 myKeyBoardHook.isrun:=false;82 end;83 DLL_PROCESS_DETACH:;84 DLL_THREAD_ATTACH:;85 DLL_THREAD_DETACH:;86 End;87 end;88 89 exports90 InstallKeyBoardHook,91 UninstallKeyBoardHook;92 93 begin94 DLLProc := @DLLEntryPoint;95 DLLEntryPoint(DLL_PROCESS_ATTACH);96 end.
以上是創(chuàng )建一個(gè)全局鉤子函數的Dll來(lái)記錄按鍵信息
library Mousehook;{ 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, ShellAPI; type TCallbackFun=procedure(info:pchar); TMouseHook=record isrun:Bool; hook:HHook; callbackFun:TCallbackFun; end;var myMouseHook:TMouseHook;{$R *.res}//1.定義自定義的HOOK函數，函數必須和需要HOOK的鉤子類(lèi)型保持同樣的參數列表function GetHookInfo(code:Integer;wp:WPARAM;lp:LPARAM):LResult;stdcall;var info:String;begin if code<0 then begin Result:=CallNextHookEx(myMouseHook.hook,code,wp,lp); Exit; end; info:=''; case wp of //鼠標消息共有21種，其中10種點(diǎn)擊是客戶(hù)區，10種是非客戶(hù)區也就是消息名以NC開(kāi)頭的消息。和一個(gè)命中測試消息 WM_LBUTTONDOWN:begin info:='WM_LBUTTONDOWN'; end; WM_LBUTTONUP:begin info:='WM_LBUTTONUP'; end; WM_LBUTTONDBLCLK:begin info:='WM_LBUTTONDBLCLK'; end; WM_RBUTTONDOWN:begin info:='WM_RBUTTONDOWN'; end; WM_RBUTTONUP:begin info:='WM_RBUTTONUP'; end; WM_RBUTTONDBLCLK:begin info:='WM_RBUTTONDBLCLK'; end; WM_MBUTTONDOWN:begin info:='WM_MBUTTONDOWN'; end; WM_MBUTTONUP:begin info:='WM_MBUTTONUP'; end; WM_MBUTTONDBLCLK:begin info:='WM_MBUTTONDBLCLK'; end; WM_MOUSEMOVE:begin info:='WM_MOUSEMOVE'; end; WM_NCMouseMove:begin info:='WM_NCMouseMove'; end; WM_MOUSEWHEEL: begin info:='WM_MOUSEWHEEL'; end; WM_NCHITTEST:begin info:='WM_NCHITTEST'; end; WM_NCLBUTTONDOWN:BEGIN info:='WM_NCLBUTTONDOWN'; end; WM_NCLBUTTONUP:BEGIN info:='WM_NCLBUTTONUP'; end; WM_NCLBUTTONDBLCLK:BEGIN info:='WM_NCLBUTTONDBLCLK'; end; WM_NCRBUTTONDOWN:BEGIN info:='WM_NCRBUTTONDOWN'; end; WM_NCRBUTTONUP:BEGIN info:='WM_NCRBUTTONUP'; end; WM_NCRBUTTONDBLCLK:BEGIN info:='WM_NCRBUTTONDBLCLK'; end; end; info:=info+','+inttostr(PMouseHookStruct(lp)^.wHitTestCode)+ ','+inttostr(MakeLParam(PMouseHookStruct(lp)^.pt.x,PMouseHookStruct(lp)^.pt.Y)); if Assigned(myMouseHook.callbackFun) then myMouseHook.callbackFun(pchar(info)); Result := CallNextHookEx(myMouseHook.hook,code,wp,lp);end;procedure InstallMouseHook(callbackF:Tcallbackfun);stdcall;begin if not myMouseHook.isrun then begin {2.設置鉤子函數 setwindowhookEx參數說(shuō)明 參數idHook指定建立的監視函數類(lèi)型。 參數lpfn指定消息函數，在相應的消息產(chǎn)生后，系統會(huì )調用該函數并將消息值傳遞給該函數供處理。函數的一般形式為： Hookproc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall; 其中code為系統指示標記（對應于idHook），wParam和lParam為附加參數，根據不同的消息監視類(lèi)型而不同。 只要在程序中建立這樣一個(gè)函數再通過(guò)SetwindowsHookEx函數將它加入到消息監視鏈中就可以處理消息了。 } myMouseHook.hook:=setwindowshookex(WH_MOUSE,@gethookinfo,HInstance,0); myMouseHook.callbackfun:=callbackf; myMouseHook.isrun:=not mymousehook.isrun; end;end;procedure UninstallMouseHook();stdcall;begin if myMouseHook.isrun then begin UnHookWindowsHookEx(mymousehook.hook); myMouseHook.callbackfun :=nil; myMouseHook.isrun:=not myMouseHook.isrun; end;end;Procedure DLLEntryPoint(dwReason:DWord);begin Case dwReason of DLL_PROCESS_ATTACH:begin myMouseHook.isrun:=false; end; DLL_PROCESS_DETACH:; DLL_THREAD_ATTACH:; DLL_THREAD_DETACH:; End;end;exports InstallMouseHook, UninstallMouseHook;begin DLLProc := @DLLEntryPoint; DLLEntryPoint(DLL_PROCESS_ATTACH);end.
以上是捕獲鼠標消息的全局鉤子DLL
使用一個(gè)新的線(xiàn)程來(lái)模擬發(fā)送消息
procedure TPlayThread.Execute;var directive:string; i:integer; ForgroundForm:TForm; procedure ExecuteDir(directive:string); var tempList:TStringList; Wp,Lp:integer; wmtype:String; focusControl:string; duration:Cardinal; winCtl:TWinControl; tempHandle,focusHandle:THandle; classname:String; mousPoint:TPOINT; procedure findFocus; var temp:TWinControl; finded:Boolean; begin if ((wmtype='WM_MOUSEMOVE') or (wmtype='WM_NCMouseMove')) then Exit; winCtl:=TWinControl(ForgroundForm.FindChildControl(focusControl)); if winCtl<>nil then begin focusHandle:= winCtl.Handle; AttachThreadInput(GetWindowThreadProcessId(ForgroundForm.Handle,nil),Self.ThreadID,True); Ferrorinfo:=SysErrorMessage(GetLastError); winCtl.SetFocus; AttachThreadInput(GetWindowThreadProcessId(ForgroundForm.Handle,nil),Self.ThreadID,False); Ferrorinfo:=SysErrorMessage(GetLastError); Exit; end; temp:=nil; finded:=False; while not finded do begin GetCursorPos(mousPoint); tempHandle := WindowFromPoint(mousPoint); if tempHandle =0 then begin Sleep(0); Continue; end; temp:=FindControl(tempHandle); if temp=nil then begin Sleep(0); Continue; end; if (temp.Name = focusControl) or (classname=temp.ClassName) then finded:=True; end; focusHandle := temp.Handle; AttachThreadInput(GetWindowThreadProcessId(ForgroundForm.Handle,nil),Self.ThreadID,True); Ferrorinfo:=SysErrorMessage(GetLastError); temp.SetFocus; AttachThreadInput(GetWindowThreadProcessId(ForgroundForm.Handle,nil),Self.ThreadID,False); Ferrorinfo:=SysErrorMessage(GetLastError); end; begin tempList:=TStringList.Create; try tempList.CommaText:=directive; tempList.Delimiter:=','; wmtype:=tempList[0]; focusHandle:=0; Wp:=StrToIntDef(tempList[1],0); //wParam Lp:=StrToIntDef(tempList[2],0); //Lparam duration:= StrToIntDef(tempList[3],0); if (duration=0) and (wmtype='WM_NCMouseMove') then Exit; //小于線(xiàn)程調度時(shí)間片的話(huà)就不延時(shí)---以免 sleep(0)直接放棄時(shí)間進(jìn)入內核態(tài) if (wmtype='') or (tempList.Count<6) then Exit; focusControl :=tempList[4]; classname := tempList[5]; findFocus; //鼠標消息 if wmtype='WM_LBUTTONDOWN' then TInputHelper.MouseLButtonDown(focusHandle,Wp,Lp) else if wmtype='WM_LBUTTONUP' then TInputHelper.MouseLButtonUp(focusHandle,Wp,Lp,True) else if wmtype='WM_LBUTTONDBLCLK' then TInputHelper.MouseLButtonDbClick(focusHandle,Wp,Lp,True) else if wmtype='WM_RBUTTONDOWN' then TInputHelper.MouseRButtonDown(focusHandle,Wp,Lp,True) else if wmtype='WM_RBUTTONUP' then TInputHelper.MouseRButtonUp(focusHandle,Wp,Lp,True) else if wmtype='WM_RBUTTONDBLCLK' then TInputHelper.MouseRButtonDbClick(focusHandle,Wp,Lp,True) else if wmtype='WM_MBUTTONDOWN' then TInputHelper.MouseMButtonDown(focusHandle,Wp,Lp,True) else if wmtype='WM_MBUTTONUP' then TInputHelper.MouseMButtonUp(focusHandle,Wp,Lp,True) else if wmtype='WM_MBUTTONDBLCLK' then TInputHelper.MouseMButtonDbClick(focusHandle,Wp,Lp,True) else if wmtype='WM_MOUSEMOVE' then TInputHelper.MouseMove(focusHandle,Wp,Lp,True) else if wmtype='WM_MOUSEWHEEL' then TInputHelper.MouseWHEEL(focusHandle,Wp,Lp,True) //鼠標非客戶(hù)區 else if wmtype='WM_NCMouseMove' then TInputHelper.MouseNCMouseMove(focusHandle,Wp,Lp,True) else if wmtype='WM_NCHITTEST' then TInputHelper.MouseNCHITTEST(focusHandle,Wp,Lp,True) else if wmtype='WM_NCLBUTTONDOWN' then TInputHelper.MouseNCLBUTTONDOWN(focusHandle,Wp,Lp,True) else if wmtype='WM_NCLBUTTONUP' then TInputHelper.MouseNCLBUTTONUP(focusHandle,Wp,Lp,True) else if wmtype='WM_NCLBUTTONDBLCLK' then TInputHelper.MouseNCLBUTTONDBLCLK(focusHandle,Wp,Lp,True) else if wmtype='WM_NCRBUTTONDOWN' then TInputHelper.MouseNCRBUTTONDOWN(focusHandle,Wp,Lp,True) else if wmtype='WM_NCRBUTTONUP' then TInputHelper.MouseNCRBUTTONUP(focusHandle,Wp,Lp,True) else if wmtype='WM_NCRBUTTONDBLCLK' then TInputHelper.MouseRButtonDbClick(focusHandle,Wp,Lp,True) //鍵盤(pán)消息 else if wmtype='WM_KEYDOWN' then TInputHelper.KeyDown(focusHandle,Wp,Lp,True) else if wmtype='WM_KEYUP' then TInputHelper.KEYUP(focusHandle,Wp,Lp,True) else if wmtype='WM_SYSKEYDOWN' then TInputHelper.KeySYSKEYDOWN(focusHandle,Wp,Lp,True) else if wmtype='WM_SYSKEYUP' then TInputHelper.KeySYSKEYUP(focusHandle,Wp,Lp,True); Application.ProcessMessages; Sleep(duration); finally tempList.Free; end; end;begin Sleep(1000); try ForgroundForm :=InputRecord.ForgroundForm; for i:= 0 to PosList.Count-1 do begin directive:=PosList[i]; ExecuteDir(directive); end; finally InputRecord.FIsPlay:=False; end;end;
聯(lián)系客服
