[BlueLeaf1336]> PROBLEMS> RecentApps>
| history | TOP |
2005/02/20:作成
| 2005/02/20 | TOP |
アプリケーションが起動された時・終了された時を監視することができるかどうかをテストします。テストといっても、実は心当たりがあります。
以前に「ファイルを開く/名前を付けて保存する」ダイアログの生成と破棄を監視することができるかどうかを調べたことがあり、「CBTフック」をしかけると「HCBT_CREATEWND(ウィンドウの生成)」「HCBT_DESTROYWND(ウィンドウの破棄)」に対処することで、あらゆるウィンドウの生成と破棄の瞬間に立ち会えることができる、とういことがわかっています。
ただし、注意するべきなのは、この方法でチェックできるのが「ウィンドウの生成と破棄」であって「アプリケーションの起動と終了ではない」とう点です。ただ、全てかどうかわからないけども、基本的に普通のアプリケーションはメインウィンドウを持っているだろう、と仮定しても問題なさそうとすれば、ウィンドウ生成時に、初めての誰にも所有されていないウィンドウかどうかを判定すればよさそうな感じがします。
一瞬ソースコードないのか? と思いましたが
にちゃんとありました。コレを元に、とりあえず、アプリケーションが起動してから終了するまでに処理された、ウィンドウの生成と破棄の状況だけを表示するプログラムを作ってみます。また、単純にウィンドウハンドルだけを表示してもわけがわからないので、ウィンドウのクラス名とテキストもついでに表示することにします。
以下にソースを掲載します。構成としては、DLLでフックのインストールやアンインストールを行うのですが、ファイルマッピングオブジェクトを使用する必要があるため(細かい話は理解していません)、まずファイルマッピングオブジェクトを処理するユニットを作成しています。それをusesに加えて、CBTフックを行うDLLを作成します。
次に、フォームにかいてもかまわないのですが、ここでは、DLLからのCBTフックによる通知を受け取るクラスを作成し、そのクラスの生成と破棄をフォームで行うようにしています。なぜそうしたかというと、参考にしたソースがそうなっていたからです。実際そうなんですが、処理が分かれているほうがよいような気もします。
およそ参考にしたサイトに関しては、ソースコード内にコメントとして記述しています。が、パクリミス等動作不具合に関して、元のサイトは無関係であり、また、このサイトにおいても責任をとりません。早い話、指摘していただくと嬉しいですが、どんな問題が起こったとしても「耳日曜」です。
| (CBTフックのための)ファイルマッピングオブジェクトの処理 | TOP |
(*
===========================================================================
共有メモリアクセス処理
---------------------------------------------------------------------------
Gen's LowTech : メッセージフックを使う
http://www2.biglobe.ne.jp/~sakai/usehook.htm
http://www2.biglobe.ne.jp/~sakai/bin/list2.txt
---------------------------------------------------------------------------
MMF = Memory Mapped File
===========================================================================
*)
unit iFMO;
interface
uses
Windows, SysUtils;
function CreateFileMappingObject(const ADataSize: integer; const AName: string): Cardinal;
procedure DestroyFileMappingObject(var AFileMappingObject: THandle);
function GetFileMappingObject(var h: THandle; var p: Pointer; const AName: string): Boolean;
procedure ReleaseFileMappingObject(var h: THandle; var p: Pointer);
implementation
//-----------------------------------------------------------------------------
// ファイルマッピングオブジェクト作成
function CreateFileMappingObject(const ADataSize: integer; const AName: string): Cardinal;
begin
// MMF作成
Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, ADataSize, PChar(AName));
// エラーでも何もしない
if (Result = 0) then ;
end;
//-----------------------------------------------------------------------------
// ファイルマッピングオブジェクト作成
procedure DestroyFileMappingObject(var AFileMappingObject: THandle);
begin
//MMF開放
if (AFileMappingObject <> 0) then
begin
CloseHandle(AFileMappingObject);
end;
end;
//-----------------------------------------------------------------------------
// 共有メモリアクセスのための準備
function GetFileMappingObject(var h: THandle; var p: Pointer; const AName: string): Boolean;
begin
Result := true;
//MMFを開く
h := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(AName));
// 開けなくても何もしない
if (h = 0) then
begin
Result := false;
end
else
// 開けた
begin
//MMFの割り当て
p := MapViewOfFile(h, FILE_MAP_ALL_ACCESS, 0, 0, 0);
// 割り当てられなくても何もしない
if (p = nil) then Result := false;
end;
end;
//-----------------------------------------------------------------------------
// 共有メモリアクセスのための後始末
procedure ReleaseFileMappingObject(var h: THandle; var p: Pointer);
begin
// MMFのビューを解除
if (p <> nil) then
begin
UnmapViewOfFile(p);
p := nil;
end;
// MMFのハンドルを閉じる
if (h <> 0) then
begin
CloseHandle(h);
h := 0;
end;
end;
end.
| (CBTフックのための)DLLの処理 | TOP |
(*
===========================================================================
Gen's LowTech : メッセージフックを使う
http://www2.biglobe.ne.jp/~sakai/usehook.htm
http://www2.biglobe.ne.jp/~sakai/bin/list2.txt
---------------------------------------------------------------------------
Using Hooks
ms-help://MS.PSDK.1033/winui/winui/windowsuserinterface/windowing/hooks/usinghooks.htm
---------------------------------------------------------------------------
2003/11/25 作り始め
2004/02/05 修正(例外とか除去/整理)
2005/02/20 ウィンドウの生成と破棄だけに限定した
===========================================================================
*)
unit HookMain;
interface
uses
Windows, Messages, iFMO;
//-----------------------------------------------------------------------------
// エクスポート関数
//-----------------------------------------------------------------------------
// フックをインストール
function HookInstall(Wnd: HWND): Boolean; export; stdcall;
// フックをアンインストール
procedure HookUnInstall(); export; stdcall;
// 準備
function HookInitialize(): Boolean; export; stdcall;
// 後始末
procedure HookFinalize(); export; stdcall;
const
// 通知用ウィンドウメッセージ(DLL to ClickHereItIs)
UM_CREATEWND = WM_APP + 1000; // CBTProc(in DLL)
UM_DESTROYWND = WM_APP + 1001; // CBTProc(in DLL)
const
// MMFのファイル名
FMO_NAME = '{C67868C5-21C1-4BEC-84B3-DB5ACDFA2427}';
implementation
//-----------------------------------------------------------------------------
// 共有メモリの内容にする構造体
type
PShareHookInfo = ^TShareHookInfo;
TShareHookInfo = packed record
HostWindow : HWND; // 通知するウィンドウ
HCbtHook : HHOOK; // フックした時のハンドル
end;
//-----------------------------------------------------------------------------
// フック関数型
type
THookProc = function(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
//-----------------------------------------------------------------------------
// 共有メモリでない内容にする構造体
type
PLocalHookInfo = ^TLocalHookInfo;
TLocalHookInfo = record
CbtHooked : Boolean; // フック中フラグ
FmoHandle: THandle; // FMOハンドル
end;
var
// フック関数のインストールに関する情報を保持する
LHI: TLocalHookInfo;
//-----------------------------------------------------------------------------
// CBTProc
function CBTProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
hFMO: THandle;
p : Pointer;
Shi : PShareHookInfo;
CreateWnd : integer;
DestroyWnd : integer;
begin
// MMF使用準備処理
GetFileMappingObject(hFMO, p, FMO_NAME);
// フック情報構造体初期化
Shi := PShareHookInfo(p);
// どんなメッセージきたかなー
if not (nCode < 0) then
begin
case nCode of
// 生まれたてウィンドウ
HCBT_CREATEWND:
begin
// 作成されつつあるウィンドウのハンドル
CreateWnd := wParam;
PostMessage(Shi^.HostWindow, UM_CREATEWND, CreateWnd, 0);
end;
// 死にかけウィンドウ
HCBT_DESTROYWND:
begin
// 破棄されつつあるウィンドウのハンドル
DestroyWnd := wParam;
PostMessage(Shi^.HostWindow, UM_DESTROYWND, DestroyWnd, 0);
end;
else
;
end;
end;
// 次の人ー
Result := CallNextHookEx(Shi^.HCbtHook, nCode, wParam, lParam);
//MMFマッピング解除、MMFハンドルクローズ
ReleaseFileMappingObject(hFMO, p);
end;
//-----------------------------------------------------------------------------
// フックをインストール
function HookInstall(Wnd: HWND): Boolean;
var
hFMO: THandle;
p: Pointer;
Shi: PShareHookInfo;
begin
// MMF使用準備処理
GetFileMappingObject(hFMO, p, FMO_NAME);
// フック情報構造体初期化(あるいは取得)
Shi := PShareHookInfo(p);
try
// 通知先記録
Shi^.HostWindow := Wnd;
// フック関数の登録
Shi^.HCbtHook := SetWindowsHookEx(WH_CBT, CBTProc, HInstance, 0);
// フック成功判定
LHI.CbtHooked := (Shi^.HCbtHook > 0);
finally
// MMF使用終了処理
ReleaseFileMappingObject(hFMO, p);
end;
// 成功した?
Result := LHI.CbtHooked;
end;
//-----------------------------------------------------------------------------
// フックをアンインストール
procedure HookUnInstall();
var
hFMO: THandle;
p: Pointer;
Shi: PShareHookInfo;
begin
// MMF使用準備処理
GetFileMappingObject(hFMO, p, FMO_NAME);
// フック情報構造体初期化
Shi := PShareHookInfo(p);
// フック解除
if LHI.CbtHooked then UnhookWindowsHookEx(Shi^.HCbtHook);
// MMF使用終了処理
ReleaseFileMappingObject(hFMO, p);
end;
//-----------------------------------------------------------------------------
// 準備
function HookInitialize(): Boolean;
begin
// MMF 作成
FillChar(LHI, SizeOf(LHI), #0);
LHI.FmoHandle := CreateFileMappingObject(SizeOf(TShareHookInfo), FMO_NAME);
Result := (LHI.FmoHandle <> 0);
end;
//-----------------------------------------------------------------------------
// 後始末
procedure HookFinalize();
begin
// MMF 解放
DestroyFileMappingObject(LHI.FmoHandle);
end;
end.
| (EXE側)DLLによるCBTフックの結果を通知してもらうクラス | TOP |
//-----------------------------------------------------------------------------
// CBT HOOK を行う DLL から通知してもらうクラス
//-----------------------------------------------------------------------------
unit iRecentApps;
interface
uses
Windows, Messages, Classes, SysUtils;
type
TMessageOut = procedure(const Msg: string) of object;
// CBTフック仲介クラスのベースクラス(ほとんど何もしない)
TCbtHookReciever = class
private
FWndHandle: HWND;
FEnabled: Boolean;
FInstalled: Boolean;
FMessageOut: TMessageOut;
procedure WndProc(var Msg: TMessage); virtual;
protected
procedure DoTargetCreate(WH: HWND); virtual;
procedure DoTargetDestroy(WH: HWND); virtual;
public
constructor Create();
destructor Destroy; override;
procedure Start();
procedure Stop();
property MessageOut: TMessageOut read FMessageOut write FMessageOut;
end;
var
CbtHookReciever: TCbtHookReciever = nil;
implementation
const
// 通知用ウィンドウメッセージ(DLL)
UM_CREATEWND = WM_APP + 1000; // CBTProc(in DLL)
UM_DESTROYWND = WM_APP + 1001; // CBTProc(in DLL)
// DLL名称
HOOK_DLL_NAME = 'hook.dll';
// DLLからインポート・横着してスタティックリンクで
function HookInstall(Wnd: HWND): Boolean; stdcall;external HOOK_DLL_NAME;
procedure HookUnInstall(); stdcall;external HOOK_DLL_NAME;
procedure HookInitialize(); stdcall;external HOOK_DLL_NAME;
procedure HookFinalize(); stdcall;external HOOK_DLL_NAME;
//------------------------------------------------------------------------------
// http://homepage2.nifty.com/Mr_XRAY/Halbow/VCL06.html
function GetClassNameStr(hWindow:HWND):string;
var
p:PChar;
ret:integer;
begin
GetMem(p,100);
ret := GetClassName(hWindow,p,100);
SetString(result,p,ret);
FreeMem(p);
end;
//------------------------------------------------------------------------------
// http://homepage2.nifty.com/Mr_XRAY/Halbow/VCL06.html
function GetWindowTextStr(hWindow:HWND):string;
var
p:PChar;
ret:integer;
begin
ret := GetWindowTextLength(hWindow);
GetMem(p,ret+1);
ret := GetWindowText(hWindow,p,ret+1);
SetString(result,p,ret);
FreeMem(p);
end;
//------------------------------------------------------------------------------
// コンストラクタ
constructor TCbtHookReciever.Create();
begin
inherited Create;
// ウィンドウコントロールのふりをする
FWndHandle := Classes.AllocateHWnd(WndProc);
// とりあえず無効に
FEnabled := False;
// フック準備
HookInitialize();
// フックインストール
FInstalled := HookInstall(FWndHandle);
// メッセージ表示イベント
FMessageOut := nil;
end;
//------------------------------------------------------------------------------
// デストラクタ
destructor TCbtHookReciever.Destroy;
begin
FMessageOut := nil;
// フックアンインストール
if (FInstalled) then HookUnInstall();
// フック後始末
HookFinalize();
// ウィンドウのふり中止
Classes.DeallocateHWnd(FWndHandle);
inherited;
end;
//------------------------------------------------------------------------------
// ウィンドウが作られたぞ
// 実際には派生したクラスで、それなりの処理をする予定
procedure TCbtHookReciever.DoTargetCreate(WH: HWND);
var
Msg: string;
begin
Msg := Format('%s WINDOW CREATED %10d [%s] - (%s)', [
FormatDateTime('hh:nn:ss.zzz', Now()), WH,
GetClassNameStr(WH),
GetWindowTextStr(WH)
]);
if Assigned(FMessageOut) then FMessageOut(Msg);
end;
//------------------------------------------------------------------------------
// ウィンドウが破棄されたぞ
// 実際には派生したクラスで、それなりの処理をする予定
procedure TCbtHookReciever.DoTargetDestroy(WH: HWND);
var
Msg: string;
begin
Msg := Format('%s WINDOW DESTROYED %10d', [FormatDateTime('hh:nn:ss.zzz', Now()), WH]);
if Assigned(FMessageOut) then FMessageOut(Msg);
end;
//------------------------------------------------------------------------------
// ウィンドウプロシージャ
//------------------------------------------------------------------------------
// ms-help://MS.PSDK.1033/winui/winui/windowsuserinterface/windowing/hooks/
// hookreference/hookfunctions/cbtproc.htm
//------------------------------------------------------------------------------
procedure TCbtHookReciever.WndProc(var Msg: TMessage);
begin
// フックに成功していて中止中でない場合
if (FInstalled) and (FEnabled) then
begin
case Msg.Msg of
// ウィンドウ作成
UM_CREATEWND: DoTargetCreate(Msg.WParam);
// ウィンドウ破棄
UM_DESTROYWND: DoTargetDestroy(Msg.WParam);
end;
end;
// 他のメッセージは知らんよ。どうにかして。
Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
//------------------------------------------------------------------------------
// 受け付けるよ
procedure TCbtHookReciever.Start();
begin
FEnabled := True;
end;
//------------------------------------------------------------------------------
// 受け付けません
procedure TCbtHookReciever.Stop();
begin
FEnabled := False;
end;
end.
| (EXE側)本体の処理 | TOP |
type
TDummyMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
procedure MessageOut(const Msg: string);
public
end;
implementation
{$R *.dfm}
uses
iRecentApps;
//-----------------------------------------------------------------------------
// フォーム作成時
procedure TDummyMainForm.FormCreate(Sender: TObject);
begin
// CBTフック開始
CbtHookReciever := TCbtHookReciever.Create();
// メッセージを表示するような関数を設定
CbtHookReciever.MessageOut := MessageOut;
CbtHookReciever.Start();
end;
//-----------------------------------------------------------------------------
// 終了時
procedure TDummyMainForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
// CBTフック終了
CbtHookReciever.Stop();
CbtHookReciever.Free();
end;
//-----------------------------------------------------------------------------
// CBTフック中継クラスから呼ばれるメッセージ出力関数(暫定)
procedure TDummyMainForm.MessageOut(const Msg: string);
begin
try
DebugWindow.PutMsg(Msg);
except
end;
end;
| 注意事項 | TOP |
大体こんな感じですが、最後の本体の処理を大幅に省略しているので(フック仲介クラスの使用箇所はコレが全てですが)、このままフォームに貼り付けても動作しません。もし、参考にするようなことがある場合は、プロジェクト全体を参照してください。動作はします。
ただし、あくまでもここまでの流れの中で、タスクトレイプログラムということになってしまっているので、起動時にタスクトレイに表示され、アプリケーションの終了はタスクトレイ右クリックの「Exit」メニューからしかできません。表示されるテスト用のウィンドウを閉じたところでアプリケーションが終了するわけではないので、ご注意ください。
20050220RecentApps.zip(222,328bytes)
こんな感じの画面が表示されます(くり返しますが、メインウィンドウではないので、閉じたところでアプリケーションは終了しません。タスクトレイにあるDelphi6のデフォルトアイコンを右クリックして終了する必要があります)。
実際には、無条件にウィンドウの生成と破棄を監視しても仕方がないので、アプリケーションごとにひとつずつ、アプリケーションを代表するウィンドウの生成に対して処理するようにしなければなりません。
このページのタイトルを「アプリケーションの起動終了を監視」としてしまったのを後悔しているわけですが、行数もかなり増えてきたので、このページはここまでとします。
| EOF | TOP |