フック関数のインスタンス化


redball.gif目次へ戻る

Delphi のクラスのメソッドは、それが呼ばれるとき暗黙のインスタンス参照が渡される、という仕様になっている。たとえば、TButton の OnClick のイベントハンドラの型は TNotifyEvent であるが、以下のように定義されている。

type TNotifyEvent = procedure (Sender: TObject) of object;

この定義宣言の末尾に of object が付いているのが、引数以外にインスタンス参照を渡すことを意味している。一方、ウィンドウ関数や EnumXXXXX などの API で設定するいわゆるコールバック関数はＯＳから直接呼ばれるため、ＯＳがその型を決めている。したがって、コールバック関数はそのままではクラスのメソッドにすることはできない。

ＶＣＬでは、当然ながら、ひとつのプロジェクトで複数の、たとえば TPanel を使用できる、クラスは、本来、そのインスタンスが複数つくられることを前提にしている。TPanel は、そのインスタンスをつくると同時に子ウィンドウとしてのウィンドウを作成する。このとき、そのウィンドウ関数がインスタンス毎に違っていないと Caption や Color などインスタンス毎に違っていることが想定されるプロパティーをインスタンスごとに違ったように反映させることはできない。つまり、ウィンドウをつくるクラスを作成するためには、ウィンドウ関数をクラスのメソッドにしてインスタンス毎に違ったものにする必要がある。この矛盾を解消するために、ＶＣＬでは、MakeObjectInstance() と FreeObjectInstance() という関数を使って、ウィンドウ関数をインスタンス化すること、つまり、クラスのメソッドにすることに成功している。

同様に、是非、インスタンス化したいコールバック関数にフック関数がある。上の参照元に示したように Grahame Marsh 氏は MakeObjectInstance() と FreeObjectInstance() を見習って、同様の手法により、フック関数をインスタンス化することに成功している。ここでは、それを試してみよう。

ここでは、ローカルフックのうちキーボードフックを試してみよう。まず最初は、普通のやりかたでフック関数をインストールしてみよう。Form1 にボタンを２つとラベルを２つ置く。以下に全リストを示す。

List 1

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  Hook: HHOOK;

function KeyHookProc(nCode: Integer; wParam: WPARAM;
                                    lParam: LPARAM): LRESULT; stdcall;
begin
  if nCode < 0 then begin
    result := CallNextHookEx(Hook,nCode,wParam,lParam);
    exit;
  end;

  if (nCode = HC_ACTION) then begin
    Form1.Label1.Caption := IntToStr(wParam);
    if (lParam and $80000000) <> 0 then
      Form1.Label2.Caption := 'Up'
    else
      Form1.Label2.Caption := 'Down';
  end;

  result := CallNextHookEx(Hook,nCode,wParam,lParam);
end;


procedure SetKeyboardHook;
begin
  if Hook <> 0 then exit;
  Hook := SetWindowsHookEx(WH_KEYBOARD,KeyHookProc,0,GetCurrentThreadID);
end;

procedure ResetKeyboardHook;
begin
  if Hook = 0 then exit;
  if UnHookWindowsHookEx(Hook) then Hook := 0;
end;

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

procedure TForm1.Button2Click(Sender: TObject);
begin
  ResetKeyboardHook;
end;

end.
n00601.gif

実行して、Button1 を押すとフック関数がインストールされ、その状態でキーを押すと Label1 にはその仮想キーコードを表示し、また、キーの on/off に応じて Label2 に Down または Up と表示される。右図は F1 キーを押したときのものである。Button2 を押すとフック関数をアンインストールする。


ローカルフック関数は、そのスレッドのメッセージ処理機構に割り込んでメッセージを捕獲するための Windows が用意してくれた仕組みである。したがって、VCL の実装コードとは一切関わりなくインストールできる。VCL の似た機構として、TApplication の OnMessage イベントがある。これは、VCL のメッセージループから呼ばれるイベントであり、したがって、VCL のメッセージループが回っていないときはメッセージを捕獲できない。つまり、TOpenDialog などのコモンダイアログや SelectDirectory や MessageDlg() を実行して表示されるモーダルダイアログの表示中、また、メニューのドロップダウンが表示されているとき、などのキーボードメッセージやマウスメッセージは捕獲できない。モーダルループやメニューループがメッセージループの代わりをしているからである。Form2.ShowModal などのときは大丈夫であるが。また、SendMessage() で送られたメッセージはメッセージキューを通過しないので Application.OnMessage では捕まえられない。ローカルフックでは、適切な種類のフック関数をインストールすると、このような限界はない。

コードを見てみよう。

フック関数は SetKeyboardHook 手続きでインストールされる。

procedure SetKeyboardHook;
begin
  if Hook <> 0 then exit;
  Hook := SetWindowsHookEx(WH_KEYBOARD,KeyHookProc,0,GetCurrentThreadID);
end;

二度重複してインストールしないようフックハンドルがゼロであることを確認して SetWindowsHookEx() を実行している。

function SetWindowsHookEx(idHook: Integer; 
                            lpfn: TFNHookProc; 
                            hmod: HINST; 
                      dwThreadId: DWORD): HHOOK; stdcall;

第一パラメータ idHook には、インストールするフック関数の種類を設定する。以下の定数のうちの一つを選ぶ。

CONST
  WH_MSGFILTER = -1;
  WH_JOURNALRECORD = 0;
  WH_JOURNALPLAYBACK = 1;
  WH_KEYBOARD = 2;
  WH_GETMESSAGE = 3;
  WH_CALLWNDPROC = 4;
  WH_CBT = 5;
  WH_SYSMSGFILTER = 6;
  WH_MOUSE = 7;
  WH_HARDWARE = 8;
  WH_DEBUG = 9;
  WH_SHELL = 10;
  WH_FOREGROUNDIDLE = 11;
  WH_CALLWNDPROCRET = 12;

そのほかに、NT 系ではさらに低レベルなフック関数もつかえる。ここでは、そのすべてを説明できないが、今回は WH_KEYBOARD を設定する。これは、キーボードメッセージのフックである。ローカルフック全般については別稿で調べることにする。

SetWindowsHookEx() の第二パラメータ lpfn にはインストールするフック関数、つまり、メッセージを受け取るコールバック関数を設定する。フック関数の形は以下のように決められている。

function HookProc(nCode: Integer; 
                 wParam: WPARAM;
                 lParam: LPARAM): LRESULT; stdcall;

だいたいどの種類のフックでも同じ形である。関数の名前はなんでもよい。しかし、パラメータと呼び出し規約、返値はこの形でなくてはならない。インストールするフックによってパラメータの解釈の仕方は異なる。SetWindowsHookEx() の第三パラメータ hmod は、インストールするモジュールのハンドルを設定する。ローカルフックではゼロにする。最後の dwThreadId には、ターゲットのスレッドＩＤを設定する。ローカルフックでは、GetCurrentThreadID API を使って、これを呼び出したスレッドＩＤを設定する。SetWindowsHookEx() の戻り値は、HHOOK 型のフックハンドルである。フック関数は、メッセージ処理機構に割り込むのであるが、その割り込みを一つだけに限定することはできない。したがって、ちょうど町内会の回覧板をまわすようにチェーンを作ってそのなかの一つとしてインストールされる。このメッセージの回覧板を回す仕組みを壊さないように、自分が受け取ったメッセージをチェーンの次の関数へ受け渡さなければならない。このとき、自分を識別するためにフックハンドルが必要になる。また、フック関数をアンインストールしてチェーンから抜けるときにも必要になる。このハンドルは、通常、グローバル変数などに格納して記憶しておく。

アンインストールは、

procedure ResetKeyboardHook;
begin
  if Hook = 0 then exit;
  if UnHookWindowsHookEx(Hook) then Hook := 0;
end;

で行っている。 UnHookWindowsHookEx() にはフックハンドルを設定する。フック関数を見てみよう。

function KeyHookProc(nCode: Integer; wParam: WPARAM;
                                    lParam: LPARAM): LRESULT; stdcall;
begin
  if nCode < 0 then begin
    result := CallNextHookEx(Hook,nCode,wParam,lParam);
    exit;
  end;

  if (nCode = HC_ACTION) then begin
    Form1.Label1.Caption := IntToStr(wParam);
    if (lParam and $80000000) <> 0 then
      Form1.Label2.Caption := 'Up'
    else
      Form1.Label2.Caption := 'Down';
  end;

  result := CallNextHookEx(Hook,nCode,wParam,lParam);
end;

WH_KEYBOARD のフックでは、nCode が負の値のときには、処理しない。HC_ACTION = 0; のときに処理することができる。いずれの場合も、CallNextHookEx() を実行して、フックチェーンの次の関数にメッセージを転送する。wParam は、押されたキーの仮想キーコード、lParam には様々なキーに関する情報がセットされている。詳しくは WM_KEYDOWN などのキーメッセージのヘルプを見ると分かる。lParam の最上位ビットが１のときは、WM_KEYUP、ゼロのときは WM_KEYDOWN に相当している。

このフック関数をみると、上述のように TForm1 クラスのメソッドにはできないため、単独の関数となっているにもかかわらず Form1 などの特定のインスタンスを参照するコードを持っていて、非常に気持ち悪い。このような方式では、インスタンスが異なるたびに新たにフック関数をインストールしなければならないだろう。これでは全く不便である。以下に、参照元の関数を使って、フック関数のインスタンス化をしてみよう。

Marsh 氏の作った、フック関数をインスタンス化する二つの関数は独立したユニットファイル HookInst.pas に宣言・実装されている。作者自身のコメント行が先頭に書かれていて、改変・再配布に制限は無いようである。便宜のため以下にリンクしておく。

HOOKINST.lzh

ダウンロードして解凍してできた HookInst.pas をプロジェクトに加えて以下のようにする。

List 2

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    Hook:HHOOK;
    HookProc:Pointer;
    procedure KeyHookProc(var HookCall:THookCall);
    procedure SetKeyboardHook;
    procedure ResetKeyboardHook;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.KeyHookProc(var HookCall:THookCall);
begin
  with HookCall do begin
    if Code < 0 then begin
      result := CallNextHookEx(Hook,Code,wParam,lParam);
      exit;
    end;

    if (Code = HC_ACTION) then begin
      Label1.Caption := IntToStr(wParam);
      if (lParam and $80000000) <> 0 then
        Label2.Caption := 'Up'
      else
        Label2.Caption := 'Down';
    end;

    result := CallNextHookEx(Hook,Code,wParam,lParam);
  end;
end; 

procedure TForm1.SetKeyboardHook;
begin
  if Hook <> 0 then exit;
  HookProc := MakeHookInstance(KeyHookProc);
  Hook := SetWindowsHookEx(WH_KEYBOARD,HookProc,0,GetCurrentThreadID);
end;

procedure TForm1.ResetKeyboardHook;
begin
  if Hook = 0 then exit;
  if UnHookWindowsHookEx(Hook) then begin
    FreeHookInstance(HookProc);
    Hook := 0;
  end;
end;

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

procedure TForm1.Button2Click(Sender: TObject);
begin
  ResetKeyboardHook;
end;

end.

動作は前と同じである。しかし、フック関数は TForm1 のメソッドになっている。インストールは以下のようにする。

procedure TForm1.SetKeyboardHook;
begin
  if Hook <> 0 then exit;
  HookProc := MakeHookInstance(KeyHookProc);

  Hook := SetWindowsHookEx(WH_KEYBOARD,HookProc,0,GetCurrentThreadID);
end;

メソッドにするフック関数の型は、HookInst.pas に定義されている。

type THookMethod = procedure (var HookCall: THookCall) of object;

このように of object が付いていてクラスのメソッドにできる。引数のレコード型は以下のようになっている。

type
  THookCall = packed record
    Code   : integer;
    WParam : WPARAM;
    LParam : LPARAM;
    Result : LResult
  end;

これは、もともとのフック関数の引数をレコード型にしているだけだ。メソッドにしたいフック関数のをパラメータとして MakeHookInstance() を実行すると関数ポインタが返ってくる。それをフック関数として SetWindowsHookEx() を実行することにより、インストールされる。アンインストールは以下のようにする。

procedure TForm1.ResetKeyboardHook;
begin
  if Hook = 0 then exit;
  if UnHookWindowsHookEx(Hook) then begin
    FreeHookInstance(HookProc);
    Hook := 0;
  end;
end;

UnHookWindowsHookEx() を実行してから、フック関数ポインタを FreeHookInstance() で解放している。フックメソッドでは、渡される THookCall 型のレコードの各フィールドを使って前回と全く同じことをしている。

以上のように、単独の関数ではなくクラスのメソッドとしてフック関数をインストールすることができた。

せっかくなので、これをコンポーネントにしてみよう。以下にそのユニットファイルを示す。

List 3

unit KeyHookUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, HookInst;

type
TNotifyKeyHook = procedure (virtualkey:Cardinal) of object;

TKeyHook = class(TComponent)
private
  FHookHandle:HHOOK;
  FHookProc:Pointer;
  FEnabled:Boolean;
  FCtrl:Boolean;
  FShift:Boolean;
  FAlt:Boolean;
  FOnkeyDown:TNotifyKeyHook;
  FOnKeyUp:TNotifyKeyHook;
  procedure SetEnable(const Value: Boolean);
protected
  function IsKeyDown(lParam:LPARAM):Boolean;
  procedure KeyDown(HookCall:THookCall);virtual;
  procedure KeyUp(HookCall:THookCall);virtual;
  procedure SetHook;
  procedure ResetHook;
  procedure KeyHookProc(var HookCall:THookCall);
public
  constructor Create(AOwner: TComponent);override;
  destructor Destroy; override;
  property CtrlPressed:Boolean read FCtrl;
  property ShiftPressed:Boolean read FShift;
  property AltPressed:Boolean read FAlt;
published
  property Enabled:Boolean read FEnabled write SetEnable;
  property OnKeyDown:TNotifyKeyHook read FOnKeyDown write FOnKeyDown;
  property OnKeyUp:TNotifyKeyHook read FOnKeyUp write FOnKeyUp;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples',[TKeyHook]);
end;

{ TKeyHook }

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

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

function TKeyHook.IsKeyDown(lParam: LPARAM): Boolean;
begin
  result := (lParam and $80000000) = 0;
end;

procedure TKeyHook.KeyDown(HookCall: THookCall);
begin
  if Assigned(FOnKeyDown) then FOnKeyDown(HookCall.WParam);
end;

procedure TKeyHook.KeyHookProc(var HookCall: THookCall);
begin
  with HookCall do begin
    if Code < 0 then begin
      result := CallNextHookEx(FHookHandle,Code,wParam,lParam);
      exit;
    end;

    if (Code = HC_ACTION) then begin
      case wParam of
        VK_SHIFT:   FShift := IsKeyDown(lParam);
        VK_CONTROL: FCtrl  := IsKeyDown(lParam);
        VK_MENU:    FAlt   := IsKeyDown(lParam);
      end;
      if IsKeyDown(lParam) then
        KeyDown(HookCall)
      else
        KeyUp(HookCall);
    end;

    result := CallNextHookEx(FHookHandle,Code,wParam,lParam);
  end;
end;

procedure TKeyHook.KeyUp(HookCall: THookCall);
begin
  if Assigned(FOnKeyUp) then FOnKeyUp(HookCall.WParam);
end;

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

procedure TKeyHook.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 TKeyHook.SetHook;
begin
  if FHookHandle <> 0 then exit;
  FHookProc := MakeHookInstance(KeyHookProc);
  FHookHandle := SetWindowsHookEx(WH_KEYBOARD,FHookProc,0,GetCurrentThreadID);
end;

end.
n00602.gif

この KeyHookUnit.pas と HookInst.pas をパスの通ったところにおいて、IDE にインストールすると [Sample] パレットに TKeyHook という非ビジュアルコンポーネントができる。これを使ってみよう。

右図のように、KeyHoo1 と KeyHoo2 を Form1 に置いて以下のようにする。


List 4

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    KeyHook1: TKeyHook;
    KeyHook2: TKeyHook;
    procedure KeyHook1KeyDown(virtualkey: Cardinal);
    procedure KeyHook1KeyUp(virtualkey: Cardinal);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure KeyHook2KeyDown(virtualkey: Cardinal);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.KeyHook1KeyDown(virtualkey: Cardinal);
begin
  if (virtualkey = VK_F1) and KeyHook1.ShiftPressed then
    Color := clYellow;
end;

procedure TForm1.KeyHook1KeyUp(virtualkey: Cardinal);
begin
  if (virtualkey = VK_F2) and KeyHook1.CtrlPressed then
    Color := clAqua;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  KeyHook1.Enabled := true;
  //KeyHook2.Enabled := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  KeyHook1.Enabled := false;
  //KeyHook2.Enabled := false;
end;

procedure TForm1.KeyHook2KeyDown(virtualkey: Cardinal);
begin
  if (virtualkey = VK_F3) then Color := clBtnFace;
end;

end.
n00603.gif

ここでは、オブジェクトインスペクタで Enabled を false （デフォルト）のままにしておき、Button1 と Button2 を押して On/Off している。実行時の様子を右図にしめす。コードを見ると分かるように、SHIFT + F1 キーを押すとフォームは黄色になる。CTRL + F2 ではキーを押して離すときにフォームの色が水色になる。それ以外のキー操作では何も起こらない。コメントアウトしているところを戻すと、F3 キーを押すとフォームの色がデフォルト色になる。このように複数の TKeyHook のインスタンスは独立して動作する。このコンポーネントは、モーダルループやメニューループの動作中でもメッセージを捕まえられる。ＶＣＬとは独立した機構により、アプリケーション独自のホットキーのような動作を実現できる。


redball.gif目次へ戻る