Delphi 6 ローテクTips/ウィンドウハンドルから実行ファイル名を取得

マウスカーソル下のウィンドウの実行ファイル名を取得したいと思いました。
モジュールどうのこうのといった難しいことではなく単にパスとファイル名を取得したいのです。
そのためにウィンドウハンドルから実行ファイル名を取得する方法を探りました。

核となる部分を関数にしました。
2000以降のみ対応となるようです。
ウィンドウハンドルを引数にとって、そのウィンドウを作成した実行ファイル名を返します。
ウィンドウハンドルはトップレベルウィンドウのものである必要はなく子ウィンドウのハンドルでも大丈夫です。

usesにPsAPIを書き加えないとGetModuleFileNameExWが未定義であるというコンパイルエラーになります。

implementation
uses
PsAPI;

function gfnsExeNameGet(const hHandle: HWND): WideString;
var
li_ProcID : DWORD;
lh_ProcHandle : THandle;
lp_Buff : PWideChar;
begin
Result := '';

//ウィンドウを作成したプロセスIDを取得
GetWindowThreadProcessId(hHandle, @li_ProcID);

//プロセスのオープンハンドルを取得
lh_ProcHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, li_ProcID);
try
//ファイル名を格納するバッファにメモリ割り当て（Unicode版APIを使うので2倍の容量を割り当て）
lp_Buff := AllocMem((MAX_PATH + 1) * SizeOf(WideChar));
try
//プロセスのオープンハンドルだけ必要でモジュールのハンドルは0でOKなよう
if (GetModuleFileNameExW(lh_ProcHandle, 0, lp_Buff, MAX_PATH) <> 0) then
begin
Result := WideString(lp_Buff);
end;
finally
FreeMem(lp_Buff);
end;
finally
CloseHandle(lh_ProcHandle);
end;
end;

上の関数をタイマーイベント内で動かしてみます。
フォームにタイマーとラベルを貼り付けてタイマーのIntervalを100くらいに設定します（0.1秒）

unit Unit1;

interface

uses
Windows, SysUtils, Forms, Classes, ExtCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
procedure Timer1Timer(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form1: TForm1;

implementation
uses
psapi;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
lpt_Pos: TPoint;
lh_Handle: HWND;
li_ProcID: DWORD;
lh_ProcHandle: THandle;
lp_Buff: PWideChar;
begin
//マウスカーソルの位置を取得（スクリーン座標）
GetCursorPos(lpt_Pos);

//マウスカーソル下のウィンドウを取得し
lh_Handle := WindowFromPoint(lpt_Pos);

//そのウィンドウを作成したプロセスIDを取得
GetWindowThreadProcessId(lh_Handle, @li_ProcID);

//プロセスのオープンハンドルを取得
lh_ProcHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, li_ProcID);
try
//ファイル名を格納するバッファにメモリ割り当て（Unicode版APIを使うので2倍の容量を割り当て）
lp_Buff := AllocMem((MAX_PATH + 1) * 2);
try
//プロセスのオープンハンドルだけ必要でモジュールのハンドルは0でOKなよう
if (GetModuleFileNameExW(lh_ProcHandle, 0, lp_Buff, MAX_PATH) <> 0) then begin
Label1.Caption := WideString(lp_Buff);
end;
finally
FreeMem(lp_Buff);
end;
finally
CloseHandle(lh_ProcHandle);
end;
end;

end.

実行すると、マウスを動かしてウィンドウの上に乗ると実行ファイル名が表示されます。

実行の様子

64bitOSの場合、上記のやり方では32bitのプログラムから64bitのプログラムの実行ファイル名を取得できませんでした。
GetModuleFileNameExは32bitのプログラムから呼んだ場合64bitのプログラムのプロセスを渡した場合失敗してしまうのが原因です。
そこで32bitのプログラムから64bitのプログラムのプロセスを渡しても失敗しないGetProcessImageFileNameを利用することにします。
ただGetProcessImageFileNameは"C:"や"D:"などのドライブ名ではなくデバイス名を返します。
そこでデバイス名ではなくドライブ名の実行ファイル名を得るにはGetLogicalDrivesとQueryDosDeviceを使ってデバイス名に対応するドライブ名を取得して置換する必要があります。
またGetProcessImageFileNameはXP以降の対応のようなので2000以前でも実行される場合へ対処するためLoadLibraryとGetProcAddressを使って動的に呼び出すようにします。

type
TGetProcessImageFileName = function(hProcess: THandle; lpImageFileName: LPWSTR; nSize: DWORD): DWORD; stdcall;
//function GetProcessImageFileNameW(hProcess: THandle; lpImageFileName: LPWSTR; nSize: DWORD): DWORD; stdcall; external 'Psapi.dll';

function gfnsExeNameGet(hHandle: HWND): WideString;
{
ウィンドウハンドルから実行ファイル名を返す
http://m--takahashi.com/bbs/pastlog/02500/02414.html
http://www.geocities.jp/fjtkt/problems/2003_0004.html
http://www2.big.or.jp/~osamu/Delphi/tips.cgi?index=0182.txt
http://homepage1.nifty.com/MADIA/delphi/Win32API/Process.htm

http://rarara.cafe.coocan.jp/cgi-bin/lng/vc/vclng.cgi?print+201010/10100011.txt
http://www14.big.or.jp/~ken1/tech/tech11.html
}
function _System32DirGetW: WideString;
//システムディレクトリを取得
var
li_Size : UINT;
lp_Buff : PWideChar;
begin
Result := '';

li_Size := GetSystemDirectoryW(nil, 0);
if (li_Size > 0) then
begin
lp_Buff := AllocMem(li_Size * SizeOf(WideChar));
try
li_Size := GetSystemDirectoryW(lp_Buff, li_Size);
if (li_Size > 0) then
begin
Result := WideString(lp_Buff) + '\';
end;
finally
FreeMem(lp_Buff);
end;
end;
end;
var
li_ProcID : DWORD;
lh_Process : THandle;
lp_Buff : PWideChar;

i : Integer;
li_Drives : DWORD;
li_Flag : Integer;
ls_Device : WideString;
lp_Device : PWideChar;
ls_Drv : WideString;

lh_Module : HMODULE;
l_GetProcessImageFileName : TGetProcessImageFileName;
begin
Result := '';

//ウィンドウを作成したプロセスIDを取得
GetWindowThreadProcessId(hHandle, @li_ProcID);

lh_Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, li_ProcID);
try
lp_Buff := AllocMem((MAX_PATH +1) * SizeOf(WideChar));
try
//プロセスハンドルを渡すだけで実行ファイル名を取得できた
if (GetModuleFileNameExW(lh_Process, 0, lp_Buff, MAX_PATH) <> 0) then
begin
Result := WideString(lp_Buff);
end else
begin
//GetModuleFileNameExは32bitプロセスから64bitプロセスの実行ファイル名を取得できない
//完全修飾パスを指定してPsapi.dllをロード
lh_Module := LoadLibraryW(PWideChar(_System32DirGetW + 'Psapi.dll'));
if (lh_Module <> 0) then
begin
try
//GetProcessImageFileNameの関数ポインタを取得
@l_GetProcessImageFileName := GetProcAddress(lh_Module, 'GetProcessImageFileNameW');
if (@l_GetProcessImageFileName <> nil) then
begin
l_GetProcessImageFileName(lh_Process, lp_Buff, MAX_PATH);
Result := WideString(lp_Buff);

//GetProcessImageFileNameはドライブ名でなくデバイス名で返すのでドライブ名に置換する
//存在するドライブのビットマスクを取得
li_Drives := GetLogicalDrives;
li_Flag := 1;
for i := Ord('A') to Ord('Z') do
begin
//取得したビットマスクからドライブが存在するかを判定
if ((li_Drives and li_Flag) <> 0)
then begin
lp_Device := AllocMem((MAX_PATH +1) * SizeOf(WideChar));
try
ls_Drv := Char(i) + ':';
//ドライブ名に対応するデバイス名を取得
QueryDosDeviceW(PWideChar(ls_Drv), lp_Device, MAX_PATH);
ls_Device := WideString(lp_Device);
if (Pos(ls_Device + '\', Result) = 1) then
begin
//実行ファイル名のデバイス名をドライブ名に置換
Result := ls_Drv + Copy(Result, Length(ls_Device) +1, MaxInt);
Break;
end;
finally
FreeMem(lp_Device);
end;
end;
li_Flag := li_Flag shl 1;
end;
end;
finally
FreeLibrary(lh_Module);
end;
end;
end;
finally
FreeMem(lp_Buff);
end;
finally
CloseHandle(lh_Process);
end;
end;