capture.dpr

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

program Capture;

{$R Capture.res}

uses Windows, Messages;

const
  IDD_CAPTURE = 102; // 模板资源ID
  IDI_CAPTURE = 104; // 图标资源ID
  IDC_WNDUNDERMOUSE = 104; // 控件ID ..
  IDC_CAPTUREWITHOUTJRHOOK = 1001;
  IDC_CAPTUREUSINGJRHOOK = 1002;

var
  g_hhookJournalRecord: HHOOK = 0; // 钩子句柄

 // 计算窗口标题
procedure Capture_CalcWndText(hWnd: HWND; const szBuf: PChar; nLen: Integer);
var
  szClass, szCaption: array[0..255] of Char;
  ArgList: array[0..2] of DWORD;
begin
  if (hWnd = 0) then
  begin
    lstrcpy(szBuf, '(no window)');
    Exit;
  end;

  if (IsWindow(hWnd) = FALSE) then
  begin
    lstrcpy(szBuf, '(invalid window)');
    Exit;
  end;

  GetClassName(hWnd, szClass, SizeOf(szClass));
  GetWindowText(hWnd, szCaption, SizeOf(szCaption));

  ArgList[0] := hWnd;
  ArgList[1] := DWORD(@szClass[0]);
  if (szCaption[0] = #0) then
    ArgList[2] := DWORD(PChar('(no caption)'))
  else
    ArgList[2] := DWORD(@szCaption[0]);

  szBuf[wvsprintf(szBuf, '%08X: [%s] %s', @ArgList[0])] := #0;
end;

 // 日志钩子回调函数
function Capture_JournalRecordProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  Result := CallNextHookEx(g_hhookJournalRecord, nCode, wParam, lParam);
end;

 // WM_INITDIALOG处理
function Capture_OnInitDialog(hWnd, hWndFocus: HWND; lParam: LPARAM): BOOL;
begin
  SendMessage(hWnd, WM_SETICON, ICON_BIG, LoadIcon(HInstance, MakeIntResource(IDI_CAPTURE)));
  Result := TRUE;
end;

 // WM_COMMAND处理
procedure Capture_OnCommand(hWnd: HWND; id: Integer; hWndCtl: HWND; codeNotify: UINT);
begin
  case (id) of
    IDCANCEL:
      begin
        PostQuitMessage(0); // 结束消息循环
      end;

    IDC_CAPTUREWITHOUTJRHOOK:
      begin
        SetCapture(hWnd); // 安装鼠标捕获
        SetCursor(LoadCursor(0, IDC_UPARROW));
      end;

    IDC_CAPTUREUSINGJRHOOK:
      begin
        g_hhookJournalRecord := // 安装日志钩子以关闭'local input state processing'
          SetWindowsHookEx(WH_JOURNALRECORD, @Capture_JournalRecordProc, HInstance, 0);

        SetCapture(hWnd); // 安装鼠标捕获
        SetCursor(LoadCursor(0, IDC_UPARROW));
      end;
  end;
end;

 // WM_RBUTTONDBLCLK处理
function Capture_OnRButtonDown(hWnd: HWND; fDoubleClick: BOOL; x, y: Integer; keyFlags: UINT): Integer;
begin
  if (fDoubleClick) then // 双击鼠标右键
  begin
    ReleaseCapture(); // 取消鼠标捕获

    if (g_hhookJournalRecord <> 0) then
    begin
      UnhookWindowsHookEx(g_hhookJournalRecord); // 打开'local input state processing'
      g_hhookJournalRecord := 0;
    end;
  end;
  
  Result := 0;
end;

 // WM_MOUSEMOVE处理
procedure Capture_OnMouseMove(hWnd: HWND; x, y: Integer; keyFlags: UINT);
var
  szBuf: array[0..128] of Char;
  pt: TPoint;
begin
  GetCursorPos(pt); // 取得鼠标在屏幕上的位置
  Capture_CalcWndText(WindowFromPoint(pt), szBuf, SizeOf(szBuf));
  SetDlgItemText(hWnd, IDC_WNDUNDERMOUSE, szBuf); // 更新方框文字
end;

 // 对话框消息回调
function Capture_DlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;
begin
  case (uMsg) of
    WM_INITDIALOG:
      begin
        Result := BOOL(SetWindowLong(hWnd, DWL_MSGRESULT,
          Longint(Capture_OnInitDialog(hWnd, wParam, lParam))));
      end;

    WM_COMMAND:
      begin
        Capture_OnCommand(hWnd, LOWORD(wParam), lParam, HIWORD(wParam));
        Result := TRUE;
      end;

    WM_MOUSEMOVE:
      begin
        Capture_OnMouseMove(hWnd, LOWORD(lParam), HIWORD(lParam), wParam);
        Result := TRUE;
      end;

    WM_RBUTTONDBLCLK:
      begin
        Capture_OnRButtonDown(hWnd, TRUE, LOWORD(lParam), HIWORD(lParam), wParam);
        Result := TRUE;
      end;

    else Result := FALSE;
  end;
end;

 // 程序'主线程'入口
var
  Msg: TMsg;
  hWnd: LongWord; // HWND
begin
 // 建立主窗体
  hWnd := CreateDialog(HInstance, MakeIntResource(IDD_CAPTURE), 0, @Capture_DlgProc);

 // 循环, 直至取到WM_QUIT消息
  while GetMessage(Msg, 0, 0, 0) do
  begin
    if (Msg.message = WM_CANCELJOURNAL) then // 系统已经强行卸载钩子
    begin
      MessageBox(GetActiveWindow(), 'Capture', 'System-wide mouse capture has been canceled', 0);
      g_hhookJournalRecord := 0;
    end else
    begin
      if (not IsDialogMessage(hWnd, Msg)) then // 分发消息并对按键作'特殊处理'
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end;
  end;

 // 清除主窗体
  DestroyWindow(hWnd);
end.