サーバレス練習帳

着眼大局着手小局

Delphi Global Hook Low Level

凄いお世話になっているMr.XRAYさんのコードに、多分、一部の誤字があると思い、私なりに訂正してみた。
04_WH_MOUSE_LL と WH_KEYBOARD_LL
mrxray.on.coocan.jp

とはいえ、ほぼ、引用先のソースコードそのままです。これが書ける人って、凄いな。
ちなみに、「 //この条件を削除すれば，全てのウィンドウでのマウス操作を検出することになる」
という記述以降の条件をコメントアウトすると、本当に全てのウインドウでのマウス操作を検出します。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Panel3: TPanel;
    Button1: TButton;
    Button2: TButton;
    Panel4: TPanel;
    Panel1: TPanel;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DisplayKeyCodeMousePos(h: HWND; MsgStr: String;
            Int1,Int2: Integer);
    function GetWindowTextStr(hWindow:HWND):String;
  protected
    procedure WMApp100(var Message: TMessage); message WM_APP+100;
    procedure WMApp110(var Message: TMessage); message WM_APP+110;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
//  低レベルキーフックの情報構造体と定数
//  LLMHF_INJECTEDはマウスフックで使用
//
//  Microsoft Windows SDK 7.1の記述(構造体もSDKからのもの)
//  Low level hook flags
//
//  #define LLKHF_EXTENDED       (KF_EXTENDED >> 8)
//  #define LLKHF_INJECTED       0x00000010
//  #define LLKHF_ALTDOWN        (KF_ALTDOWN >> 8)
//  #define LLKHF_UP             (KF_UP >> 8)
//  #define LLMHF_INJECTED       0x00000001
//-----------------------------------------------------------------------------
const
  LLKHF_EXTENDED = KF_EXTENDED shr 8;
  LLKHF_INJECTED = $00000010;
  LLKHF_ALTDOWN  = KF_ALTDOWN shr 8;
  LLKHF_UP       = KF_UP shr 8;
  LLMHF_INJECTED = $00000001;

type
  LPKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  tagKBDLLHOOKSTRUCT = record
    vkCode      : DWORD;
    scanCode    : DWORD;
    flags       : DWORD;
    time        : DWORD;
    dwExtraInfo : ULONG_PTR;
  end;
  KBDLLHOOKSTRUCT  = tagKBDLLHOOKSTRUCT;
  TKbDllHookStruct = KBDLLHOOKSTRUCT;
  PKbDllHookStruct = LPKBDLLHOOKSTRUCT;

//-----------------------------------------------------------------------------
//  低レベルマウスフックのキー情報構造体
//-----------------------------------------------------------------------------

  LPMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;
  tagMSLLHOOKSTRUCT = record
    pt: TPOINT;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;
  MSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
  TMsllHookStruct = MSLLHOOKSTRUCT;
  PMsllHookStruct = LPMSLLHOOKSTRUCT;

var
  KeyHookHandle   : HHOOK;
  MouseHookHandle : HHOOK;
  TargetWnd       : HWND;

//-----------------------------------------------------------------------------
//  マウスフックのコールバック関数
//-----------------------------------------------------------------------------
function LowLevelMouseProc(Code:integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
begin
  if Code < 0 then begin
    Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
    exit;
  end;

  if Code = HC_ACTION then begin
    PostMessage(Form1.Handle, WM_APP+100, wPar, 0);
  end;

  Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
end;

//-----------------------------------------------------------------------------
//  キーフックのコールバック関数
//-----------------------------------------------------------------------------
function LowLevelKeyProc(Code: Integer; wPar: WPARAM; lPar: LPARAM):
  LRESULT; stdcall;
var
  Lkbdll    : PKBDLLHOOKSTRUCT;
  LScanCode : Integer;
begin
  if Code < 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
    exit;
  end;

  Lkbdll := PKBDLLHOOKSTRUCT(lPar);
  if Code = HC_ACTION then begin
    if wPar = WM_KEYDOWN then begin
      LScanCode := Lkbdll.scanCode;
      PostMessage(Form1.Handle, WM_APP+110, LScanCode, Lkbdll.vkCode);
    end;
  end;

  Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
end;

//=============================================================================
//  フォーム生成時の処理
//  ListViewの各カラムを設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.ViewStyle:=vsReport;
  ListView1.Columns.Add;

  ListView1.Columns[0].Caption := ' TITLE';
  ListView1.Columns[0].Width   := 130;

  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := ' HANDLE ';
  ListView1.Columns[1].Width   := 66;

  ListView1.Columns.Add;
  ListView1.Columns[2].Caption := ' EVENT';
  ListView1.Columns[2].Width   := 85;
end;

//=============================================================================
//  アプリ終了時はフック関数をアンインストール(登録解除)して対象アプリを終了
//  WH_MOUSE,WH_KEYBORDと違いアンインストールに時間がかかるような気がする
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if MouseHookHandle <> 0 then UnhookWindowsHookEx(MouseHookHandle);
  if KeyHookHandle <> 0   then UnhookWindowsHookEx(KeyHookHandle);

  if TargetWnd <> 0 then begin
    SendMessage(TargetWnd, WM_CLOSE, 0, 0);
  end;
end;

//=============================================================================
//  [StartHook]ボタン
//  フック開始
//  イベントの発生を記録する対象としてメモ帳を起動
//  フック関数をインストール(登録)
//
//  TargetWndは起動したメモ帳のウィンドウハンドルでグローバル変数
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  TargetWnd := FindWindow('NotePad', nil);
  if TargetWnd = 0 then begin
    ShellExecute(Self.Handle,'open',
                 PChar('Notepad.exe'),
                 nil,
                 nil,SW_SHOW);

    while True do begin
      TargetWnd := FindWindow('NotePad', nil);
      if TargetWnd <> 0 then break;
      Application.ProcessMessages;
   end;
  end;

  //マウスとキーのグローバルフック開始
  if MouseHookHandle = 0 then
    MouseHookHandle := SetWindowsHookEx(WH_MOUSE_LL,
                                        @LowLevelMouseProc,
                                        hInstance,
                                        0);
  if KeyHookHandle = 0 then
    KeyHookHandle := SetWindowsHookEx(WH_KEYBOARD_LL,
                                      @LowLevelKeyProc,
                                      hInstance,
                                      0);
end;

//=============================================================================
//  [StopHook]ボタン
//  フック終了
//  フック関数をアンインストール(登録解除)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if MouseHookHandle <> 0 then begin
    UnhookWindowsHookEx(MouseHookHandle);
    MouseHookHandle := 0;
  end;
  if KeyHookHandle <> 0 then begin
    UnhookWindowsHookEx(KeyHookHandle);
    KeyHookHandle := 0;
  end;
end;

//-----------------------------------------------------------------------------
//  フックしたマウス情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
  LhTarget  : HWND;
  LMsgStr   : String;
  LMousePos : TPoint;
begin
  case Message.WParam of
    WM_NCMOUSEMOVE     : LMsgStr := 'NC_MouseMove';
    WM_NCLBUTTONDOWN   : LMsgStr := 'NC_LButtonDown';
    WM_NCLBUTTONUP     : LMsgStr := 'NC_LButtonUp';
    WM_NCLBUTTONDBLCLK : LMsgStr := 'NC_LButtonDBLClick';
    WM_NCRBUTTONDOWN   : LMsgStr := 'NC_RButtonDown';
    WM_NCRBUTTONUP     : LMsgStr := 'NC_RButtonUp';
    WM_NCRBUTTONDBLCLK : LMsgStr := 'NC_RButtonDBLClick';
    WM_NCMBUTTONDOWN   : LMsgStr := 'NC_MButtonDown';
    WM_NCMBUTTONUP     : LMsgStr := 'NC_MButtonUp';
    WM_NCMBUTTONDBLCLK : LMsgStr := 'NC_MButtonDBLClick';

    WM_MOUSEMOVE       : LMsgStr := 'MouseMove';
    WM_LBUTTONDOWN     : LMsgStr := 'LButtonDown';
    WM_LBUTTONUP       : LMsgStr := 'LButtonUp';
    WM_LBUTTONDBLCLK   : LMsgStr := 'LButtonDBLClick';

    WM_RBUTTONDOWN     : LMsgStr := 'RButtonDown';
    WM_RBUTTONUP       : LMsgStr := 'RButtonUp';
    WM_RBUTTONDBLCLK   : LMsgStr := 'RButtonDBLClick';

    WM_MBUTTONDOWN     : LMsgStr := 'MButtonDown';
    WM_MBUTTONUP       : LMsgStr := 'MButtonUp';
    WM_MBUTTONDBLCLK   : LMsgStr := 'MButtonDBLClick';
    WM_MOUSEWHEEL      : LMsgStr := 'MouseWheel';
    WM_MOUSEHWHEEL     : LMsgStr := 'MouseHWheel';
  end;

  //最前面のウィンドウのハンドルがTargetWndと同じだったら処理
  //この条件を削除すれば，全てのウィンドウでのマウス操作を検出することになる
  LhTarget := GetForegroundWindow;
  if LhTarget = TargetWnd then begin
    GetCursorPos(LMousePos);
    //アクティブウィンドウのタイトルと操作内容をListViewに表示
    Form1.DisplayKeyCodeMousePos(LhTarget, LMsgStr, LMousePos.X, LMousePos.Y);
  end;
end;

//-----------------------------------------------------------------------------
//  フックしたキーボード情報を受取る
//  KEYDOWNで送られてくる
//-----------------------------------------------------------------------------
procedure TForm1.WMApp110(var Message: TMessage);
var
  LKey     : WORD;
  LMsgKind : WORD;
  LhTarget : HWND;
  LMsgStr  : String;
begin
  LKey     := Message.LParam;
  LMsgKind := Message.WParam;

  LMsgStr := 'KeyDown';
  //最前面のウィンドウのハンドルがTargetWndと同じだったら処理
  //この条件を削除すれば，全てのウィンドウでのキー操作を検出することになる
  LhTarget := GetForegroundWindow;
  if LhTarget = TargetWnd then begin
    //アクティブウィンドウのタイトルと操作内容をListViewに表示
    Form1.DisplayKeyCodeMousePos(LhTarget, LMsgStr, LKey, LMsgKind);
  end;
end;

//-----------------------------------------------------------------------------
//  ウィンドウのタイトルとハンドル番号，操作内容をListViewに表示
//  また，押下したキー文字と仮想キーコード，マウス座標値を表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayKeyCodeMousePos(h: HWND; MsgStr: String;
  Int1, Int2: Integer);
var
  LItem : TListItem;
  LCode : Integer;
begin
  LItem := ListView1.Items.Add;

  LItem.Caption := GetWindowTextStr(h);
  LItem.SubItems.Add(IntToStr(h));
  LItem.SubItems.Add(MsgStr);

  //ListViewの一番最後を表示
  ListView1.Items[ListView1.Items.Count-1].Selected := True;
  ListView1.Items[ListView1.Items.Count-1].Focused  := True;
  ListView1.Items[ListView1.Items.Count-1].MakeVisible(True);

  if MsgStr = 'KeyDown' then begin
    LCode := Int1 and $FF;
    Panel1.Caption := Chr(LCode) + Format(' %.2d ($%.2x)', [LCode,LCode]);
  end;

  if MsgStr = 'LButtonDown' then begin
    Panel2.Caption := Format('[ X=%.4d Y=%.4d ]', [Int1, Int2]);
  end;
end;

//-----------------------------------------------------------------------------
//  対象のウィンドウハンドルhWindowからそのタイトル(キャプション)を取得
//-----------------------------------------------------------------------------
function TForm1.GetWindowTextStr(hWindow: HWND): String;
var
  Buff : array [0..MAX_PATH-1] of Char;
begin
  FillChar(Buff[0], MAX_PATH, #0);
  GetWindowText(hWindow, Buff, GetWindowTextLength(hWindow) + 1);

  Result := String(Buff);
end;

end.