通过记录键盘和鼠标位置和输入信息，然后模拟发送，就能够创建一个按键精灵！
主要代码如下：
library KeyBoardHook;
{ 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;
type
TCallBackFun=procedure(info:PChar);
TKeyBoardHook=record
isrun:Bool;
hook:HHook;
callBackFun:TCallBackFun;
end;
var
myKeyBoardHook:TKeyBoardHook;
{$R *.res}
function GetKeyBoardInfo(code:Integer;wp:WPARAM;lp:LPARAM):LRESULT;stdcall;
var
info:string;
begin
if code< then
begin
Result:=CallNextHookEx(myKeyBoardHook.hook,code,wp,lp);
Exit;
end;
info:='';
if ((DWord(lp) shr )=) and (code=HC_ACTION) then
if ((DWord(lp) shr )=) then
info:='WM_SYSKEYUP'
else
info:='WM_KEYUP'
else
if ((DWord(lp) shr )=) then
info:='WM_SYSKEYDOWN'
else
info:='WM_KEYDOWN';
info:=info+','+inttostr(wp)+','+inttostr(lp);
if Assigned(myKeyBoardHook.callbackFun) then
myKeyBoardHook.callbackFun(pchar(info));
Result := CallNextHookEx(myKeyBoardHook.hook,code,wp,lp);
end;
procedure InstallKeyBoardHook(callback:TCallBackFun);stdcall;
begin
if not myKeyBoardHook.isrun then
begin
myKeyBoardHook.hook:=SetWindowsHookEx(WH_KEYBOARD,@GetKeyBoardInfo,HInstance,);
myKeyBoardHook.callBackFun:=callBack;
myKeyBoardHook.isrun:=not myKeyBoardHook.isrun;
end;
end;
procedure UninstallKeyBoardHook();stdcall;
begin
if myKeyBoardHook.isrun then
begin
UnHookWindowsHookEx(myKeyBoardHook.hook);
myKeyBoardHook.callBackFun:=nil;
myKeyBoardHook.isrun:=not myKeyBoardHook.isrun;
end;
end;
Procedure DLLEntryPoint(dwReason:DWord);
begin
Case dwReason of
DLL_PROCESS_ATTACH:begin
myKeyBoardHook.isrun:=false;
end;
DLL_PROCESS_DETACH:;
DLL_THREAD_ATTACH:;
DLL_THREAD_DETACH:;
End;
end;
exports
InstallKeyBoardHook,
UninstallKeyBoardHook;
begin
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
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}
//.定义自定义的HOOK函数，函数必须和需要HOOK的钩子类型保持同样的参数列表
function GetHookInfo(code:Integer;wp:WPARAM;lp:LPARAM):LResult;stdcall;
var
info:String;
begin
if code< then
begin
Result:=CallNextHookEx(myMouseHook.hook,code,wp,lp);
Exit;
end;
info:='';
case wp of
//鼠标消息共有21种，其中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,);
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 = then
begin
Sleep();
Continue;
end;
temp:=FindControl(tempHandle);
if temp=nil then
begin
Sleep();
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[];
focusHandle:=;
Wp:=StrToIntDef(tempList[],); //wParam
Lp:=StrToIntDef(tempList[],); //Lparam duration:= StrToIntDef(tempList[],);
if (duration=) and (wmtype='WM_NCMouseMove') then Exit; //小于线程调度时间片的话就不延时---以免 sleep()直接放弃时间进入内核态
if (wmtype='') or (tempList.Count<) then Exit;
focusControl :=tempList[];
classname := tempList[]; 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();
try
ForgroundForm :=InputRecord.ForgroundForm;
for i:= to PosList.Count- do
begin
directive:=PosList[i];
ExecuteDir(directive);
end;
finally
InputRecord.FIsPlay:=False;
end; end;