ホーム >プログラム >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;

2012-11-21:64bitOSで32bitプロセスから64bitプロセスの実行ファイル名を取得するコードを追加。