hkproc.pas

delphi写的一个录制鼠标动作的例子。对需要学习鼠标操作的有一定参考意义。

unit HKProc;

interface

uses
  forms,Windows,SysUtils,Messages,Dialogs;

var
  hHotKeyNextHookProc:hHook=0;
  hGetNextHookProc:hHook=0;
  hPlayBackNextHookProc:hHook=0;
  procSaveExit: Pointer;
  Msg:TEventMsg;
  WaitTime:DWord=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.