unit Unit1;

interface

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

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 WndProc(var msg: TMessage);override;
   procedure DisplayWindowInfo(ClassName, TitleStr: String);
   function GetWindowTitleStr(hWindow: HWND): String;
   function GetWindowClassNameStr(hWindow: HWND):string;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

// DLL内の関数類の定義
function StartCBTHook(Wnd: HWND): Boolean; stdcall; external 'PLHOOKCBT.DLL';
procedure StopCBTHook; stdcall; external 'PLHOOKCBT.DLL';
function  GetHookMsgString: PChar; stdcall; external 'PLHOOKCBT.DLL';

var
  hHookLib    : THANDLE;
  HookMessage : String;
  MsgHooking  : WORD;


//=============================================================================
//  フォーム生成時の処理
//  クラス名とタイトルを一覧表示するためのListViewの設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LStyle : LongInt;
begin
  ListView1.ViewStyle          := vsReport;
  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;

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

//=============================================================================
//  [StartHook]ボタン
//  フックを有効にする
//  予めDLL内で定義してある文字列を使用してフックメッセージを登録
//  UIPI(ユーザーインターフェイス特権の分離)対応処理
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  MSGFLT_ADD    = 1;
  MSGFLT_REMOVE = 2;
var
  DLLHandle  : THandle;
  FuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
begin
  if hHookLib = 0 then begin
    hHookLib := LoadLibrary('PLHOOKCBT.DLL');
    StartCBTHook(Handle);
    HookMessage := GetHookMsgString;
    MsgHooking  := RegisterWindowMessage(PChar(HookMessage));

    //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(MsgHooking, MSGFLT_ADD);
          end;
        end;
      finally
        FreeLibrary(DLLHandle);
      end;
    end;
  end;
end;

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

//=============================================================================
//  Application側でDLLからのメッセージ通知を受取る
//  ここではフォームのWndProcメソッドを使用
//=============================================================================
procedure TForm1.WndProc(var msg: TMessage);
var
  TargetWnd : HWND;
begin
  if msg.Msg = MsgHooking then begin
    TargetWnd := msg.WParam;
    DisplayWindowInfo(GetWindowClassNameStr(TargetWnd),
                      GetWindowTitleStr(TargetWnd));
  end;

  inherited WndProc(msg);
end;

//-----------------------------------------------------------------------------
//  ListViewにCreateしたウィンドウのクラス名とタイトルを表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayWindowInfo(ClassName, TitleStr: String);
var
  LItem : TListItem;
begin
  if Trim(ClassName) <> '' then 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;
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.

library plHookCBT;

uses
  plHookCBTUnit in 'plHookCBTUnit.pas';

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

unit plHookCBTUnit;

interface

uses
  Windows, Messages, SysUtils;

//外部のアプリケーションから使用する関数類

function StartCBTHook(Wnd: HWND): Boolean; stdcall;
procedure StopCBTHook; stdcall;
function  GetHookMsgString: PChar; stdcall;

implementation

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

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

const
  //Hostへの通知メッセージ定義に使用
  HookStr = 'plHookCBT hook';
  //メモリマップドファイル名
  MapFileName = 'plHookCBTCreate';

//-----------------------------------------------------------------------------
//  メッセージ作成用文字列の取得関数
//-----------------------------------------------------------------------------
function GetHookMsgString: PChar; stdcall;
begin
  Result := HookStr;
end;

//-----------------------------------------------------------------------------
//  共有メモリアクセスのための準備
//
//  成功すると0を返す.失敗すると負数を返す
//  負の値で処理を分岐できるようになっているが,このコードでは未使用
//-----------------------------------------------------------------------------
function MapFileMemory(var AMapWnd: THandle; var ApMap: Pointer): Integer;
begin
  Result := 0;

  //メモリマップドファイルを開く
  AMapWnd := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(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);
    end;
  end;
end;

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

//-----------------------------------------------------------------------------
//  フックのコールバック関数
//  HCBT_CREATEWNDの時のみこのDLLを使用したアプリにメッセージを送る
//  メッセージIDはこのDLL内で設定した文字列から生成したもの
//  必要であれば別途定義する
//-----------------------------------------------------------------------------
function MyHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  LMapWnd : THandle;
  LpMap   : Pointer;
begin
  Result := 0;
  if MapFileMemory(LMapWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end else begin
    if (nCode = HCBT_CREATEWND) then begin
      PostMessage(pHookInfo(LpMap)^.HostWinHandle,
                  pHookInfo(LpMap)^.MsgID,
                  wPar,
                  lPar);
    end;
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LMapWnd, LpMap);
end;

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

  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);

  if LpMap <> nil then begin
    //フック情報構造体初期化とフック関数の登録
    pHookInfo(LpMap)^.HostWinHandle := Wnd;
    //フックをインストール}
    pHookInfo(LpMap)^.HookHandle := SetWindowsHookEx(WH_CBT,
                                                     @MyHookProc,
                                                     hInstance,
                                                     0);
    //アプリケーションへ通知するメッセージを登録
    pHookInfo(LpMap)^.MsgID := RegisterWindowMessage(HookStr);
    if pHookInfo(LpMap)^.MsgID = 0 then exit;

    //フック成功
    if pHookInfo(LpMap)^.HookHandle > 0 then begin
      Result := True;
    end;
    //メモリマップドファイル使用終了処理
    UnMapFileMemory(LMapWnd, LpMap);
  end;
end;

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopCBTHook; stdcall;
var
  LMapWnd : THandle;
  LpMap   : Pointer;
begin
  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap <> nil then 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),
                                PChar(MapFileName));
end;

//-----------------------------------------------------------------------------
//  ユニット終了処理部
//  メモリマップドファイルのクローズ
//-----------------------------------------------------------------------------
finalization
begin
  if hMapFile <> 0 then CloseHandle(hMapFile);
end;

end.