Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2007年09月23日] [更新 2015年03月11日]　Delphi サンプルプログラム集
   
290_グローバルフック WH_GETMESSAGE
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
290_HookGetMessage.zip　[1,216 KB]　2015年03月11日版 (EXE 同梱)



  • 2007年10月29日
  • コードをコピペして使用した場合に発生する [リストのインデックスが範囲を超えています] に対する修正
  • 2009年02月28日
  • [メッセージを選択してテスト] を追加
  • 2009年07月27日
  • 他のフックのサンプルと重複しないように MapFileName を変更
  • コールバックの戻り値 (Result) を CallNextHookEx にした
  • 2015年03月11日
  • WM_USER を WM_APP に変更
  • Windows 7 + Delphi XE で動作可能なコードに修正
  • UIPI (ユーザーインターフェイス特権の分離) 対応コードを追加
  • コード整備



01_グローバルフック WH_GETMESSAGE


Halbow 資料館の [メッセージを盗む: サブクラス化とフック関数] と [メッセージを捕まえる: ローカルフック] に解説がありますが，これらはローカルフックの例です．
本ページのサンプルは，フック関数 WH_GETMESSAGE を DLL 内に置き，グローバルフックとして使用する例です．


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



  SetWindowsHookEx(WH_GETMESSAGE, @MyHookProc, 0, GetCurrentThreadID);


図1
実行画面
  • WM_LBUTTONDOWN メッセージを表示

リスト1
グローバルフック WH_GETMESSAGE のテスト 
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListView1: TListView;
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 protected
   procedure DisplayWindowInfo(ClassName, TitleStr: String);
   function GetWindowTitleStr(hWindow: HWND): String;
   function GetWindowClassNameStr(hWindow: HWND):string;
 private
   { Private declarations }
    hHookLib  : THANDLE;
    procedure WMAPPMessage(var Msg: TMessage); message WM_APP+100;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

  // DLL内の呼出関数類
  function StartGetMessageHook(Wnd: HWND): Boolean; stdcall;
    external 'PLHOOKGETMESSAGE.DLL';
  procedure StopGetMessageHook; stdcall; external 'PLHOOKGETMESSAGE.DLL';


//=============================================================================
//  フォーム生成時の処理
//  UIPI対応処理(管理者権限で実行してもフックを可能にする)
//  クラス名とタイトルを一覧表示するためのListViewの設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
const
  MSGFLT_ADD    = 1;
  MSGFLT_REMOVE = 2;
var
  DLLHandle  : THandle;
  FuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
  LStyle     : LongInt;
begin
  //UIPI(ユーザーインターフェイス特権の分離)対応処理
  //このプログラムを管理者権限で実行してもメッセージの受信を可能にする
  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);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  Caption := 'WH_GETMESSAGE テスト';

  ListView1.ViewStyle := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' CLASS';
  ListView1.Columns[0].Width   := 130;
  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := ' TITLE';
  ListView1.Columns[1].Width   := 151;

  //垂直スクロールバーを最初から表示
  LStyle := GetWindowLong(ListView1.Handle, GWL_STYLE);
  ShowScrollBar(ListView1.Handle,SB_VERT, True);
  SetWindowLong(ListView1.Handle,GWL_STYLE, LStyle);
end;

//=============================================================================
//  本Form破棄の時にはフックを解除
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hHookLib <> 0 then begin
    StopGetMessageHook;
    FreeLibrary(hHookLib);
    hHookLib := 0;
  end;
end;

//=============================================================================
//  フックを有効にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if hHookLib = 0 then begin
    hHookLib := LoadLibrary('PLHOOKGETMESSAGE.DLL');
    StartGetMessageHook(Self.Handle);
  end;
end;

//=============================================================================
//  フックを無効にする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  FormDestroy(nil);
end;

//-----------------------------------------------------------------------------
//  DLLでPostしたメッセージ通知を受取る
//
//  DLL側で以下の値をセットしている
//  Msg.wParam メッセージ識別子
//  Msg.lParam メッセージを受取るウィンドウのハンドル値
//-----------------------------------------------------------------------------
procedure TForm1.WMAPPMessage(var Msg: TMessage);
var
  LTargetWnd : HWND;
  LClass     : String;
  LTitle     : String;
begin
 if Msg.Msg = WM_APP + 100 then begin
   //ここのWM_XXXXの(メッセージ識別子)を変更すれば
   //WH_GETMESSAGEフックがどんなメッセージを捕捉可能かを確認可能
   if Msg.WParam = WM_LBUTTONDOWN then begin
     LTargetWnd := Msg.LParam;
     LClass     := GetWindowClassNameStr(LTargetWnd);
     LTitle     := GetWindowTitleStr(LTargetWnd);
     DisplayWindowInfo(LClass, LTitle);
   end;
 end;
end;

//-----------------------------------------------------------------------------
//  ListViewにCreateしたウィンドウのクラス名とタイトルを表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayWindowInfo(ClassName, TitleStr: String);
var
  LItem : TListItem;
begin
  LItem := ListView1.Items.Add;
  LItem.Caption := ClassName;
  LItem.SubItems.Add(TitleStr);

  //ListViewの一番最後を表示
  //ここでは実際にはMakeVisibleだけでOK
  ListView1.Items[ListView1.Items.Count - 1].Selected := True;
  ListView1.Items[ListView1.Items.Count - 1].Focused  := True;
  ListView1.Items[ListView1.Items.Count - 1].MakeVisible(True);
end;

//-----------------------------------------------------------------------------
//  ウィンドウハンドルからウィンドウのクラス名を取得
//-----------------------------------------------------------------------------
function TForm1.GetWindowClassNameStr(hWindow: HWND): string;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  ウィンドウハンドルからウィンドウのタイトルを取得
//-----------------------------------------------------------------------------
function TForm1.GetWindowTitleStr(hWindow: HWND): String;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetWindowText(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

end.


リスト2
サンプルプログラムで使用している DLL のプロジェクトソース 
library plHookGetMessage;

uses
  plHookGetMessageUnit in 'plHookGetMessageUnit.pas';

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


リスト3
サンプルプログラムで使用している DLL のコード 
unit plHookGetMessageUnit;

interface

uses
  Windows, Messages;

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

implementation

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

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

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

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

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

//-----------------------------------------------------------------------------
//  フックのコールバック関数
//  このDLLを使用したアプリにメッセージを送る
//  検出するメッセージは呼出プログラムからフック開始時に引数で指定
//
//  nCoe    フックコード
//  wParam  PM_REMOVE   この関数通過後メッセージキューからメッセージが削除される
//          PM_NOREMOVE PeekMessageで覗かれているだけでキューから削除されない
//  lParma  メッセージに関する情報を格納したTMsg構造体のポインタ
//
//  TMsg = packed record
//    hwd     : HWND   メッセージを受取るウィンドウのハンドル
//    message : UNIT   メッセージ識別子
//    wParam  : WPARAM メッセージ固有の32ビット値
//    lParam  : LPARAM メッセージ固有の32ビット値
//    time    : DWORD  メッセージがボストされた時刻
//    pt      : TPoint マウスカーソルの位置
//
//  GetMesageまたはPeekMessage関数が呼出される前にこのフック関数を通過する
//  このフック関数内でメッセージのパラメータを変更すると，変更したパラメータが
//  目的のウィンドウに渡される
//-----------------------------------------------------------------------------
function MyHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LWnd       : THandle;
  LpMap      : Pointer;
  LpMsg      : PMsg;
  LTargetWnd : HWND;
  LPostMsg   : Integer;
begin
  Result := 0;
  if MapFileMemory(LWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      if wPar = PM_REMOVE then begin
        LpMsg      := PMsg(lPar);
        LTargetWnd := LpMsg^.hwnd;
        LPostMsg   := LpMsg^.message;

        if LTargetWnd <> pHookInfo(LpMap)^.HostWnd then begin
          PostMessage(pHookInfo(LpMap)^.HostWnd,
                      WM_APP + 100,
                      LPostMsg,
                      LTargetWnd);
        end;
      end;
    end;
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フック関数の登録
//  登録するフック関数はMyHookProc
//-----------------------------------------------------------------------------
function StartGetMessageHook(HostWnd: HWND): Boolean; stdcall;
var
  LMapWnd : THandle;
  LpMap   : Pointer;
begin
  Result := False;

  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
  end else begin
    //フック情報構造体初期化とフック関数の登録
    pHookInfo(LpMap)^.HostWnd := HostWnd;

    //フックをインストール
    //ローカルフックの場合は3番目の引数は0(null)でOK
    //グローバルの場合はDLLのインスタンス
    //4番目はフック対象のスレッドID(システム全体の時は0)
    pHookInfo(LpMap)^.HookHandle := SetWindowsHookEx(WH_GETMESSAGE,
                                                     @MyHookProc,
                                                     hInstance,
                                                     0);
    //フック成功
    if pHookInfo(LpMap)^.HookHandle > 0 then begin
      Result := True;
    end;
    //メモリマップドファイル使用終了処理
    UnMapFileMemory(LMapWnd, LpMap);
  end;
end;

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopGetMessageHook; stdcall;
var
  LMapWnd : THandle;
  LpMap   : Pointer;
begin
  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
  end else begin
    //フック解除
    if pHookInfo(LpMap)^.HookHandle > 0 then begin
      UnhookWindowsHookEx(pHookInfo(LpMap)^.HookHandle);
    end;
    //メモリマップドファイル使用終了処理
    UnMapFileMemory(LMapWnd, LpMap);
  end;
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.



02_メッセージを選択してテスト


[300_グローバルフック WH_CALLWNDPROC] と [310_グローバルフック WH_CALLWNDPROCRET] ではメッセージセージを選択してテストするサンプルを提供しているので，こちらも作成してみました．
フック対象メッセージをコンボボックスから選択するようにしています．別のメッセージを選択するとフックを中止しますので，再度フック開始ボタンをクリックします．
コンボボックスには Delphi 7 当時で扱える 227 の WM_XXXX メッセージリストをリソースから読み出してセットしていますが，WH_GETMESSAGE でこれらの全てがフックできるわけではありません．

図ではマウスボタンの操作をフックしていますが，ボタンの位置は表示されていません．マウスの位置情報は lParam に格納されています．このサンプルコードでは wParam の値しか DLL から取得していないので表示できません．
これらの値を操作する等，DLL を使用する実際のアプリケーションではそのアプリごとに，ある程度 DLL 内で処理する必要もあるでしょう．本サイトのサンプルプログラム集は，あくまでも動作確認のテストプログラムです．


図2
設計時画面
図3
実行開始
  • メッセージを選択して
  • [Start Hook] をクリック
図4
フック中
  • 起動中のワードでマウス操作
  • タスクバーから起動中のエクセルを選択
  • エクセルでマウス操作

リスト4
メインプログラムのコード 
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
    Panel1: TPanel;
    btnClear: TSpeedButton;
    btnStart: TButton;
    btnStop: TButton;
    ComboBox1: TComboBox;
    Panel2: TPanel;
    ListView1: TListView;
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1CloseUp(Sender: TObject);
 protected
   procedure DisplayWindowInfo(AClass, ATitle: String; wParam: Cardinal);
   function GetWindowTitleStr(hWindow: HWND): String;
   function GetWindowClassNameStr(hWindow: HWND):string;
 private
   { Private declarations }
    hHookLib  : THANDLE;
    procedure WMAPPMessage(var Msg: TMessage); message WM_APP+100;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

  // DLL内の呼出関数類
  function StartGetMessageHook(Wnd: HWND; AMsg: Integer): Boolean; stdcall;
    external 'PLHOOKGETMESSAGEMSG.DLL';
  procedure StopGetMessageHook; stdcall; external 'PLHOOKGETMESSAGEMSG.DLL';


//=============================================================================
//  フォーム作成時の処理
//
//  リソースからWM_XXXのリストを取出してコンポボックスにセット
//  ウィンドウメッセージリストのリソースファイルはMessageList.txt
//  セットするのはWM_XXXの文字列とその整数値
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
const
  MSGFLT_ADD    = 1;
  MSGFLT_REMOVE = 2;
var
  DLLHandle  : THandle;
  FuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
  LResource  : TResourceStream;
  LList      : TStringList;
  i          : Integer;
  LText1     : String;
  LText2     : String;
  LPos       : Integer;
  LStyle     : Integer;
begin
  //UIPI(ユーザーインターフェイス特権の分離)対応処理
  //このプログラムを管理者権限で実行してもメッセージの受信を可能にする
  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);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  LResource := TResourceStream.Create(hInstance, 'MessageList', 'TEXT');
  LList := TStringList.Create;
  ComboBox1.Items.Clear;
  try
    LList.LoadFromStream(LResource);
    for i := 0 to LList.Count - 1 do begin
      LPos := Pos('=', LList[i]);
      LText1 := Trim(Copy(LList[i], 1, LPos - 1));
      LText2 := Trim(Copy(LList[i], LPos + 1, Length(LList[i])));
      ComboBox1.Items.AddObject(LText1, TObject(StrToInt(LText2)));
    end;
  finally
    FreeAndNil(LResource);
    FreeAndNil(LList);
  end;

  //垂直スクロールバーを最初から表示
  LStyle := GetWindowLong(ListView1.Handle, GWL_STYLE);
  ShowScrollBar(ListView1.Handle, SB_VERT, True);
  SetWindowLong(ListView1.Handle, GWL_STYLE, LStyle);
end;

//=============================================================================
//  本Form破棄の時にはフックを解除
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hHookLib <> 0 then begin
    btnStart.Enabled := True;
    btnStop.Enabled  := False;

    StopGetMessageHook;
    FreeLibrary(hHookLib);
    hHookLib := 0;
  end;
end;

//=============================================================================
//  フックを有効にする
//=============================================================================
procedure TForm1.btnStartClick(Sender: TObject);
var
  LIndex  : Integer;
  LRevMsg : Integer;
begin
  LRevMsg := 0;

  LIndex := ComboBox1.ItemIndex;

  if (LIndex = -1) then begin
    if (Trim(ComboBox1.Text) <> '') then begin
      LRevMsg := StrToInt(Trim(ComboBox1.Text));
    end;
  end else begin
    LRevMsg := Integer(ComboBox1.Items.Objects[LIndex]);
  end;

  if LRevMsg > 0 then begin
    if hHookLib = 0 then begin
      hHookLib := LoadLibrary('PLHOOKGETMESSAGEMSG.DLL');
      StartGetMessageHook(Self.Handle, LRevMsg);

      btnStart.Enabled := False;
      btnStop.Enabled  := True;
    end;
  end;
end;

//=============================================================================
//  フックを無効にする
//=============================================================================
procedure TForm1.btnStopClick(Sender: TObject);
begin
  FormDestroy(nil);
end;

//=============================================================================
//  ListViewのアイテムをクリア
//=============================================================================
procedure TForm1.btnClearClick(Sender: TObject);
begin
  ListView1.Items.Clear;
  ListView1.Update;
end;

//=============================================================================
//  コンボボックスでフック対象メッセージを変更したら一度フックを止める
//=============================================================================
procedure TForm1.ComboBox1CloseUp(Sender: TObject);
begin
  btnStopClick(nil);
end;

//-----------------------------------------------------------------------------
//  DLL側がPostしたメッセージ通知を受取る
//
//  DLL側はPostMessageで以下の値を送っている
//  指定したメッセージを発生したウィンドウのハンドル
//  各メッセージに対応したwParamの値
//-----------------------------------------------------------------------------
procedure TForm1.WMAPPMessage(var Msg: TMessage);
var
  LTargetWnd : HWND;
  LClass     : String;
  LTitle     : String;
  LwParam    : Cardinal;
begin
  if Msg.Msg = WM_APP + 100 then begin
    LTargetWnd := Msg.wParam;
    LClass     := GetWindowClassNameStr(LTargetWnd);
    LTitle     := GetWindowTitleStr(LTargetWnd);
    LwParam    := Msg.LParam;
    DisplayWindowInfo(LClass, LTitle, LwParam);
  end;
end;

//-----------------------------------------------------------------------------
//  ListViewにフックしたウインドウのクラス名とタイトル，wParam値を表示
//  wParam値は，下位ワードと上位ワード値に分けて16進数で表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayWindowInfo(AClass, ATitle: String; wParam: Cardinal);
var
  LItem : TListItem;
  LLow  : WORD;
  LHi   : WORD;
begin
  LLow := LOWORD(wParam);
  LHi  := HIWORD(wParam);

  LItem := ListView1.Items.Add;
  LItem.Caption := AClass;
  LItem.SubItems.Add (ATitle);
  LItem.SubItems.Add (Format('$%.4x ', [LHi]));
  LItem.SubItems.Add (Format('$%.4x ', [LLow]));

  //ListViewの一番最後を表示
  //ここでは実際にはMakeVisibleだけでOK
  ListView1.Items[ListView1.Items.Count - 1].Selected := True;
  ListView1.Items[ListView1.Items.Count - 1].Focused  := True;
  ListView1.Items[ListView1.Items.Count - 1].MakeVisible(True);
end;

//-----------------------------------------------------------------------------
//  ウィンドウハンドルからウィンドウのクラス名を取得
//-----------------------------------------------------------------------------
function TForm1.GetWindowClassNameStr(hWindow: HWND): string;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  ウィンドウハンドルからウィンドウのタイトルを取得
//-----------------------------------------------------------------------------
function TForm1.GetWindowTitleStr(hWindow: HWND): String;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetWindowText(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

end.


リスト5
ほとんど同じパターンの DLL のソースコード 
unit plHookGetMessageMsgUnit;

interface

uses
  Windows, Messages;

  //外部のアプリケーションから使用する関数類
  function StartGetMessageHook(HostWnd: HWND; AMsg: Integer): Boolean; stdcall;
  procedure StopGetMessageHook; stdcall;

implementation

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

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

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

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

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

//-----------------------------------------------------------------------------
//  フックのコールバック関数
//  このDLLを使用したアプリにメッセージを送る
//  検出するメッセージは呼出プログラムからフック開始時に引数で指定
//
//  nCoe    フックコード
//  wParam  PM_REMOVE   この関数通過後メッセージキューからメッセージが削除される
//          PM_NOREMOVE PeekMessageで覗かれているだけでキューから削除されない
//  lParma  メッセージに関する情報を格納したTMsg構造体のポインタ
//
//  TMsg = packed record
//    hwd     : HWND   メッセージを受取るウィンドウのハンドル
//    message : UNIT   メッセージ識別子
//    wParam  : WPARAM メッセージ固有の32ビット値
//    lParam  : LPARAM メッセージ固有の32ビット値
//    time    : DWORD  メッセージがボストされた時刻
//    pt      : TPoint マウスカーソルの位置
//
//  GetMesageまたはPeekMessage関数が呼出される前にこのフック関数を通過する
//  このフック関数内でメッセージのパラメータを変更すると，変更したパラメータが
//  目的のウィンドウに渡される
//-----------------------------------------------------------------------------
function MyHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LWnd       : THandle;
  LpMap      : Pointer;
  LpMsg      : PMsg;
  LTargetWnd : HWND;
  LPostMsg   : Integer;
begin
  Result := 0;
  if MapFileMemory(LWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      if wPar = PM_REMOVE then begin
        LpMsg      := PMsg(lPar);
        LTargetWnd := LpMsg^.hwnd;
        LPostMsg   := LpMsg^.message;

        //LPostMsgがStartGetMessageHookの引数の値に等しい時だけ送信
        if LPostMsg = pHookInfo(LpMap)^.RevMessage then begin
          PostMessage(pHookInfo(LpMap)^.HostWnd, 
                      WM_APP + 100,
                      LTargetWnd,
                      LpMsg.wParam);
        end;
      end;
    end;
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フック関数の登録
//  登録するフック関数はMyHookProc
//  AMsgはこのDLLの関数を外部から使用する時に指定するメッセージ(WM_XXXX)
//-----------------------------------------------------------------------------
function StartGetMessageHook(HostWnd: HWND; AMsg: Integer): Boolean; stdcall;
var
  LMapWnd : THandle;
  LpMap   : Pointer;
begin
  Result := False;

  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
  end else begin
    //フック情報構造体初期化とフック関数の登録
    pHookInfo(LpMap)^.HostWnd    := HostWnd;
    pHookInfo(LpMap)^.RevMessage := AMsg;

    //フックをインストール
    //ローカルフックの場合は3番目の引数は0(null)でOK
    //グローバルの場合はDLLのインスタンス
    //4番目はフック対象のスレッドID(システム全体の時は0)
    pHookInfo(LpMap)^.HookHandle := SetWindowsHookEx(WH_GETMESSAGE,
                                                     @MyHookProc,
                                                     hInstance,
                                                     0);
    //フック成功
    if pHookInfo(LpMap)^.HookHandle > 0 then begin
      Result := True;
    end;
    //メモリマップドファイル使用終了処理
    UnMapFileMemory(LMapWnd, LpMap);
  end;
end;

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopGetMessageHook; stdcall;
var
  LMapWnd : THandle;
  LpMap   : Pointer;
begin
  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
  end else begin
    //フック解除
    if pHookInfo(LpMap)^.HookHandle > 0 then begin
      UnhookWindowsHookEx(pHookInfo(LpMap)^.HookHandle);
    end;
    //メモリマップドファイル使用終了処理
    UnMapFileMemory(LMapWnd, LpMap);
  end;
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.