给个单元你把,用的时候引用单元里的函数就可以了。[
]
unit HKProc;
interface
uses
forms,Windows,SysUtils,Messages,Dialogs;
var
hHotKeyNextHookProc:hHook=0;
hGetNextHookProc:hHook=0;
hPlayBackNextHookProc:hHook=0;
procSaveExit: Pointer;
Msg:TEventMsg;
WaitTime
Word=0;
PlayNum:Integer=0;
{热键定义}
function KeyboardHookHandler(iCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LResult;stdcall;
function EnableHotKeyHook: Bool;
function DisableHotKeyHook: Bool;
procedure HotKeyHookExit;
{获取消息}
function GetHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;stdcall;
function GetMessage:Bool;
function StopGetMessage:Bool;
procedure GetHookExit;
{回放消息}
function PlayBackHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;stdcall;
function PlayBackMessage:Bool;
function StopPlayBackMessage:Bool;
procedure PlayBackHookExit;
{获取消息}
procedure GetOneMsgFromPM;
//从当前录制的动作中读取一条消息
procedure GetOneMsgFromPM1;//从选择文件的动作中读取一条消息
implementation
uses mRecord;
////////////////////////////////////////////////////////////////////////////////
{
热键定义
}
function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;lParam: LPARAM): lResult;stdcall;
const
_KeyPressMask = $80000000;
begin
Result := 0;
If iCode < 0 then
begin
Result := CallNextHookEx(hHotKeyNextHookProc, iCode, wParam, lParam);
Exit;
end;
if ((lParam and _KeyPressMask) = 0) and // 偵測 Ctrl + R 組合鍵
(GetKeyState(vk_Control) < 0) and (wParam = Ord('R')) then
begin
Form1.BtnRecord.OnClick(Form1.BtnRecord);
Result := 1;
end ;
end;
function EnableHotKeyHook: BOOL;
begin
Result := False;
if hHotKeyNextHookProc <> 0 then
Exit;
{ 挂上WH_KEYBOARD型的HOOK, 同时,传回值必须保留下來, 免得 HOOK 呼叫连接中断}
hHotKeyNextHookProc:=SetWindowsHookEx(WH_KEYBOARD, KeyboardHookHandler, HInstance, 0);
Result := hHotKeyNextHookProc <> 0;
end;
function DisableHotKeyHook: BOOL;
begin
if hHotKeyNextHookProc <> 0 then
begin
UnhookWindowshookEx(hHotKeyNextHookProc);
// 解除 Keyboard Hook
hHotKeyNextHookProc := 0;
MessageBeep(0);
MessageBeep(0);
end;
Result := hHotKeyNextHookProc = 0;
end;
procedure HotKeyHookExit;
begin
// 如果忘了解除 HOOK, 自動代理解除的動作
if hHotKeyNextHookProc <> 0 then
DisableHotKeyHook;
ExitProc := procSaveExit;
end;
////////////////////////////////////////////////////////////////////////////////
{
获取消息
}
function GetHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;
stdcall;
begin
Result := 0;
if Code < 0 then
begin
Result := CallNextHookEx(hGetNextHookProc,Code,wParam,lParam);
Exit;
end;
msg:=pEventMsg(lParam)^;
//读取响应过后的一条消息
if ((msg.message>=WM_MOUSEFIRST)and(msg.message<=WM_MOUSELAST))
or((msg.message>=WM_KEYFIRST)and (msg.message<=WM_KEYLAST))then
begin
if ((msg.message=$0101)and(msg.paramL=$011B)and(msg.paramH =$0001)) //如果是ESCAPe键,
or((msg.message=$0100)and(msg.paramL =$011B)and(msg.paramH=$0001)) then
begin
//则退出记录过程(脱钩)
Form1.BtnStopRec.OnClick(Form1.BtnStopRec);
Exit;
end;
MessageStr:=MessageStr+'$'+IntToHex(msg.message,4)+'$'+IntToHex(msg.paramL,4)+'$'+
IntToHex(msg.paramH,4)+'$'+IntToHex(msg.time,12)+#13#10;
inc(Msgcount);
end;
end;
function GetMessage:Bool;
begin
Result := False;
if hGetNextHookProc <> 0 then
Exit;
{挂上WH_JOURNALRECORD型的HOOK, 同时,传回值必须保留下來, 免得 HOOK 呼叫连接中断}
hGetNextHookProc:=SetWindowsHookEx(WH_JOURNALRECORD,GetHookHandler,HInstance,0);
Result := hGetNextHookProc <> 0;
end;
function StopGetMessage:Bool;
begin
if hGetNextHookProc <> 0 then
begin
UnhookWindowshookEx(hGetNextHookProc);
// 解除 Mouse Hook
hGetNextHookProc := 0;
end;
Result := hGetNextHookProc = 0;
end;
procedure GetHookExit;
begin
if hGetNextHookProc <> 0 then
StopGetMessage;
ExitProc := procSaveExit;
end;
/////////////////////////////////////////////////////////////////////////////////
{
回放消息
}
function PlayBackHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;stdcall;
begin
case Code of
HC_SKIP:begin
//从消息列表中提取下一个消息,如果到了数组最后 ,就脱钩
if not Form1.CBPlayBack.Checked then
GetOneMsgFromPM//从当前录制的数组中读取一条消息
else
GetOneMsgFromPM1;//从选择文件的动作中读取一条消息
Result:=0;
end;
HC_GETNEXT:begin
//正确填充wparam/lparam的值,以使消息能够得到正确的回放。
//此时不能脱钩。返回值表明Windows应当在多少时间内回放消息。
Sleep(WaitTime);
Msg.time:=GetTickCount;
PEventMsg(lParam)^:=Msg;
Result:=0;//返回0表立即处理
end;
else
//否则就调用挂钩连中的下一个挂钩
Result:=CallNextHookEx(hPlayBackNextHookProc,Code,wParam,lParam);
end;
end;
function PlayBackMessage:Bool;
begin
Result:=False;
if hPlayBackNextHookProc <> 0 then
Exit;
{挂上WH_JOURNALPlayBack型的HOOK, 同时,传回值必须保留下來, 免得 HOOK 呼叫连接中断}
hPlayBackNextHookProc:=SetWindowsHookEx(WH_JOURNALPLAYBACK,PlayBackHookHandler,HInstance,0);
Result := hPlayBackNextHookProc <> 0;
end;
function StopPlayBackMessage:Bool;
begin
if hPlayBackNextHookProc <> 0 then
begin
UnhookWindowshookEx(hPlayBackNextHookProc);
// 解除 Mouse Hook
hPlayBackNextHookProc := 0;
end;
PLayNum:=0;
Result:=hPlayBackNextHookProc = 0;
end;
procedure PlayBackHookExit;
begin
if hPlayBackNextHookProc <> 0 then
StopPlayBackMessage;
ExitProc := procSaveExit;
end;
////////////////////////////////////////////////////////////////////////////////
procedure GetOneMsgFromPM;
begin
if PlayNum>=MsgCount then
begin
Form1.StopPlayBack;
end else
begin
Msg:=PM[PlayNum];
if PlayNum=0 then
WaitTime:=0 else
WaitTime:=PM[PLayNum].Time-PM[PLayNum-1].Time;
end;
inc(PLayNum);
end;
procedure GetOneMsgFromPM1;
begin
if PlayNum>=ArrayCount then
begin
Form1.StopPlayBack;
end else
begin
Msg:=PM1[PLayNum];
if PlayNum=0 then
WaitTime:=0 else
WaitTime:=PM1[PLayNum].Time-PM1[PLayNum-1].Time;
end;
Inc(PlayNum);
end;
end.