Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年03月25日] [更新 2017年10月02日] Delphi サンプルプログラム集
   
260_グローバルフック ( キー・マウス )
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
260_HookKeyMouseEvent.zip [2,295 KB] 2017年04月12日版(EXE同梱)



  • 2007年10月29日
  • コードをコピペして使用した場合に発生する [リストのインデックスが範囲を超えています)] に対する修正
  • 2017年04月12日 (途中の履歴は省略)
  • マウスとキーのローカルフックのサンプルを別のページに移動




キー操作とマウス操作のグローバルフック


システム全体のキー操作とマウス操作のメッセージを捕えるサンプルコードです.
キーとマウスのグローバルフックを使用します.キーとマウスのグローバルフックを使用すると,自アプリはもちろん,自アプリ以外でのマウスの操作,キー操作も検出することができます.

本ページのサンプルは [StartHook] ボタンでフックを開始すると,メモ帳が起動します.このメモ帳がアクティブで,入力フォーカスがある,つまり,フォアグランドなウィンドウの時に限って,マウスの操作とキー操作を検出するようにしています.
システム全体や,特定のアプリケーションだけのマウス操作やキー操作を検出するようにするのにフックの処理コードは変更する必要はありません.フックからのメッセージの処理部分だけを変更すれば対応できます.

フックを登録する SetWindowsHookEx 関数の引数は,ローカルフックとグローバルフックとでは違います.MSDN オンラインの記事等で十分に確認してください.間違うと動作が不安定になるだけでなく,例外が発生してしまいます.
また,本ページのサンプルでは,フックのコールバック関数の第 1 引数の値によって処理を分岐していますが,実際には,最終的に CallNextHookEx 関数を実行しています.必要であれば書き換えてください.フックでは,フック関数の種類にもよりますが,条件によって処理を変更すると,フック後のプログラムの処理を変えることができます.

フックを利用したプログラムは,

  • (1) SetWindowsHookEx 関数でフックを開始する
    この時,コールバック関数と呼ばれる関数を,引数に指定する
    コールバック関数の名前は任意だが,引数の型と順番はフックの種類によって決まっている
  • (2) キーフックの場合,何かキーを押すと,コールバック関数が自動で実行される
  • (3) このコールバック関数内で,自アプリに何かしらのメッセージを送る
    送るメッセージは,目的によって異なる
    情報の種類と内容は,コールバック関数の引数から取得する
  • (4) フックする必要がなくなったら,UnhookWindowsHookEx 関数でフックを解除する
という感じになります.コールバック関数は,クラス (本サンプルの場合では TForm1) の関数にはできません.それは,システムが直接呼び出して実行する関数だからです.システムは,Delphi のクラス内のメンバーにはアクセスできません.


グローバルフックとローカルフックの違いは,SetWindowsHookEx 関数の引数の違いです.
ローカルフックの場合は,次のように,第 3 引数の値を 0,第 4 引数の値を GetCurrentThreadID にすれば,多くの場合十分です.ローカルフックの場合,DLL にする必要はありません.



  SetWindowsHookEx(WH_JOURNALRECORD, Addr(JournalRecordProc), 0, GetCurrentThreadID);
  SetWindowsHookEx(WH_MOUSE, Addr(MouseHookProc), 0, GetCurrentThreadID);
  SetWindowsHookEx(WH_KEYBOARD, Addr(KeyHookProc), 0, GetCurrentThreadID);


[備考]
管理者権限で起動しているアプリのウインドウ内では,フックが無効になることがあります.その場合は,本サンプルを管理者権限で実行してください.




01_WH_JOURNALRECORD


フック関数の WH_JOURNALRECORD を使用すると,DLL にしなくてもシステムのキーとマウス操作 (イベント) を検出できます.ただし,これらのイベントのメッセージを変更することはできません.
このサンプルプログラムでは,[Start Hook] をクリックすると,メモ帳を起動します.このメモ帳で発生したキーとマウスのイベントを ListView に表示します.また,押下した仮想キーコードと,マウスの座標値を表示します.

このフック関数は,WH_JOURNALPLAYBACK フックと組み合わせて,キーとマウス操作の記録,再生に利用されることがあります.そのため,フックを何かしらのキーで終了させるコードが必要です.マイクロソフトでは VK_CANCEL の検出で終了すべきとしていますので,このサンプルもこれにしたがっています.以下のいずれかのキー操作でフックが終了することになります.

  • [Ctrl] + [ESC]
  • [Ctrl] + [Pause] (あるいは [Ctrl] + [Break],[Ctrl] + [Stop] )
  • [Ctrl] + [Alt] + [Delete]
このサンプルは,Vista 以降の OS では,ユーザーインターフェイス特権の分離機能 (UIPI) のため,動作しません.WH_JOURNALRECORD フックはプロセス間で実行されるため,動作には最高の権限レベルが必要です.単に管理者権限に昇格するだけでは動作しません.デジタル署名 (コードサイニング証明書) が必要です.


図1
設計時画面
図2
実行画面
  • 下部左に仮想キーコード
  • 下部右にマウス座標値

リスト1
DLL を使用しないマウスとキーのグローバルフック
Windows XP 以前用.Windows Vista, 7 では動作しない
unit HookKeyMouseEventUnit;

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;            
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  Hook      : HHOOK;
  TargetWnd : HWND;
  MsgStr    : String;


//-----------------------------------------------------------------------------
//  WH_JOURNALRECORDのコールバック関数
//  このコードではメッセージの発生元であるウィンドウハンドルhが対象のウィンド
//  ウのハンドルと同じ時に処理を分岐.対象ウィンウを特定しなければ,システム全
//  体のイベントを調査できる.
//
//  以下のキーでフック終了
//  [Ctrl]+[Pause]ではWM_CANCELJOURNALメッセージは発生しない
//  [Ctrl]+[ESC]
//  [Ctrl]+[Pause]
//  [Ctrl]+[Alt]+[Delete]
//-----------------------------------------------------------------------------
function JournalRecordProc(nCode:Integer; wParam:WPARAM;
                            lParam:LPARAM): LRESULT; stdcall;
var
  pevent: pEVENTMSG;
  h     : HWND;
begin
  if nCode < 0 then begin
    Result := CallNextHookEx(Hook, nCode, wParam, lParam)
  end else begin
    if nCode = HC_ACTION then begin
      pEvent := pEVENTMSG(lParam);

      if (pEvent.message=WM_KEYDOWN) and (Lo(pEvent.paramL)=VK_CANCEL) then begin
        UnhookWindowsHookEx(Hook);
      end else begin
        //最前面のウィンドウのハンドルがTargetWndと同じだったら処理
        //この条件を削除すれば,全てのウィンドウでのマウス操作を検出することになる
        h := GetForegroundWindow;
        if h = TargetWnd then begin
          case pEvent.Message of
            WM_ACTIVATE:    MsgStr := 'Open';
            WM_SYSKEYDOWN:  MsgStr := 'SysKeyDown';
            WM_SYSKEYUP:    MsgStr := 'SysKeyUp';
            WM_KEYDOWN:     MsgStr := 'KeyDown';
            WM_KEYUP:       MsgStr := 'KeyUp';
            WM_MOUSEMOVE:   MsgStr := 'MouseMove';
            WM_LBUTTONDOWN: MsgStr := 'LButtonDown';
            WM_LBUTTONUP:   MsgStr := 'LButtonUp';
            WM_RBUTTONDOWN: MsgStr := 'RButtonDown';
            WM_RBUTTONUP:   MsgStr := 'RButtonUp';
            WM_MBUTTONDOWN: MsgStr := 'MButtonDown';
            WM_MBUTTONUP:   MsgStr := 'MButtonUp';
          end;
          //ウィンドウのタイトルとハンドル番号,操作内容をListViewに表示
          Form1.DisplayKeyCodeMousePos(h, MsgStr, pEvent.paramL, pEvent.paramH);
        end;
      end;
    end;

    Result := CallNextHookEx(Hook, nCode, wParam, lParam)
  end;
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;

//=============================================================================
//  フォーム破棄の時の処理
//  アプリ終了時はフック関数をアンインストール(登録解除)して対象アプリを終了
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnhookWindowsHookEx(Hook);
  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;

  Hook := SetWindowsHookEx(WH_JOURNALRECORD,
                           Addr(JournalRecordProc),
                           hInstance,
                           0);
end;

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

//=============================================================================
//  ウィンドウのタイトルとハンドル番号,操作内容をListViewに表示
//  また,押下したキー文字と仮想キーコード,マウス座標値を表示
//=============================================================================
procedure TForm1.DisplayKeyCodeMousePos(h: HWND; MsgStr: String;
     Int1, Int2: Integer);
var
  AItem : TListItem;
  ACode : Integer;
begin
  AItem := ListView1.Items.Add;
  AItem.Caption := GetWindowTextStr(h);
  AItem.SubItems.Add(IntToStr(h));
  AItem.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
    ACode := Int1 and $FF;
    Panel1.Caption := Chr(ACode) + Format(' %.2d ($%.2x)', [ACode,ACode]);
  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.




02_WH_MOUSE と WH_KEYBOARD


WH_MOUSE と WH_KEYBOARD フックのサンプルです.これらのフックは,DLL にしないとグローバルフックとなりません.動作内容は前のサンプルと同じです.Vista と Windows 7 でも動作します.

UIPI (ユーザーインターフェイス特権の分離) 対応コードについては,[04_ドラッグ・アンド・ドロップ機能の実装 ( Vista 以降への対応 )] 記事も参考にしてください.



こちらのサンプルはフックを終了させるコードは実装していません.必要であれば次のようなコードを追加すれば VK_CANCEL でフックを終了させることができます.


リスト2
VK_CANCEL ( [Ctrl] + [Break] ) でフックを終了させるためのコード例
//-----------------------------------------------------------------------------
//  DLLからグローバルフックしたキーボード情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp110(var Message: TMessage);
var
  LIsDown  : Boolean;
  LKey     : WORD;
  LhTarget : HWND;
  LMsgStr  : String;
begin
    // ------ 中略 ----------

    if LKey = VK_CANCEL then begin
      StopMouseKeyHook;
    end else begin
      //キー情報を受取った時の処理
    end;
  end;
end;


図3
設計時画面
図4
実行画面
  • 下部左に仮想キーコード
  • 下部右にマウス座標値

リスト3
WH_MOUSE と WH_KEYBORD を使用したマウスとキーのグローバルフック
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}

var
  TargetWnd : HWND;

function StartMouseKeyHook(Wnd: HWND): HHOOK; stdcall; external 'PLMOUSEKEYHOOK.DLL';
procedure StopMouseKeyHook; stdcall; external 'PLMOUSEKEYHOOK.DLL';

//=============================================================================
//  フォーム生成時の処理
//  ListViewの各カラムを設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
const
  //  Microsoft Windows SDK 7.1 より抜粋
  //  * Message Filter
  //  #define MSGFLT_ADD 1
  //  #define MSGFLT_REMOVE 2
  MSGFLT_ADD    = 1;
  MSGFLT_REMOVE = 2;
var
  DLLHandle  : THandle;
  FuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
begin
  //UIPI(ユーザーインターフェイス特権の分離)対応処理
  //このプログラムを管理者権限で実行してもWM_APP+100メッセージの受信を可能にする
  if CheckWin32Version(6, 0) then begin
    DLLHandle := loadLibrary('user32.dll');
    try
      if DLLHandle > 0 then begin
        @FuncFilter := GetProcAddress(DLLHandle, 'ChangeWindowMessageFilter');
        if @FuncFilter <> nil then begin
          FuncFilter(WM_APP+100, MSGFLT_ADD);
          FuncFilter(WM_APP+110, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  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;

//=============================================================================
//  フォーム破棄の時の処理
//  アプリ終了時はフック関数をアンインストール(登録解除)して対象アプリを終了
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  StopMouseKeyHook;

  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;

  //マウスとキーのグローバルフック開始
  StartMouseKeyHook(Handle);
end;

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

//-----------------------------------------------------------------------------
//  DLLからグローバルフックしたマウス情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
  LhTarget  : HWND;
  LMsgStr   : String;
  LMousePos : TPoint;
begin
  case Message.WParam of
    WM_NCMOUSEMOVE:   LMsgStr := 'MouseMove';
    WM_NCLBUTTONDOWN: LMsgStr := 'LButtonDown';
    WM_NCLBUTTONUP:   LMsgStr := 'LButtonUp';
    WM_NCRBUTTONDOWN: LMsgStr := 'RButtonDown';
    WM_NCRBUTTONUP:   LMsgStr := 'RButtonUp';
    WM_MOUSEMOVE:     LMsgStr := 'MouseMove';
    WM_LBUTTONDOWN:   LMsgStr := 'LButtonDown';
    WM_LBUTTONUP:     LMsgStr := 'LButtonUp';
    WM_RBUTTONDOWN:   LMsgStr := 'RButtonDown';
    WM_RBUTTONUP:     LMsgStr := 'RButtonUp';
  end;

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

//-----------------------------------------------------------------------------
//  DLLからグローバルフックしたキーボード情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp110(var Message: TMessage);
var
  LIsDown  : Boolean;
  LKey     : WORD;
  LhTarget : HWND;
  LMsgStr  : String;
begin
  //キーが押された時に処理
  LIsDown := (Message.LParam and (1 shl 31)) = 0;

  if LIsDown then begin
    //Shiftキー等を取得する場合
    //IsShift := (GetKeyState(VK_SHIFT)   and (1 shl 15)) <> 0;
    //IsCtrl  := (GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0;
    //IsAlt   := (Message.LParam          and (1 shl 29)) <> 0;
    //仮想キーコード
    LKey := Message.WParam;

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


上のコードに,Shift キー等も検出する場合の参考コードをコメントとして書いてあります.
Shift キー等の検出についは,[081] [02_コントロールキーの押下を検出] も参考にしてください.

押下したキーの文字は,次のように,ShortCutToText 関数を使用しても取得できます.
ShortCutToText 関数を使用すると,例えば,Shift キーを押下した場合,Shift という文字列が表示されます.ShortCutToText 関数の使用には,uses に Menus が必要です.




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


以下は DLL のソースコードです.
プロジェクト形式としています.拡張子が .dpr のプロジェクトファイルだけで作成してもいいのですが,関数類の見通しがいいので,この方式としています.


リスト4
WH_MOUSE と WH_KEYBORD フック用 DLL のプロジェクトファイル
library plMouseKeyHook;

uses
  plMouseKeyHookUnit in 'plMouseKeyHookUnit.pas';

//-----------------------------------------------------------------------------
//  外部からDLL内のメソッドを利用可能にするためのオマジナイ
//-----------------------------------------------------------------------------
exports
  StartMouseKeyHook,
  StopMouseKeyHook;
end.


DLL のプロジェクトのソースコードは,単に外部から使用する DLL 内の関数名を記述するだけですが,DLL 内の実際の処理は少し面倒です.

DLL は,他の開発言語からも利用可能なライブラリのことです.したがって,DLL は,基本的には,他のプログラムからも同時に使用される状況も考慮して作成しなければなりません.

DLL 内の関数,変数類は,他のアプリ,他のプロセスからもアクセスされます.この時,DLL 内の関数,変数は,プロセスごとに独立した関数または変数として扱われます.これが,DLL の関数を他の多くのプログラムから同時に利用できる理由です.
しかし,今回のフックのように,DLL 内での処理を,自分自身に送ってもらうためには,システムが割り当てる値ではなく,「自分自身」を確定するための値を保持しておく必要があります.そのためには,メモリマップドファイルと名前付き共有メモリという仕組みを利用します.

DLL の作成は面倒ですが,一度作成してしまえば,後は利用するだけです.このサンプルでは,キーとマウスのグローバルフックの汎用的な用途に,そのまま利用可能と言えます.



リスト5
WH_MOUSE と WH_KEYBORD フック用 DLL のコード
unit plMouseKeyHookUnit;

interface

uses
  Windows, Messages;

//外部のアプリケーションから使用する関数類
function StartMouseKeyHook(Wnd: HWND): Boolean; stdcall;
procedure StopMouseKeyHook; stdcall;

implementation

//共有メモリの内容の構造体
type
  PHookInfo  = ^THookInfo;
  THookInfo  = record
  HookKeyHandle   : HHOOK;
  HookMouseHandle : HHOOK;
  HostWnd         : HWND;
end;

var
  //メモリマップドファイルのハンドル
  hMapFile : THandle;

const
  //メモリマップドファイル名
  MapFileName = 'plMouseKeyHookDLL';

//-----------------------------------------------------------------------------
//  共有メモリアクセスのための準備
//
//  成功すると0を返す.失敗すると負数を返す.
//  負の値で処理を分岐できるようになっているが,このコードでは未使用.
//-----------------------------------------------------------------------------
function MapFileMemory(var hMap: THandle; var pMap: pointer): Integer;
begin
  //メモリマップドファイルを開く
  hMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, MapFileName);
  if hMap = 0 then begin
    Result := -1;
    exit;
  end;

  //メモリマップドファイルの割り当て
  pMap := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if pMap = nil then begin
    Result := -2;
    CloseHandle(hMap);
    exit;
  end;

  Result := 0;
end;

//-----------------------------------------------------------------------------
//  共有メモリアクセスの後始末
//  割当てたメモリがあればビューを解除
//  ハンドルがあればクローズ
//-----------------------------------------------------------------------------
procedure UnMapFileMemory(hMap: THandle; pMap: Pointer);
begin
  if pMap <> nil then UnmapViewOfFile(pMap);
  if hMap <> 0 then CloseHandle(hMap);
end;

//-----------------------------------------------------------------------------
//  マウスフックのコールバック関数
//  このDLLを使用したアプリにメッセージを送る
//-----------------------------------------------------------------------------
function MouseHookProc(nCode:integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LpMap   : Pointer;
  LMapWnd : THANDLE;
begin
  Result := 0;
  if MapFileMemory(LMapWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookMouseHandle, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      PostMessage(pHookInfo(LpMap)^.HostWnd, WM_APP+100, wPar, 0);
    end;
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookMouseHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LMapWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  キーフックのコールバック関数
//  このDLLを使用したアプリにメッセージを送る
//-----------------------------------------------------------------------------
function KeyHookProc(nCode:integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LpMap   : Pointer;
  LMapWnd : THANDLE;
begin
  Result := 0;
  if MapFileMemory(LMapWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookKeyHandle, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      PostMessage(pHookInfo(LpMap)^.HostWnd, WM_APP+110, wPar, lPar);
    end;
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookKeyHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LMapWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フック関数の登録
//-----------------------------------------------------------------------------
function StartMouseKeyHook(Wnd: HWND): Boolean; stdcall;
var
  LpMap   : Pointer;
  LMapWnd : THandle;
begin
  Result := False;

  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
    exit;
  end;

  //フック情報構造体初期化とフック関数の登録
  pHookInfo(LpMap)^.HostWnd := Wnd;
  //フックをインストール
  pHookInfo(LpMap)^.HookMouseHandle := SetWindowsHookEx(WH_MOUSE,
                                                    Addr(MouseHookProc),
                                                    hInstance,
                                                    0);
  pHookInfo(LpMap)^.HookKeyHandle := SetWindowsHookEx(WH_KEYBOARD,
                                                  Addr(KeyHookProc),
                                                  hInstance,
                                                  0);
  //フック成功
  if (pHookInfo(LpMap)^.HookMouseHandle > 0) and
     (pHookInfo(LpMap)^.HookKeyHandle > 0) then begin
    Result := True;
  end;

  //メモリマップドファイル使用終了処理
  UnMapFileMemory(LMapWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopMouseKeyHook; stdcall;
var
  LpMap   : Pointer;
  LMapWnd : THandle;
begin
  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
    exit;
  end;

  //フック解除
  if pHookInfo(LpMap)^.HookMouseHandle > 0 then begin
    UnhookWindowsHookEx(pHookInfo(LpMap)^.HookMouseHandle);
  end;
  if pHookInfo(LpMap)^.HookKeyHandle > 0 then begin
    UnhookWindowsHookEx(pHookInfo(LpMap)^.HookKeyHandle);
  end;

  //メモリマップドファイル使用終了処理
  UnMapFileMemory(LMapWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  ユニット初期化部
//  メモリマップドファイルの作成
//
//  High(NativeUInt)の値は
//  32ビットアプリでは$FFFFFFFF
//  64ヒットアプリでは$FFFFFFFFFFFFFFFF
//-----------------------------------------------------------------------------
initialization
begin
  hMapFile := CreateFileMapping(High(NativeUInt),
                                nil,
                                PAGE_READWRITE,
                                0,
                                SizeOf(THookInfo),
                                MapFileName);
end;

//-----------------------------------------------------------------------------
//  ユニット終了処理部
//  メモリマップドファイルのクローズ
//-----------------------------------------------------------------------------
finalization
begin
  if hMapFile<>0 then CloseHandle(hMapFile);
end;

end.




03_WH_MOUSE フックにおけるマウスカーソル位置の取得


上のサンプルでは,マウスカーソルの位置を GetCursorPos 関数で取得しています.
フックのコールバック関数内でマウスカーソル位置を取得して,受信側で受け取るようにすることもできます.それには,マウスフックの情報を格納している構造体 (レコード型) からマウスカーソル位置を取得します.
次のコードでは,PostMessage の LParam パラメータの上位ワードと下位ワードにマウスカーソルの座標値を格納しています.


//-----------------------------------------------------------------------------
//  マウスフックのコールバック関数
//  このDLLを使用したアプリにメッセージを送る
//
//  マウスカーソル位置をlParamの下位ワード,上位ワードに格納
//-----------------------------------------------------------------------------
function MouseHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LpMap     : Pointer;
  LMapWnd   : THANDLE;
  LMousePos : TPoint;
begin
  Result := 0;
  if MapFileMemory(LMapWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(p)^.HookMouseHandle, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      LMousePos := PMouseHookStruct(lPar)^.pt;
      PostMessage(pHookInfo(p)^.HostWnd,
                  WM_APP+100,
                  wPar,
                  MakeLParam(LMousePos.X, LMousePos.Y));
    end;
    Result := CallNextHookEx(pHookInfo(p)^.HookMouseHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LMapWnd, LpMap);
end;


受信側では,次のように,LParam の下位ワードから X 座標値,上位ワードから Y 座標値を取り出すことができます.


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




04_WH_MOUSE_LL と WH_KEYBOARD_LL


低レベルのキーフックとマウスフックである WH_KEYBOARD_LL と WH_MOUSE_LL を使用したサンプルです.低レベルのキーとマウスフックは DLL にしなくてもグローバルフックを実現できます.

マウスメッセージの検出種類を増やしていますが実際に検出できるわけではありません.DLL を使用した上のサンプルとの違いが確認できるようにしているだけです.

このコードでは WM_APP+100 と WM_APP+110 というメッセージでフックのコールバック関数からメッセージを受取っていますが,特にこの方法を使う必要はありません.例えば WndProc 等でのメッセージを処理,あるいは,TApplicationEvents の OnMessage イベントでの処理も考えられます.これは他のフックのサンプルでも同じです.

この低レベルのフックは,上のサンプルでのメッセージよりも早く発生します.そのため,このメッセージで処理を行った後,システムが他のメッセージを送る間に他の処理を実行することになります.したがって,上のサンプルコードの通常のフックと同様な処理を行っても,微妙な違いが発生することがあります.

[Shift] キー等のコントロールキーの押下を同時に検出したい場合は,上のサンプルの記事を参考にしてください.



リスト6
低レベルのマウスフック WH_MOUSE_LL とキーフック WH_KEYBORD_LL を使用したコード
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 LowLevelMouseProc(nCode: 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.


押下したキーの文字は,次のように,ShortCutToText 関数を使用しても取得できます.
ShortCutToText 関数を使用すると,コントロールキーを押下した場合,そのコントロールキーの名前が表示されます.例えば,Shift キーを押下した場合,Shift という文字列が表示されます.
ShortCutToText 関数の使用には,uses に Menus が必要です.


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




05_WH_MOUSE_LL フックにおけるマウスカーソル位置の取得


上のサンプルでは,マウスカーソルの位置を GetCursorPos 関数で取得しています.
フックのコールバック関数内でマウスカーソル位置を取得して,受信側で受け取るようにすることもできます.それには,マウスフックの情報を格納している構造体 (レコード型) からマウスカーソル位置を取得します.
次のコードでは,PostMessage の LParam パラメータの上位ワードと下位ワードにマウスカーソルの座標値を格納しています.


//-----------------------------------------------------------------------------
//  マウスフックのコールバック関数
//
//  マウスカーソル位置をlParamの下位ワード,上位ワードに格納
//-----------------------------------------------------------------------------
function LowLevelMouseProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): 
  LRESULT; stdcall;
var
  LMousePos : TPoint;
begin
  if Code < 0 then begin
    Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
    exit;
  end;

  if Code = HC_ACTION then begin
    LMousePos := PMsllHookStruct(lPar)^.pt;
    PostMessage(Form1.Handle, WM_APP+100, wPar, MakeLParam(LMousePos.X, MoLusePos.Y));
  end;

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


受信側では,次のように,LParam の下位ワードから X 座標値,上位ワードから Y 座標値を取り出すことができます.


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




06_グローバルフックを使用しないマウスカーソルの位置取得


自アプリ以外の場所のマウスカーソルの位置は,ここまでのサンプルで示したように,マウスのグローバルフックを使用して取得できます.
マウスカーソルの位置は,次のリンクの記事のように,グローバルなホットキーを使用して取得することもできます.ホットキーはキーフックの一種です.また,下図の説明のような方法でもマウスカーソルの位置を取得できます.これは,マウスを押している間は,そのマウスの所属が元のウィンドウであることを利用しています.

本サンプルは,マウスカーソル位置の色を取得して,その色の値を表示します.



図5
実行画面
  • マウスの左ボタンを Panel1 の上で押す
  • そのまま画面の任意の位置にマウスを移動
  • ボタンを放すとその座標値が取得できる

リスト7
画面上のマウスカーソル位置を取得するテスト用コード
コードそのものはマウスカーソル位置取得には関係ない.マウスの操作に意味がある
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  protected
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1 : TForm1;

implementation

{$R *.DFM}


//=============================================================================
//  Button1のOnMouseUpイベント処理
//
//  マウスの左ボタンをPanle1の上で押す
//  左ボタンを押したまま画面の任意の位置に移動
//  ボタンを放すとその位置の座標値が取得できる
//=============================================================================
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LPos    : TPoint;
  LDispDC : HDC;
  LColor  : TColor;
begin
  Panel1.ParentBackground := False;

  //LPos := Mouse.CursorPos;でも同じ
  GetCursorPos(LPos);

  LDispDC := CreateDC('DISPLAY', nil, nil, nil);
  if LDispDC <> 0 then begin
    LColor := GetPixel(LDispDC, LPos.X, LPos.Y);
    Panel1.Color := LColor;
    Edit1.Text := Format('$%.8x', [LColor]);

    DeleteDC(LDispDC);
  end;
end;

end.




07_押下したキーの名前を取得


上の方の記事で ShortCutToText 関数を使用すると押下したキーの名前が取得できると書きました.次のコードのように GetKeyNameText 関数を使用すると,KeyDown では検出できないシステムキー以外は全てキーの名前を取得することができます.



図6
F5 キーの場合
図7
テンキーの数字の 6 のキーの場合
図8
[Page Down] キーの場合
図9
右の [Win] キーの場合
  • [スタートメニュー] がアクティブになる

リスト8
GetKeyNameText 関数を使用して押下したキーの名前を取得
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
  protected
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1 : TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  WM_KEYDOWNメッセージ処理
//  キーの文字列を取得して表示
//=============================================================================
procedure TForm1.WMKeyDown(var Message: TWMKeyDown);
var
 LBuff : array[0..31] of Char;
 LText : string;
begin
 GetKeyNameText(Message.KeyData, LBuff, Length(LBuff));

 LText := LBuff;
  Panel1.Caption := LText;

 inherited;
end;

end.