recorder.pas

这一系列是我平时收集的pascal深入核心编程

unit Recorder;

interface

uses Windows, Messages;

type
 // 错误类型
  TRecErr =
   (
     RECERR_OK, // 操作成功
     RECERR_CANTHOOK, // 钩子无法安装
     RECERR_ACTIVE, // 正在记录/回放时要求记录/回放
     RECERR_INACTIVE, // 已经停止时要求停止
     RECERR_NOMEMORY, // 内存不足, 分配失败
     RECERR_NOEVENTS, // 没有记录可供回放
     RECERR_SYSMODAL, // 系统模态对话框导致停止
     RECERR_USERCANCEL // 用户按下快捷键导致停止
   );

 // 记录状态
  TRecMode =
   (
     RECMODE_STOPPED,   // 停止记录
     RECMODE_RECORDING, // 正在记录
     RECMODE_PLAYING    // 正在回放
   );

 // 记录列表句柄
  hEventList = LongWord;

 // 记录器初始化
procedure Recorder_Init(); stdcall;

 // 释放事件列表内存
procedure Recorder_Free(h: hEventList); stdcall;

 // 显示e对应错误信息
procedure Recorder_DisplayError(e: TRecErr); stdcall;

 // 返回当前记录器状态
function Recorder_GetMode(): TRecMode; stdcall;

 // 处理WM_CANCELJOURNAL消息
function Recorder_IsRecorderCanceled(PtMsg: PMsg): BOOL; stdcall;

 // 开始记录
function Recorder_Record(hWndNotify: HWND; uMsgNotify: UINT): TRecErr; stdcall;

 // 开始回放
function Recorder_Play(h: hEventList; hWndNotify: HWND; uMsgNotify: UINT): TRecErr; stdcall;

 // 停止记录/回放
function Recorder_Stop(): TRecErr; stdcall;

implementation

type
 // 事件列表头结构
  PRecStat = ^TRecStat;
  TRecStat = record
    nNumEvents: Integer; // 记录的事件数量
    nNumEventsPlayed: Integer; // 回放的事件数量
    dwStartTime: DWORD; // 开始回放的时间
  end;

 // 记录器信息结构
  TRecorderData = record
    hhookJournal: HHOOK; // 日志钩子句柄
    RecMode: TRecMode; // 记录状态
    hWndNotify: HWND;  // 通知目标
    uMsgNotify: UINT;  // 通知消息
    RecErr: TRecErr;   // 错误类型
    PtRecStat: PRecStat; // 记录数据 (TRecStat + TEventMsg数组)
  end;

var
 // 记录器信息
  g_RecorderData: TRecorderData;

 // 初始化记录器
procedure Recorder_Init(); stdcall;
begin
  ZeroMemory(@g_RecorderData, SizeOf(TRecorderData));

  g_RecorderData.uMsgNotify := WM_NULL;
  g_RecorderData.RecMode := RECMODE_STOPPED;
  g_RecorderData.RecErr := RECERR_OK;
end;

 // 事件记录钩子回调
function Recorder_JournalRecordProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
const
{$J+}
  fPause: BOOL = FALSE; // 存在系统模态对话框
{$J-}
var
  PtEvent: PEventMsg;
  nNumEvents: Integer;
begin
 // 下一个钩子
  Result := CallNextHookEx(g_RecorderData.hhookJournal, nCode, wParam, lParam);

 // 钩子代码
  case (nCode) of
    HC_ACTION:
      begin
       // 存在系统模态对话框, 不作记录
        if (fPause) then Exit;

       // 增加TEventMsg数组长度
        nNumEvents := g_RecorderData.PtRecStat.nNumEvents + 1;

       // 重新分配内存(扩大)
        ReallocMem(g_RecorderData.PtRecStat, SizeOf(TRecStat) + nNumEvents * SizeOf(TEventMsg));

       // 内存不足, 停止记录
        if (g_RecorderData.PtRecStat = nil) then
        begin
          g_RecorderData.RecErr := RECERR_NOMEMORY;
          Recorder_Stop();
          Exit;
        end;

       // 填写刚刚增加的TEventMsg
        PtEvent := PEventMsg(Integer(g_RecorderData.PtRecStat) + SizeOf(TRecStat));
        PEventMsg(Integer(PtEvent) + SizeOf(TEventMsg) * g_RecorderData.PtRecStat.nNumEvents)^
          := PEventMsg(lParam)^;

       // TEventMsg数组成员数量增加
        Inc(g_RecorderData.PtRecStat.nNumEvents);
      end;

    HC_SYSMODALON:
      begin
       // 系统模态对话框弹出, 之后不再记录
        fPause := TRUE;
      end;

    HC_SYSMODALOFF:
      begin
       // 系统模态对话框关闭, 停止记录并作通知
        fPause := FALSE;
        g_RecorderData.RecErr := RECERR_SYSMODAL;
        Recorder_Stop();
      end;
  end;
end;

 // 事件回放钩子回调
function Recorder_JournalPlaybackProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  PtEvent: PEventMsg;
begin
 // 下一个钩子
  Result := CallNextHookEx(g_RecorderData.hhookJournal, nCode, wParam, lParam);

 // 钩子代码
  case (nCode) of
    HC_SKIP:
      begin
       // 下一个准备回放的事件
        Inc(g_RecorderData.PtRecStat.nNumEventsPlayed);
        if (g_RecorderData.PtRecStat.nNumEventsPlayed = g_RecorderData.PtRecStat.nNumEvents) then
          Recorder_Stop();
      end;

    HC_GETNEXT:
      begin
       // 拷贝事件结构
        PtEvent := PEventMsg(Integer(g_RecorderData.PtRecStat) + SizeOf(TRecStat));
        PEventMsg(lParam)^ :=
          PEventMsg(Integer(PtEvent) + SizeOf(TEventMsg) * g_RecorderData.PtRecStat.nNumEventsPlayed)^;

       // 调整事件时间
        Inc(PEventMsg(lParam).time, g_RecorderData.PtRecStat.dwStartTime);

       // 回放前的延时
        Result := PEventMsg(lParam).time - GetTickCount();
        if (Result < 0) then Result := 0;
      end;

    HC_SYSMODALOFF:
      begin
       // 系统模态对话框关闭, 停止回放并作通知
        g_RecorderData.RecErr := RECERR_SYSMODAL;
        Recorder_Stop();
      end;
  end;
end;

 // 显示e对应错误信息
procedure Recorder_DisplayError(e: TRecErr); stdcall;
var
  pMessage: PChar;
begin
  case (e) of
    RECERR_ACTIVE:
      begin
        pMessage := 'Recorder already recording/playing.';
      end;

    RECERR_INACTIVE:
      begin
        pMessage := 'Recorder already stopped.';
      end;

    RECERR_NOMEMORY:
      begin
        pMessage := 'Insufficient memory.';
      end;

    RECERR_NOEVENTS:
      begin
        pMessage := 'No events to playback.';
      end;

    RECERR_USERCANCEL:
      begin
        pMessage := 'Recorder canceled by user.';
      end;

    RECERR_CANTHOOK:
      begin
        pMessage := 'Unable to set hook.';
      end;

    RECERR_SYSMODAL:
      begin
        pMessage := 'Recorder canceled by system modal dialog.';
      end;

    else pMessage := nil;
  end;

  if (pMessage <> nil) then
    MessageBox(GetActiveWindow(), pMessage, 'Echo', 0);
end;

 // 返回当前记录器状态
function Recorder_GetMode(): TRecMode; stdcall;
begin
  Result := g_RecorderData.RecMode;
end;

 // 释放事件列表内存
procedure Recorder_Free(h: hEventList); stdcall;
begin
  FreeMem(Pointer(h));
end;

 // 开始记录
function Recorder_Record(hWndNotify: HWND; uMsgNotify: UINT): TRecErr; stdcall;
begin
  if (g_RecorderData.RecMode = RECMODE_RECORDING) or
     (g_RecorderData.RecMode = RECMODE_PLAYING) then
  begin
    Result := RECERR_ACTIVE; // 正在记录/回放
    Exit;
  end;

 // 分配头部内存并初始化
  GetMem(g_RecorderData.PtRecStat, SizeOf(TRecStat));
  if (g_RecorderData.PtRecStat = nil) then
  begin
    Result := RECERR_NOMEMORY; // 内存分配失败
    Exit;
  end;
  g_RecorderData.PtRecStat.nNumEvents := 0;
  g_RecorderData.PtRecStat.nNumEventsPlayed := 0;
  g_RecorderData.hwndNotify := hwndNotify;
  g_RecorderData.uMsgNotify := uMsgNotify;

 // 安装记录钩子
  g_RecorderData.hhookJournal :=
    SetWindowsHookEx(WH_JOURNALRECORD, @Recorder_JournalRecordProc, HInstance, 0);

 // 安装是否成功
  if (g_RecorderData.hhookJournal = 0) then
  begin
    FreeMem(g_RecorderData.PtRecStat);
    Result := RECERR_CANTHOOK; // 无法安装钩子
  end else
  begin
    g_RecorderData.RecErr := RECERR_OK;
    g_RecorderData.RecMode := RECMODE_RECORDING;
    Result := RECERR_OK; // 钩子安装成功
  end;
end;

 // 停止记录/回放
function Recorder_Stop(): TRecErr; stdcall;
var
  hEventList: LongWord; // hEventList
  PtEvent: PEventMsg;
  nNumEvents: Integer;
begin
  case (g_RecorderData.RecMode) of
    RECMODE_STOPPED:
      begin
        Result := RECERR_INACTIVE; // 已经处于停止状态
        Exit;
      end;

    RECMODE_RECORDING:
      begin
        hEventList := LongWord(g_RecorderData.PtRecStat);
      end;

    RECMODE_PLAYING:
      begin
        hEventList := 0;
      end;

    else hEventList := 0; // 这是不可能的
  end;

 // 停止日志钩子
  if (g_RecorderData.hhookJournal <> 0) then
  begin
   // 如果因为WM_CANCELJOURNAL消息被Recorder_Stop()调用, 钩子已经卸载, 并且句柄为空
    UnhookWindowsHookEx(g_RecorderData.hhookJournal);
    g_RecorderData.hhookJournal := 0;
  end;

 // 停止的是记录钩子
  if (g_RecorderData.RecMode = RECMODE_RECORDING) then
  begin
    PtEvent := PEventMsg(Integer(g_RecorderData.PtRecStat) + SizeOf(TRecStat));
    nNumEvents := g_RecorderData.PtRecStat.nNumEvents;

   // 修改所有TEventMsg.time为距离开始记录的时差
    while (nNumEvents >= 1) do
    begin
      Dec(nNumEvents);
      Dec(PEventMsg(Integer(PtEvent) + SizeOf(TEventMsg) * nNumEvents).time,
        PtEvent.time);
    end;
  end;
  g_RecorderData.PtRecStat := nil;

 // 向主窗体发指定消息通知'停止'
  g_RecorderData.RecMode := RECMODE_STOPPED;
  SendMessage(g_RecorderData.hwndNotify,
    g_RecorderData.uMsgNotify, hEventList, Integer(g_RecorderData.RecErr));

  Result := RECERR_OK;
end;

 // 开始回放
function Recorder_Play(h: hEventList; hWndNotify: HWND; uMsgNotify: UINT): TRecErr; stdcall;
begin
  if (g_RecorderData.RecMode = RECMODE_RECORDING) or
     (g_RecorderData.RecMode = RECMODE_PLAYING) then
  begin
    Result := RECERR_ACTIVE; // 正在记录or回放
    Exit;
  end;

  if (PRecStat(h).nNumEvents = 0) then
  begin
    Result := RECERR_NOEVENTS; // 没有事件可回放
    Exit;
  end;

 // 设置事件列表(这样可以重新指定更灵活)
  g_RecorderData.PtRecStat := PRecStat(h);

 // 初始化通知消息和通知目标
  g_RecorderData.hwndNotify := hwndNotify;
  g_RecorderData.uMsgNotify := uMsgNotify;

 // 初始化已放数量和开始时间
  g_RecorderData.PtRecStat.nNumEventsPlayed := 0;
  g_RecorderData.PtRecStat.dwStartTime := GetTickCount();

 // 安装回放钩子
  g_RecorderData.hhookJournal := SetWindowsHookEx(WH_JOURNALPLAYBACK,
    @Recorder_JournalPlaybackProc, HInstance, 0);

  if (g_RecorderData.hhookJournal = 0) then
  begin
    Result := RECERR_CANTHOOK; // 安装钩子失败
    Exit;
  end;

  g_RecorderData.RecErr := RECERR_OK;
  g_RecorderData.RecMode := RECMODE_PLAYING;

  Result := RECERR_OK; // 安装钩子成功
end;

 // 处理WM_CANCELJOURNAL消息
function Recorder_IsRecorderCanceled(PtMsg: PMSG): BOOL; stdcall;
begin
  Result := (PtMsg.message = WM_CANCELJOURNAL);

 // 系统已经强行卸载钩子
  if (Result) then
  begin
    g_RecorderData.hhookJournal := 0;
    g_RecorderData.RecErr := RECERR_USERCANCEL;
    Recorder_Stop();
  end;
end;

end.