【笨嘴拙舌WINDOWS】实践检验之按键精灵【Delphi】
通过记录键盘和鼠标位置和输入信息，然后模拟发送，就能够创建一个按键精灵！
主要代码如下：
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 along 10 with your DLL. To avoid using BORLNDMM.DLL, pass string information 11 using PChar or ShortString parameters. } 12 13 uses 14 SysUtils, 15 Classes, 16 Windows, 17 Messages; 18 19 type 20 TCallBackFun=procedure(info:PChar); 21 TKeyBoardHook=record 22 isrun:Bool; 23 hook:HHook; 24 callBackFun:TCallBackFun; 25 end; 26 27 var 28 myKeyBoardHook:TKeyBoardHook; 29 {$R *.res} 30 31 function GetKeyBoardInfo(code:Integer;wp:WPARAM;lp:LPARAM):LRESULT;stdcall; 32 var 33 info:string; 34 begin 35 if code<0 then 36 begin 37 Result:=CallNextHookEx(myKeyBoardHook.hook,code,wp,lp); 38 Exit; 39 end; 40 info:=''; 41 if ((DWord(lp) shr 31)=1) and (code=HC_ACTION) then 42 if ((DWord(lp) shr 29)=1) then 43 info:='WM_SYSKEYUP' 44 else 45 info:='WM_KEYUP' 46 else 47 if ((DWord(lp) shr 29)=1) then 48 info:='WM_SYSKEYDOWN' 49 else 50 info:='WM_KEYDOWN'; 51 info:=info+','+inttostr(wp)+','+inttostr(lp); 52 if Assigned(myKeyBoardHook.callbackFun) then 53 myKeyBoardHook.callbackFun(pchar(info)); 54 Result := CallNextHookEx(myKeyBoardHook.hook,code,wp,lp); 55 end; 56 57 procedure InstallKeyBoardHook(callback:TCallBackFun);stdcall; 58 begin 59 if not myKeyBoardHook.isrun then 60 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 begin 69 if myKeyBoardHook.isrun then 70 begin 71 UnHookWindowsHookEx(myKeyBoardHook.hook); 72 myKeyBoardHook.callBackFun:=nil; 73 myKeyBoardHook.isrun:=not myKeyBoardHook.isrun; 74 end; 75 end; 76 77 Procedure DLLEntryPoint(dwReason:DWord); 78 begin 79 Case dwReason of 80 DLL_PROCESS_ATTACH:begin 81 myKeyBoardHook.isrun:=false; 82 end; 83 DLL_PROCESS_DETACH:; 84 DLL_THREAD_ATTACH:; 85 DLL_THREAD_DETACH:; 86 End; 87 end; 88 89 exports 90 InstallKeyBoardHook, 91 UninstallKeyBoardHook; 92 93 begin 94 DLLProc := @DLLEntryPoint; 95 DLLEntryPoint(DLL_PROCESS_ATTACH); 96 end.
以上是创建一个全局钩子函数的Dll来记录按键信息
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的钩子类型保持同样的参数列表 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种点击是客户区，10种是非客户区也就是消息名以NC开头的消息。和一个命中测试消息 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参数说明 参数idHook指定建立的监视函数类型。 参数lpfn指定消息函数，在相应的消息产生后，系统会调用该函数并将消息值传递给该函数供处理。函数的一般形式为： Hookproc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall; 其中code为系统指示标记（对应于idHook），wParam和lParam为附加参数，根据不同的消息监视类型而不同。 只要在程序中建立这样一个函数再通过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
使用一个新的线程来模拟发送消息
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; //小于线程调度时间片的话就不延时---以免 sleep(0)直接放弃时间进入内核态 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) //鼠标非客户区 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) //键盘消息 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;