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



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



01_グローバルフック WH_CALLWNDPROC


WH_CALLWNDPROC フック関数のコールバック関数は，SendMessage によって呼出され，このフック関数を通過してから目的のウィンドウに送られます．受取ったメッセージの変更はできません．
本サンプルは，このフック関数を DLL 内に置くことによりグローバルフックとしています．


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



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


図1
実行画面
  • WM_ACTIVATE メッセージ結果を表示

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

interface

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

type
 TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    SpeedButton1: TSpeedButton;
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpeedButton1Click(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+200;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

  // DLL内の呼出関数類
  function StartCallWndProcHook(Wnd: HWND): Boolean; stdcall;
    external 'PLHOOKCALLWNDPROC.DLL';
  procedure StopCallWndProcHook; stdcall; external 'PLHOOKCALLWNDPROC.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+200, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  Caption := 'WH_CALLWNDPROC テスト';

  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   := 161;

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

//=============================================================================
//  フォーム破棄時の処理
//  フックを解除
//  DLLの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hHookLib <> 0 then begin
    StopCallWndProcHook;
    FreeLibrary(hHookLib);
    hHookLib := 0;
  end;
end;

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

//=============================================================================
//  フックを無効にする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  //フォームを破棄する時と同じ処理を実行
  //このようにイベント用のメソッドを実行してもイベントとしては機能しない
  FormDestroy(nil);
end;

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

//-----------------------------------------------------------------------------
//  DLLでPostMessageで送ってきたメッセージを受取る
//
//  DLL側で以下の値をセットしている
//  Msg.wParam メッセージ識別子
//  Msg.lParam メッセージを受取るウィンドウのハンドル値
//-----------------------------------------------------------------------------
procedure TForm1.WMAPPMessage(var Msg: TMessage);
var
  LTargetWnd : HWND;
  LClass     : String;
  LTitle     : String;
begin
  if Msg.Msg = WM_APP + 200 then begin
    //ここのWM_XXXXの(メッセージ識別子)を変更してテストすれば
    //WH_CALLWNDPROCフックがどんなメッセージを捕捉可能かを確認可能
    if Msg.WParam = WM_ACTIVATE 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 plHookCallWndProc;

uses
  plHookCallWndProcUnit in 'plHookCallWndProcUnit.pas';

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


リスト3
DLL 本体のコードドは，グローバルフックのサンプルでほとんど同じ
違うのはコールバック関数の部分と，フック開始関数の引数等が違う場合がある		 
unit plHookCallWndProcUnit;

interface

uses
  Windows, Messages;

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

implementation

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

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

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

//-----------------------------------------------------------------------------
//  共有メモリアクセスのための準備
//
//  成功すると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を使用したアプリにメッセージを送る
//
//  nCode フックコード
//  wPar  カレントプロセスからのメッセージの場合0以外の値
//        別のプロセスからのメッセージの場合は0
//  lPar  メッセージ情報が格納されているTCWPStruct構造体のポインタ．
//        型をそのポインタ型のPCWPStructとしてもいいが，ここではIntegerのままと
//        し，構造体から値を取得する時に変数LStructにそのポインタを代入
//
//  メッセージがSendMessage関数によって送られる前にこのフック関数を通過する
//  PostMessageで呼出元に送るのはメッセージの識別子とウィンドウハンドル
//  フック関数のLPARAM等をそのまま送ってもよいが，メッセージ識別子とハンドルが
//  取得できれば通常の用途では十分と考えた
//-----------------------------------------------------------------------------
function MyHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LpMap      : Pointer;
  LWnd       : THANDLE;
  LTargetWnd : HWND;
  LpStruct   : PCWPStruct;
  LMsg       : 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
      LpStruct    := PCWPStruct(lPar);
      LMsg        := LpStruct^.message;
      LTargetWnd  := LpStruct^.hwnd;

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

  UnMapFileMemory(LWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フック関数の登録
//  登録するフック関数はMyHookProc
//-----------------------------------------------------------------------------
function StartCallWndProcHook(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_CALLWNDPROC,
                                                     @MyHookProc,
                                                     hInstance,
                                                     0);
    //フック成功
    if pHookInfo(LpMap)^.HookHandle > 0 then begin
      Result := True;
    end;
    //メモリマップドファイル使用終了処理
    UnMapFileMemory(LMapWnd, LpMap);
  end;
end;

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopCallWndProcHook; 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_メッセージを選択してテスト


他のプログラムのテストのために作成したものです．WH_CALLWNDPROC フック関数のフック対象メッセージをコンボボックスから選択するようにしています．別のメッセージを選択するとフックを中止しますので，再度フック開始ボタンをクリックします．
コンボボックスには Delphi 7 当時で扱える 227 の WM_XXXX メッセージリストをリソースから読み出してセットしていますが，WH_CALLWNDPROC でこれらの全てがフックできるわけではありません．マウスやキーボートの操作はフックできません．



図2
実行画面

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

interface

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

type
 THookWinProcForm = class(TForm)
    Panel1: TPanel;
    btnStart: TButton;
    btnStop: TButton;
    btnClear: TSpeedButton;
    Panel2: TPanel;
    ComboBox1: TComboBox;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure ComboBox1CloseUp(Sender: TObject);
 protected
   procedure DisplayMessageInfo(AClass, ATitle: String; AwParam: Cardinal);
   function GetWindowTitleStr(hWindow: HWND): String;
   function GetWindowClassNameStr(hWindow: HWND): String;
 private
    hDllHandle : THANDLE;
    procedure WMAPPMessage(var Msg: TMessage); message WM_APP+200;
 public
 end;

var
 HookWinProcForm: THookWinProcForm;

implementation

{$R *.DFM}

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


//=============================================================================
//  フォーム生成時の処理
//  リソースからWM_XXXのリストを取出してコンポボックスにセット
//  ウィンドウメッセージリストのリソースファイルはMessageList.txt
//  セットするのはWM_XXXの文字列とその整数値
//=============================================================================
procedure THookWinProcForm.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 + 200, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  Caption := 'WH_CALLWNDPROC テスト';

  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;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure THookWinProcForm.FormDestroy(Sender: TObject);
begin
  if hDllHandle <> 0 then begin
    btnStart.Enabled := True;
    btnStop.Enabled  := False;

    StopWndProcHook;
    FreeLibrary(hDllHandle);
    hDllHandle := 0;
  end;
end;

//=============================================================================
//  フックを有効にする
//  フック開始関数引数は，このフォームのハンドルと，フック対象メッセージの値
//=============================================================================
procedure THookWinProcForm.btnStartClick(Sender: TObject);
var
  LIndex  : Integer;
  LRevMsg : Integer;
begin
  if ComboBox1.ItemIndex < 0 then exit;

  if hDllHandle = 0 then begin
    LIndex   := ComboBox1.ItemIndex;
    LRevMsg  := Integer(ComboBox1.Items.Objects[LIndex]);
    hDllHandle := LoadLibrary('PLHOOKWNDPROCMSG.DLL');

    StartWndProcHook(Handle, LRevMsg);

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

//=============================================================================
//  フックを無効にする
//=============================================================================
procedure THookWinProcForm.btnStopClick(Sender: TObject);
begin
  //フォームを破棄する時と同じ処理を実行
  //このようにイベント用のメソッドを実行してもイベントとしては機能しない
  FormDestroy(nil);
end;

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

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

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

  LAItem := ListView1.Items.Add;
  LAItem.Caption := AClass;
  LAItem.SubItems.Add (ATitle);
  LAItem.SubItems.Add (Format('$%.4x ', [LHi]));
  LAItem.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;

//-----------------------------------------------------------------------------
//  DLLからのメッセージを受け取る
//
//  DLL側で以下の値をセットしている
//  Msg.wParam メッセージを受取るウィンドウのハンドル値
//  Msg.lParam メッセージ固有の値(wParam値)
//-----------------------------------------------------------------------------
procedure THookWinProcForm.WMAPPMessage(var Msg: TMessage);
var
  LTargetWnd : HWND;
  LClass     : String;
  LTitle     : String;
  LwParam    : Cardinal;
begin
  if Msg.Msg = WM_APP + 200 then begin
    LTargetWnd := Msg.wParam;
    LClass     := GetWindowClassNameStr(LTargetWnd);
    LTitle     := GetWindowTitleStr(LTargetWnd);
    LwParam    := Msg.LParam;
    DisplayMessageInfo(LClass, LTitle, LwParam);
  end;
end;

//-----------------------------------------------------------------------------
//  ウィンドウハンドルからウィンドウのクラス名を取得
//-----------------------------------------------------------------------------
function THookWinProcForm.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 THookWinProcForm.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 のプロジェクトファイル 
library plHookWndProcMsg;

uses
  plHookWndProcMsgUnit in 'plHookWndProcMsgUnit.pas';

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


リスト6
DLL 本体のコードドは，グローバルフックのサンプルでほとんど同じ
違うのはコールバック関数の部分と，フック開始関数の引数等が違う場合がある		 
unit plHookWndProcMsgUnit;

interface

uses
  Windows, Messages;

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

implementation

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

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

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

//-----------------------------------------------------------------------------
//  共有メモリアクセスのための準備
//
//  成功すると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を使用したアプリにメッセージを送る
//
//  nCode フックコード
//  wPar  カレントプロセスからのメッセージの場合0以外の値
//        別のプロセスからのメッセージの場合は0
//  lPar  メッセージ情報が格納されているTCWPStruct構造体のポインタ．
//        型をそのポインタ型のPCWPStructとしてもいいが，ここではIntegerのままと
//        し，構造体から値を取得する時に変数LStructにそのポインタを代入
//
//  メッセージがSendMessage関数によって送られる前にこのフック関数を通過する
//  PostMessageで呼出元に送るのはメッセージ発生元のハンドルとwParam値
//  wParamにウィンドウ操作関係の情報がある
//  lParamはウィンドウハンドルやコントロールのIDの場合が多い
//-----------------------------------------------------------------------------
function MyHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LpMap      : Pointer;
  LWnd       : THANDLE;
  LTargetWnd : HWND;
  LpStruct   : PCWPStruct;
  LMsg       : 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 = 0 then begin
        LpStruct    := PCWPStruct(lPar);
        LMsg        := LpStruct^.message;
        LTargetWnd  := LpStruct^.hwnd;

        //LpStruct^.wParamはメッセージによって異なる固有の32ビット値
        if LMsg = pHookInfo(LpMap)^.RevMessage then begin
          PostMessage(pHookInfo(LpMap)^.HostWnd,
                      WM_APP+200,
                      LTargetWnd,
                      LpStruct^.wParam);
        end;
      end;
    end;
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フック関数の登録
//  登録するフック関数はMyHookProc
//  AMsgは調査対象のウィンドウメッセージの値(WM_XXXX)
//-----------------------------------------------------------------------------
function StartWndProcHook(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_CALLWNDPROC,
                                                     @MyHookProc,
                                                     hInstance,
                                                     0);
    //フック成功
    if pHookInfo(LpMap)^.HookHandle > 0 then begin
      Result := True;
    end;
    //メモリマップドファイル使用終了処理
    UnMapFileMemory(LMapWnd, LpMap);
  end;
end;

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopWndProcHook; 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.