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



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



01_グローバルフック  WH_CALLWNDPROCRET


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


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



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


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

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

interface

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

type
 TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListView1: TListView;
    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 GetWindowClassNameStr(hWindow: HWND): String;
   function GetWindowTitleStr(hWindow: HWND): String;
 private
   { Private declarations }
    hHookLib : THANDLE;
    procedure WMAPPMessage(var Msg: TMessage); message WM_APP+210;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

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

  Caption := 'WH_CALLWNDPROCRET テスト';

  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;

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

//=============================================================================
//  フックを有効にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if hHookLib = 0 then begin
    hHookLib := LoadLibrary('PLHOOKCALLWNDPROCRET.DLL');
    StartCallWndProcRetHook(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 + 210 then begin
   //ここのWM_XXXXの(メッセージ識別子)を変更してテストすれば
   //WH_CALLWNDPROCRETフックがどんなメッセージを捕捉可能かを確認可能
   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 plHookCallWndProcRet;

uses
  plHookCallWndProcRetUnit in 'plHookCallWndProcRetUnit.pas';

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


リスト3
サンプルプログラムで使用している DLL のコード
DLL 本体のコードドは，グローバルフックのサンプルでほとんど同じ		 
unit plHookCallWndProcRetUnit;

interface

uses
  Windows, Messages;

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

implementation

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

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

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

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

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

  UnMapFileMemory(LWnd, LpMap);
end;

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

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopCallWndProcRetHook; 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 メッセージリストをリソースから読み出してセットしていますが，これらの全てがフックできるわけではありません．マウスやキーボートの操作はフックできません．


図2
実行画面

リスト4
メッセージを選択して WH_CALLWNDPROCRET フックを行うプログラム 
unit Unit1;

interface

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

type
 TForm1 = 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; wParam: Cardinal);
   function GetWindowTitleStr(hWindow: HWND): String;
   function GetWindowClassNameStr(hWindow: HWND):string;
 private
    hHookLib : THANDLE;
    procedure WMAPPMessage(var Msg: TMessage); message WM_APP+220;
 public
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

  // DLL内の呼出関数類
  function StartWndProcHook(Wnd: HWND; AMsg: Integer): Boolean; stdcall;
    external 'PLHOOKWNDPROCRETMSG.DLL';
  procedure StopWndProcHook; stdcall; external 'PLHOOKWNDPROCRETMSG.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 + 220, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  Caption := 'WH_CALLWNDPROCRET テスト';

  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 TForm1.FormDestroy(Sender: TObject);
begin
  if hHookLib <> 0 then begin
     StopWndProcHook;
     FreeLibrary(hHookLib);
     hHookLib := 0;

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

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

  if hHookLib = 0 then begin
    LIndex   := ComboBox1.ItemIndex;
    LRevMsg  := Integer(ComboBox1.Items.Objects[LIndex]);
    hHookLib := LoadLibrary('PLHOOKWNDPROCRETMSG.DLL');
    StartWndProcHook(Handle, LRevMsg);

    btnStart.Enabled := False;
    btnStop.Enabled  := True;
  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からのメッセージを受取る
//
//  DLL側で以下の値をセットしている
//  Msg.wParam メッセージを受取るウィンドウのハンドル値
//  Msg.lParam メッセージ固有の値(wParam値)
//-----------------------------------------------------------------------------
procedure TForm1.WMAPPMessage(var Msg: TMessage);
var
  LTargetWnd : HWND;
  LClass     : String;
  LTitle     : String;
  LwParam    : Cardinal;
begin
  if Msg.Msg = WM_APP + 220 then begin
    LTargetWnd := Msg.wParam;
    LClass     := GetWindowClassNameStr(LTargetWnd);
    LTitle     := GetWindowTitleStr(LTargetWnd);
    LwParam    := Msg.LParam;
    DisplayMessageInfo(LClass, LTitle, LwParam);
  end;
end;

//-----------------------------------------------------------------------------
//  ListViewにフックしたウインドウのクラス名とタイトル，wParam値を表示
//  wParam値は，下位ワードと上位ワード値に分けて16進数で表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayMessageInfo(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 のプロジェクトソース 
library plHookWndProcRetMsg;

uses
  plHookWndProcRetMsgUnit in 'plHookWndProcRetMsgUnit.pas';

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


リスト6
DLL のソース
DLL 本体のコードドは，グローバルフックのサンプルでほとんど同じ		 
unit plHookWndProcRetMsgUnit;

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 = 'HookWndProcRetMsg';

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

        //LpStruct^.wParamはメッセージによって異なる固有の32ビット値
        if LMsg = pHookInfo(LpMap)^.RevMessage then begin
          PostMessage(pHookInfo(LpMap)^.HostWnd,
                      WM_APP+220,
                      LpStruct^.hwnd,
                      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_CALLWNDPROCRET,
                                                     @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.