第７章 ウィンドウメッセージを捕まえる : ローカルフック

各ウィンドウのウィンドウ関数がメッセージを受け取る経路は二つある。ひとつは、マウスやキーボード、タイマ、ウィンドウの描画などに関係するメッセージであり、システムがメッセージキューにポストし、スレッドのメッセージループで GetMessage() または PeekMessage() を使って取り出し、DispatchMessage() で再度システム経由でウィンドウ関数に送られるものだ。もうひとつは、SendMessage() を実行した場合のように、システムがメッセージキューを経由しないで直接ウィンドウ関数を呼び出す場合である。どのメッセージがどちらに属するかは、英語のヘルプを読むと、post と send という動詞を使って明確に区別されている。ここでは、VCL に備わっているメッセージ捕獲機構を調べ、また、VCL の実装とはまったく無関係に API を使ってメッセージを捕獲するローカルフックを試してみよう。

７−０ この章の内容


|  arrw18c.gif 前の章へ| 総目次へ | 次の章へ arrw18d.gif ｜

７−１ Application.OnMessage

プログラムのメインルーチンではウィンドウをつくって、それを表示した後、すぐに end. に到達してしまうとそこでプログラムは終了してしまう。これでは GUI アプリとしては無意味である。API の方の第１章でみたように、また、ウィンドウズの GUI アプリに限らず、一般に、実行がすぐに終わらないようにするためには、どこかでループしてユーザが終了の合図を送るのを待つ機構が必要である。これが、Windows の GUI アプリの場合は、メッセージループと呼ばれる機構で、ただ無意味にループしているわけではなく、ユーザの働きかけによって生じるメッセージをウィンドウに届ける重要な役割を担っている。Delphi の VCL のフレームワークでは、メインルーチンに相当するのはプロジェクトファイルのコードである。デフォルトでは、Form1 を作ってから Application.Run; が実行され、これはアプリが終了するまで制御が戻らない。したがって、メッセージループは、この Application.Run; の中にあるのだろう、と推測できる。実際、VCL のソースコードを調べると、メッセージループを発見できる。このメッセージループの中の DispatchMessage() でウィンドウにメッセージを送る前に呼び出されるのが Application.OnMessage イベントである。したがって、このイベントは、VCL 独自の機構により呼び出されるのである。ここでは、このイベントを実際に使って試してみよう。メッセージキューに入るほとんどのメッセージ（後述するように全部ではない）がこのイベントで捕まえられる。ここでは、マウスの左ボタンを押したときのメッセージ WM_LBUTTONDOWN だけを捕まえてみよう。コンポーネントパレットの Additional タブのところにある TApplicationEvents を使うと簡単に実装できる。

List 1

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Panel1: TPanel;
    Button1: TButton;
    Shape1: TShape;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function GetClassNameStr(Handle:HWND):string;
var
  Len:integer;
  PC:PChar;
begin
  GetMem(PC,100);
  Len := GetClassName(Handle,PC,100);
  SetString(result,PC,Len);
  FreeMem(PC);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.ScrollBars := ssVertical;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  case Msg.message of
    WM_LBUTTONDOWN:
      Memo1.Lines.Add(GetClassNameStr(Msg.hwnd) +' - from AppMessage');
  end;
end;

end.
AppMessage01.gif

実行していろいろなところをマウスでクリックすると、クリックしたところの TWinControl の派生クラスのクラス名が Memo1 に表示される。TLabel や TShape はウィンドウを作らない TGraphicControl の派生クラスなのでクリックすると下の TForm1 が表示される。


このように、Application.OnMessage は、マウスメッセージやキーボードメッセージ、描画メッセージ、タイマーメッセージなどのキューを通過するほとんどのメッセージを捕まえることができる。しかし、全部ではない。上のプロジェクトに OpenDialog1 コンポーネントを追加して

List 2

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog1.Execute;
end;
AppMessage02.gif

を実行してみよう。右図のように、OpenDialog1 が表示するモーダルダイアログ上でマウスをクリックしても Application.OnMessage で捕まえることはできない。


AppMessage03.gif

また、Memo1 を右クリックして表示されるポップアップメニュー上でのクリックによるメッセージも捕まえられない。


このように、メインのメッセージループから制御を奪うモーダルループやメニューループでは、Application.OnMessage は呼ばれない。TForm.ShowModal の場合は大丈夫であるが。次節では、VCL の実装と全く無関係な Windows のメッセージ捕獲機構であるフック関数を試してみよう。

redball.gifこの章の目次へ戻る

７−２ ローカルフック ： WH_GETMESSAGE

前節でやった Application.OnMessage の機能に一番ちかいローカルフックは WH_GETMESSAGE である。前節のプログラムにコードを追加して確かめてみよう。

List 3

unit Main;

interface

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

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    Memo1: TMemo;
    Label1: TLabel;
    Panel1: TPanel;
    Button1: TButton;
    Shape1: TShape;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Item11Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  Hook: HHOOK;

function GetClassNameStr(Handle:HWND):string;
var
  Len:integer;
  PC:PChar;
begin
  GetMem(PC,100);
  Len := GetClassName(Handle,PC,100);
  SetString(result,PC,Len);
  FreeMem(PC);
end;

function GetMsgProc(code:integer;wparam:WPARAM;lparam:LPARAM):LRESULT;stdcall;
var
  Msg: PMsg;
begin
  if (code < 0) then begin
    result := CallNextHookEx(Hook,code,wparam,lparam);
    exit;
  end;

  if (code = HC_ACTION) then begin
    Msg := PMsg(lparam);
    case Msg^.message of
      WM_LBUTTONDOWN:begin
       if wparam = PM_REMOVE then
         Form1.Memo1.Lines.Add(GetClassNameStr(Msg.hwnd) +' - from Hook ');
      end;
    end;
  end;
  
  result := CallNextHookEx(Hook,code,wparam,lparam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.ScrollBars := ssVertical;

  Hook := SetWindowsHookEx(WH_GETMESSAGE,GetMsgProc,0,GetCurrentThreadID);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  case Msg.message of
    WM_LBUTTONDOWN:
      Memo1.Lines.Add(GetClassNameStr(Msg.hwnd) +' - from AppMessage');
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnHookWindowsHookEx(Hook);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog1.Execute;
end;

end.
GetMsg01.gif

実行して、Memo1 上で右クリックして表示されるポップアップメニューや、Button1 を押して表示される OpenDialog1 などの上でマウスをクリックしてみると、右図のように Application.OnMessage では捕まらなかったメッセージもこのローカルフックでは捕まえられることが分かる。


コードを調べよう。

すでにローカルフックの例は、API のところの ４−３ フック関数の簡単な例 や Notes のところのフック関数のインスタンス化 で示している。また、VCL でもヒントウィンドウやツールバーの実装に使われている。どの場合も

Hook := SetWindowsHookEx(HOOK_TYPE,HookProc,0,GetCurrentThreadID);

を実行してインストールし、

UnHookWindowsHookEx(Hook);

でアンインストールする。OS から呼び出される HookProc のかたちは決まっていて、

function HookProc(code:integer;wparam:WPARAM;lparam:LPARAM):LRESULT;stdcall;

となっている。関数の名前は任意である。この三つのパラメータの解釈の仕方が、インストールするフックの種類によって違っている。

今回の WH_GETMESSAGE の場合は、code が HC_ACTION のときだけメッセージを処理することができる。code が負のときは、すぐに次のチェーンへ渡してその結果をもどす。このフック関数は、メッセージループに渡る前に呼び出される。実際のコードは、

function GetMsgProc(code:integer;wparam:WPARAM;lparam:LPARAM):LRESULT;stdcall;
var
  Msg: PMsg;
begin
  if (code < 0) then begin
    result := CallNextHookEx(Hook,code,wparam,lparam);
    exit;
  end;

  if (code = HC_ACTION) then begin
    Msg := PMsg(lparam);
    case Msg^.message of
      WM_LBUTTONDOWN:begin
       if wparam = PM_REMOVE then
         Form1.Memo1.Lines.Add(GetClassNameStr(Msg.hwnd) +' - from Hook ');
      end;
    end;
  end;
  
  result := CallNextHookEx(Hook,code,wparam,lparam);
end;

のようになっている。wparam は、以下のいずれかである。

PM_NOREMOVE  このメッセージは、PeekMessage() で覗かれているだけでキューから削除されない。

PM_REMOVE    このメッセージは、この後キューから削除される。

実際の処理は、PM_REMOVE のときだけ行えば十分である。lparam は、以下のような TMsg レコード型変数へのポインタ PMsg であると解釈する。

  PMsg = ^TMsg;
  tagMSG = packed record
    hwnd: HWND;
    message: UINT;
    wParam: WPARAM;
    lParam: LPARAM;
    time: DWORD;
    pt: TPoint;
  end;
  TMsg = tagMSG;
  MSG = tagMSG;

これは、メッセージキューから取り出されるナマのメッセージそのものであり、すでに API の１−３−５ メッセージループ で説明した。ここでは message が WM_LBUTTONDOWN のときだけ捕まえて表示した。

redball.gifこの章の目次へ戻る

７−３ ローカルフック ： WH_CALLWNDPROCRET

さて、メッセージの流れのもう一つの方は、SendMessage() によって送られるキューを通過しない、したがってメッセージループを経由しないものである。これを捕まえる VCL のイベントは無いようである。ローカルフックでは、WH_CALLWNDPROC と WH_CALLWNDPROCRET がこれらのメッセージを捕まえられる。前者は、ウィンドウ関数に渡される前に、後者は後にフック関数が呼び出される。つまり、ウィンドウ関数によって処理される前後で同じメッセージを捕まえられるわけである。ここでは WH_CALLWNDPROCRET を試してみよう。

すでに、第２章 コントロールのメッセージ処理（その１）で調べたように、コントロールは、ユーザがなにか操作して状態に変更が起きたとき、親ウィンドウに通知メッセージを送って処理を依頼する、というふうに実装されている。標準コントロールの場合は WM_COMMAND を、コモンコントロールの場合は WM_NOTIFY を、標準スクロールバーやスクロールバーコントロール、アップダウン、トラックバーは、WM_VSCROLL または WM_HSCROLL を親コントロールに送る。リッチエディットのように WM_COMMAND と WM_NOTIFY の両方を送る場合もある。また、メニューやアクセレレータも WM_COMMAND を送る。このように、SendMessage() で送られるメッセージを簡単に捕まえられると、いろいろな応用ができるようになるだろう。それではさっそく始めてみよう。

List 4

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    RichEdit1: TRichEdit;
    Button1: TButton;
    ComboBox1: TComboBox;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Edit1: TEdit;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  Hook: HHOOK;

function GetClassNameStr(Handle:HWND):string;
var
  Len:integer;
  PC:PChar;
begin
  GetMem(PC,100);
  Len := GetClassName(Handle,PC,100);
  SetString(result,PC,Len);
  FreeMem(PC);
end;

procedure WMCommand(hWindow: HWND;wParam: WPARAM; lParam: LPARAM);
begin
  if HWND(lParam) = Form1.Memo1.Handle then exit;
  if lParam <> 0 then
    Form1.Memo1.Lines.Add(Format('WM_COMMAND  from  %s  to  %s',
                          [GetClassNameStr(lParam),GetClassNameStr(hWindow)]));
end;

procedure WMNotify(hWindow: HWND;wParam: WPARAM; lParam: LPARAM);
var
  pHdr:PNMHdr;
begin
  pHdr := PNMHdr(lParam);
  Form1.Memo1.Lines.Add(Format('WM_Notify   from  %s  to  %s',
     [GetClassNameStr(pHdr^.hwndFrom),GetClassNameStr(hWindow)]));
end;


procedure ProcessMessage(hWindow:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM);
begin
  case Msg of
    WM_COMMAND:WMCommand(hWindow,wParam,lParam);
    WM_NOTIFY:WMNotify(hWindow,wParam,lParam);
  end;
end;

function CallWndRetProc(code:integer;wparam:WPARAM;lparam:LPARAM):LRESULT;stdcall;
var
  pCWPR:PCWPRetStruct;
begin
  if (code < 0) then begin
    result := CallNextHookEx(Hook,code,wparam,lparam);
    exit;
  end;

  if (Code = HC_ACTION) then begin
    pCWPR := PCWPRetStruct(lParam);
    ProcessMessage(pCWPR^.hwnd,pCWPR^.message,pCWPR^.wParam,pCWPR^.lParam);
  end;

  result := CallNextHookEx(Hook,code,wparam,lparam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.ScrollBars := ssVertical;

  Hook := SetWindowsHookEx(WH_CALLWNDPROCRET,CallWndRetProc,0,GetCurrentThreadID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnHookWindowsHookEx(Hook);
end;

end.
CallWndProcRet01.gif

適当に標準コントロールやコモンコントロールを置いて、実行すると右図のようになる。ここでは、WM_COMMAND と WM_NOTIFY メッセージを捕まえて、それを送ったコントロールと受け取ったコントロールのクラス名を Memo1 に表示している。ここでは試していないが、このフックはスレッドローカルなので、Form2 などの他のフォーム上のコントロールや TOpenDialog コモンダイアログなど、あらゆるコントロールからのメッセージを捕まえられる。


コードを調べよう。フックのインストールの仕方はいつもと同じである。フック関数を見てみよう。

function CallWndRetProc(code:integer;wparam:WPARAM;lparam:LPARAM):LRESULT;stdcall;
var
  pCWPR:PCWPRetStruct;
begin
  if (code < 0) then begin
    result := CallNextHookEx(Hook,code,wparam,lparam);
    exit;
  end;

  if (Code = HC_ACTION) then begin
    pCWPR := PCWPRetStruct(lParam);
    ProcessMessage(pCWPR^.hwnd,pCWPR^.message,pCWPR^.wParam,pCWPR^.lParam);
  end;

  result := CallNextHookEx(Hook,code,wparam,lparam);
end;

WH_CALLWNDPROCRET フックのフック関数では code が HC_ACTION のときだけメッセージ処理ができる。wparam は、メッセージがこのスレッド内から送られたときは非ゼロ、他のスレッドから送られてきたときはゼロになる。lparam は、以下のようなレコード型へのポインタ PCWPRetStruct である。

  PCWPRetStruct = ^TCWPRetStruct;
   tagCWPRETSTRUCT = packed record
    lResult: LRESULT;              // 処理結果（通常ゼロ）
    lParam: LPARAM;                // lParam
    wParam: WPARAM;                // wParam
    message: UINT;                 // メッセージＩＤ
    hwnd: HWND;                    // 送り先のウィンドウハンドル
  end;
  TCWPRetStruct = tagCWPRETSTRUCT;
  CWPRETSTRUCT = tagCWPRETSTRUCT;

このレコード型の内容から、普通のウィンドウ関数のパラメータと同じ内容を取得できることが分かるだろう。ここでは

  if (Code = HC_ACTION) then begin
    pCWPR := PCWPRetStruct(lParam);
    ProcessMessage(pCWPR^.hwnd,pCWPR^.message,pCWPR^.wParam,pCWPR^.lParam);
  end;

のようにデコードして処理関数 ProcessMessage() に渡している。

procedure ProcessMessage(hWindow:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM);
begin
  case Msg of
    WM_COMMAND:WMCommand(hWindow,wParam,lParam);
    WM_NOTIFY:WMNotify(hWindow,wParam,lParam);
  end;
end;

ここでは、WM_COMMAND と WM_NOTIFY メッセージを捕まえて、それぞれの処理関数にパラメータを転送している。WM_COMMAND と WM_NOTIFY メッセージの wParam と lParam のデコードに仕方については、すでに 第２章 コントロールのメッセージ処理（その１） で説明したのでそちらを参照して頂きたい。筆者としては、個人的にコントロールのメッセージ処理に興味があるので、このローカルフックはメッセージ解析のツールとして頻繁に使っている。（実際は、以下の節のようにコンポーネントにしている）特定のコントロールが送るメッセージだけを解析すると、ヘルプや MSDN の解説を読んだだけでは分かりにくいところが分かってきて、とても気に入っている。まぁ、趣味の領域ですが。

redball.gifこの章の目次へ戻る

７−４ ローカルフックコンポーネント

Notes の フック関数のインスタンス化 では、フック関数をクラスのメソッドにして WH_KEYBOARD のローカルフックコンポーネントを作った。ここでは、いろいろなローカルフックをコンポーネント化するために、まず、そのすべての派生元になるフック関数をインスタンス化するためだけのコンポーネントクラスを作成しよう。個別のローカルフックコンポーネントは、このクラスから派生して簡単に作ることができるだろう。

フック関数のインスタンス化 でダウンロードできる HookInst.pas を使って、フック関数をインスタンス化するだけの抽象クラス THookBase を作る。以下にその全コードを示す。

List 5

unit LocalHook;

interface

uses
  Windows, Messages, SysUtils, Classes, HookInst;

type
THookBase = class(TComponent)
private
  FEnabled:Boolean;
  FHookProc:Pointer;
  procedure SetEnable(const Value: Boolean);
protected
  FHookHandle:HHOOK;
  FHookKind:integer;
  procedure SetHook;
  procedure ResetHook;
  procedure HookProc(var HookCall:THookCall);virtual;abstract;
public
  constructor Create(AOwner: TComponent);override;
  destructor Destroy; override;
published
  property Enabled:Boolean read FEnabled write SetEnable;
end;

implementation

{ THookBase }

constructor THookBase.Create(AOwner: TComponent);
begin
  inherited;
  if not (csDesigning in ComponentState) and FEnabled then SetHook;
end;

destructor THookBase.Destroy;
begin
  ResetHook;
  inherited;
end;

procedure THookBase.ResetHook;
begin
  if FHookHandle = 0 then exit;
  if UnHookWindowsHookEx(FHookHandle) then begin
    FreeHookInstance(FHookProc);
    FHookHandle := 0;
  end;
end;

procedure THookBase.SetEnable(const Value: Boolean);
begin
  if FEnabled <> Value then FEnabled := Value;
  if (csDesigning in ComponentState) then exit;
  if FEnabled then SetHook else ResetHook;
end;

procedure THookBase.SetHook;
begin
  if FHookHandle <> 0 then exit;
  FHookProc := MakeHookInstance(HookProc);
  FHookHandle := SetWindowsHookEx(FHookKind,FHookProc,0,GetCurrentThreadID);
end;

end.

このクラスの Enable プロパティーを true にするだけで FHookKind でその種類を指定できるローカルフックをインストールし、そのフック関数 HookProc をインスタンス化できる。各ローカルフック用のコンポーネントはこのクラスから派生し、コンストラクタの継承メソッドを呼び出す前に FHookKind を設定し、また、HookProc をオーバーライドして実装することにより、インスタンス化されたフック関数を持つようにすることができる。それでは具体的にやってみよう。