Delphi Programming / Object Pascal
[掲載 2017年04月01日] [更新 2021年10月06日] Delphi サンプルプログラム集
488_ウェブブラウザを起動して終了を検出 - Microsoft Edge 対応
動作確認等
Windows 10 ビルド 19042 + Delphi XE5(UP2) Pro VCL-32
488_BrowseURL_ShellExecute.zip [6.2 MB] 2021年10月06日版 (EXE 同梱)
ウェブブラウザを起動して終了を検出 - Microsoft Edge 対応
ウェブブラウザの起動,起動したブラウザが終了するまで待つ等,それらに関連したサンプルです.
2020年1月,Microsoft Edge
が Google の Chromium をベースにしたブラウザになました.下図は従来の非 Chromium 版の Microsoft Edge におけるプロセスを確認した結果です.このプロセスは Microsoft Edge を ShellExecuteEx 関数で起動しても,TShellExecuteInfo.hProcess では取得できません.そこで,TProcessEntry32 を使用してプロセスを検出する処理にしていました.
今回,Chromium 版と非 Chromium 版のどちらの Microsoft Edge でも動作可能にするためにコードを見直し,全て EnumWindows 関数で処理する方式に変更しました.
図1
Microsoft Edge の実行プロセスを確認
非 Chromium 版の Microsoft Edge
下図は,テストに使用したウェブブラウザとそのバージョンです.
図2
Chromium 版の Microsoft Edge の環境
図3
非 Chromium 版の Microsoft Edge の環境
[備考]
非 Chromium 版の Microsoft Edge は UWP アプリです.
指定したウェブブラウザを起動し,それが終了するまで待つことを可能にする例です.
起動するウェブブラウザを選択して [Button1]] をクリックします.[Wait Close] をチェックしてからウェブブラウザを起動すると終了待ちになります.[TOPMOST] をチェックすと,起動したウェブブラウザを TOPMOST なウィンドウにして表示します.
起動したアプリの終了を待つというのは,アプリを起動するコードの次のコードが実行されないという意味です.本サンプルのフォームが操作できないわけではありません.したがって,ブラウザの表示中もフォームの操作は可能です.ブラウザの表示中に閉じるボタン
[X] を操作すると,ブラウザが閉じると直ちにフォームが閉じます.
[備考]
指定したウェブブラウザが既に起動中の時は,新しいタブに表示するようにしています.
IE 11 では,既に IE 11 が起動中の時に ShellExecute 等の関数でウェブページの表示を実行すると新しく IE 11 が起動します.そこで,本サンプルでは起動中の IE 11 のオブジェクトを検出して,そのオブジェクトを操作しています.
図4
TOPMOST でブラウザを起動
本サンプルのフォームを含めて,他のアプリは前面に表示できない
図5
[TOPMOST] のチェックを外してからブラウザを起動
本サンプルのフォームを含めて,他のアプリも前面に表示できる
図6
[Wait Close] をチェックしてからブラウザを起動
ブラウザを閉じないと,ブラウザを起動した次のコードは実行されない
リスト1
ウェブブラウザの起動と,起動したウェブブラウザの終了を待つことが可能な例
IE の操作用に,タイプライブラリの取り込みで作成した Shell32_TLB を使用
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ShDocVw, Vcl.StdCtrls,
Vcl.ExtCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
RadioGroup1: TRadioGroup;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
function RunExeFile(AWnd: HWND; AExeName: string ; AParameters: string ;
IsWaitClose: Boolean=False; IsTOPMOST: Boolean=False): HWND;
public
{ Public 宣言 }
end ;
function QueryFullProcessImageNameW(Process: THandle; Flags: DWORD; Buffer: PChar;
Size: PDWORD): DWORD; stdcall ; external 'kernel32.dll' ;
function EnumTopWindowExeName(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
function EnumTopWindowHandle(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
function GetRelatedExeName(FileExt: string ): string ;
function GetFirstCreateIEObject: InternetExplorer;
var
Form1: TForm1;
implementation
uses
Winapi.ShellAPI,
Winapi.ShLwApi,
Winapi.Dwmapi,
Winapi.MMSystem,
System.StrUtils,
Shell32_TLB;
{$R *.dfm}
// =============================================================================
// フォーム生成時の処理
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
RadioGroup1.ItemIndex := 0 ;
end ;
// =============================================================================
// 指定ブラウザのアプリでウェブページを表示
// 終了まで待つ場合,ウェブブラウザを閉じないと本アプリは終了できないので注意
//
// Microsoft Edge は以下で起動可能
// MicrosoftEdge.exe, MSEdge.exe は Chromium 版専用
// shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge
// microsoft-edge: (末尾はコロン,またはコロンの後に URL)
// MicrosoftEdge.exe (.exe は省略可)
// MSEge.exe (.exe は省略可)
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LExeName : string ;
LCmdLine : string ;
LTargetWnd : HWND;
LText : string ;
begin
LExeName := '' ;
if RadioGroup1.ItemIndex = 0 then begin
LExeName := GetRelatedExeName('.html' );
end else
if RadioGroup1.ItemIndex = 1 then begin
LExeName := 'iexplore.exe' ;
end else
if RadioGroup1.ItemIndex = 2 then begin
LExeName := 'firefox.exe' ;
end else
if RadioGroup1.ItemIndex = 3 then begin
LExeName := 'chrome.exe' ;
end else
if RadioGroup1.ItemIndex = 4 then begin
LExeName := 'microsoft-edge:' ;
end ;
LCmdLine := 'http://mrxray.on.coocan.jp/index.htm' ;
if LExeName = 'microsoft-edge:' then begin
LExeName := LExeName + LCmdLine;
LCmdLine := '' ;
end ;
LTargetWnd := RunExeFile(Handle,
LExeName,
LCmdLine,
CheckBox2.Checked,
CheckBox1.Checked);
SetForegroundWindow(Handle);
if ContainsText(LExeName, 'microsoft-edge:' ) then begin
LExeName := LeftStr(LExeName, 15 );
end ;
if LTargetWnd = 0 then begin
LText := LExeName + sLineBreak + '起動に失敗しました' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end else begin
if CheckBox2.Checked then begin
LText := LExeName + sLineBreak + '起動したブラウザが終了しました' ;
MessageBox(Handle, PChar(Ltext), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end ;
end ;
end ;
// -----------------------------------------------------------------------------
// ShellExecuteEx 関数でアプリを起動
// 戻り値は対象のウィンドウハンドル.起動に失敗すると 0
// 起動待ちと終了待ちは EnumWindows を使用してウィンドウハンドルで調べる
//
// Microsoft Edge では
// TShellExecuteInfo.hProcess の値では起動待ち,終了待ちの判定不可
// -----------------------------------------------------------------------------
function TForm1.RunExeFile(AWnd: HWND; AExeName, AParameters: string ;
IsWaitClose: Boolean=False; IsTOPMOST: Boolean=False): HWND;
// -------------------------------------------------------------------
// 指定コマンドの EXE が起動したかをチェック
// 起動していればそのウィンドウハンドルを返す
// -------------------------------------------------------------------
function CheckRunExeName(RunExeName: string ): HWND;
begin
EnumWindows(@EnumTopWindowExeName, LPARAM(@RunExeName));
Result := StrToIntDef(RunExeName, 0 );
end ;
// -------------------------------------------------------------------
// 指定したウィンドウが起動しているかをチェック
// -------------------------------------------------------------------
function CheckRunHandle(AWnd: NativeUInt): Boolean;
var
LWnd : HWND;
begin
LWnd := AWnd;
EnumWindows(@EnumTopWindowHandle, LPARAM(@AWnd));
Result := LWnd <> AWnd;
end ;
// -------------------------------------------------------------------
const
navOpenInNewTab = $00000800 ;
var
LTargetWnd : THandle;
LIEObject : InternetExplorer;
LIEFlag : OleVariant;
LInfo : TShellExecuteInfo;
LResInfo : NativeUInt;
LStartTime : Cardinal;
begin
LTargetWnd := 0 ;
Result := LTargetWnd;
// IE の場合 (既に起動している IE がある場合)
if (CheckRunExeName(AExeName) <> 0 ) and (AExeName = 'iexplore.exe' ) then begin
LIEObject := GetFirstCreateIEObject;
if LIEObject <> nil then begin
// 最初に作成された IE に表示する
LIEFlag := navOpenInNewTab;
LIEObject.Navigate2(AParameters, LIEFlag, EmptyParam, EmptyParam, EmptyParam);
LTargetWnd := LIEObject.HWnd;
if IsTOPMOST then begin
SetForegroundWindow(LTargetWnd);
SetWindowPos(LTargetWnd, HWND_TOPMOST,
0 , 0 , 0 , 0 ,
SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
end ;
if IsWaitClose then begin
while True do begin
if not CheckRunHandle(LTargetWnd) then Break;
Application.ProcessMessages;
Sleep(50 );
end ;
end ;
LIEObject := nil ;
Result := LTargetWnd;
end ;
Exit;
end ;
// ブラウザの新規起動 (IE を含む)
// 起動中の場合は新規タブに URL のぺージを表示 (IE を除く.IE は上のコード)
FillChar(LInfo, SizeOf(LInfo), #0 );
LInfo.cbSize := SizeOf(LInfo);
LInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
LInfo.lpFile := PChar(AExeName);
LInfo.Wnd := AWnd;
LInfo.lpVerb := '' ;
LInfo.nShow := SW_SHOW;
LInfo.lpParameters := PChar(AParameters);
ShellExecuteEx(@LInfo);
// ShellExecuteEx は成功するとhInstApp に 33 以上の値を返す
LResInfo := LInfo.hInstApp;
if LResInfo < 33 then Exit;
try
// Microsoft Edge (UWP アプリ) 対策
// Microsoft Edge は TShellExecuteInfo.hProcess での判定は不可
LStartTime := timeGetTime;
while True do begin
LTargetWnd := CheckRunExeName(AExeName);
if (timeGetTime - LStartTime) >= 5000 then Break;
if LTargetWnd <> 0 then Break;
Application.ProcessMessages;
Sleep(50 );
end ;
if LTargetWnd = 0 then Exit;
if IsTOPMOST then begin
SetForegroundWindow(LTargetWnd);
SetWindowPos(LTargetWnd, HWND_TOPMOST,
0 , 0 , 0 , 0 ,
SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
end ;
if IsWaitClose then begin
while True do begin
if not CheckRunHandle(LTargetWnd) then Break;
Application.ProcessMessages;
Sleep(50 );
end ;
end ;
finally
CloseHandle(LInfo.hProcess);
end ;
Result := LTargetWnd;
end ;
// -----------------------------------------------------------------------------
// EnumWindows のコールバック関数
// 引数 (lPar) と同じ EXE 名の EXE が起動したかの確認用
// 検出したらウィンドウハンドルの値を文字列にして引数 lPar に返す
//
// Microsoft Edge のプロセスの EXE 名は
// 非 Chromium 版では microsoftedge.exe
// Chromium 版では MSEdge.exe
// -----------------------------------------------------------------------------
function EnumTopWindowExeName(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
const
PROCESS_QUERY_LIMITED_INFORMATION = $1000 ;
DWMWA_CLOAKED = 14 ;
MSEDGE_APPID = 'Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge' ;
var
LExeName : string ;
LIsEdge : Boolean;
LCloaked : BOOL;
LProcessID : DWORD;
LhProcess : THandle;
LBuffer : array [0 ..MAX_PATH - 1 ] of Char;
LSTR_SIZE : DWORD;
LAppPath : string ;
begin
Result := True;
LExeName := LowerCase(PString(lPar)^);
if GetWindow(hWindow, GW_OWNER) <> 0 then exit;
if not IsWindowVisible(hWindow) then exit;
// 待機中またはバックグラウンドのウィンドウは対象外
DwmGetWindowAttribute(hWindow, DWMWA_CLOAKED, @LCloaked, SizeOf(LCloaked));
if LCloaked then Exit;
LExeName := ReplaceText(LExeName, '.exe' , '' );
LIsEdge := SameText(LExeName, 'msedge' )
or SameText(LExeName, 'MicrosoftEdge' )
or (LeftStr(LExeName, 15 ) = 'microsoft-edge:' )
or ContainsText(LExeName, MSEDGE_APPID);
// プロセス ID を取得.その値からプロセスのハンドル取得
GetWindowThreadProcessId(hWindow, @LProcessID);
LhProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, LProcessID);
try
// プロセスのハンドルから EXE のフルパスを取得
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LSTR_SIZE := Length(LBuffer);
if QueryFullProcessImageNameW(LhProcess,
0 ,
@LBuffer[0 ],
@LSTR_SIZE) = 0 then Exit;
LAppPath := LBuffer;
LAppPath := ExtractFileName(LAppPath);
if LIsEdge then begin
if SameText(LAppPath, 'microsoftedge.exe' )
or SameText(LAppPath, 'msedge.exe' ) then begin
PString(lPar)^ := IntToStr(hWindow);
Result := False;
end ;
end else begin
if RightStr(LExeName, 4 ) <> '.exe' then LExeName := LExeName + '.exe' ;
if SameText(LAppPath, LExeName) then begin
PString(lPar)^ := IntToStr(hWindow);
Result := False;
end ;
end ;
finally
CloseHandle(LhProcess);
end ;
end ;
// -----------------------------------------------------------------------------
// EnumWindows のコールバック関数
// 引数の lPar と同じウィンドウハンドル値のウインドウを検索
// 起動中であれば HWND(-1) を引数の lPar に返す
// -----------------------------------------------------------------------------
function EnumTopWindowHandle(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
const
DWMWA_CLOAKED = 14 ;
var
LCloaked : BOOL;
begin
Result := True;
if GetWindow(hWindow, GW_OWNER) <> 0 then exit;
if not IsWindowVisible(hWindow) then exit;
// 待機中またはバックグラウンドのウィンドウは対象外
DwmGetWindowAttribute(hWindow, DWMWA_CLOAKED, @LCloaked, SizeOf(LCloaked));
if LCloaked then Exit;
if PNativeUInt(lPar)^ = hWindow then begin
PNativeUInt(lPar)^ := HWND(-1 );
Result := False;
end ;
end ;
// -----------------------------------------------------------------------------
// 指定した拡張子に関連づけた実行ファイルのフルパス名を取得する関数
// AssocQueryString の使用には uses に Winapi.ShLwApi が必要
// -----------------------------------------------------------------------------
function GetRelatedExeName(FileExt: string ): string ;
var
LBuffer : array [0 ..MAX_PAtH-1 ] of Char;
LdwOut : DWORD;
begin
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LdwOut := MAX_PATH;
AssocQueryString(ASSOCF_NOTRUNCATE,
ASSOCSTR_EXECUTABLE,
PChar(FileExt),
nil ,
LBuffer,
@LdwOut);
Result := ExtractFileName(LBuffer);
if Length(Result) = 0 then Result := '' ;
end ;
// -----------------------------------------------------------------------------
// 最初に起動した IE を取得して返す関数
// ShellWindows の使用には uses に SHDocVw が必要
// -----------------------------------------------------------------------------
function GetFirstCreateIEObject: InternetExplorer;
var
LShell : Shell32_TLB.TShell;
LShWindows : ShellWindows;
LIEObj : InternetExplorer;
LExeName : string ;
i : Integer;
begin
LShell := TShell.Create(nil );
try
LShWindows := LShell.Windows as ShellWindows;
Result := nil ;
// ShWindows は起動した順に検出する
for i := 0 to LShWindows.Count - 1 do begin
LIEObj := LShWindows.Item(i) as InternetExplorer;
if LIEObj <> nil then begin
// ExeName の値はエクスプローラなら Explorer.EXE,IE であれば iexplore.exe
LExeName := ExtractFileName(LIEObj.FullName);
if LowerCase(LExeName) = 'iexplore.exe' then begin
// 最初に起動した IE を見つけたら終了
Result := LIEObj;
Break;
end ;
end ;
end ;
finally
FreeAndNil(LShell);
end ;
end ;
end .
起動したウェブブラウザの終了を自動的に検出可能にするサンプルです.
上のサンプルに CheckRunHandle という関数内関数があります.その関数を定期的に実行すれば,起動したウェブブラウザの終了を検出できますが,ここでは WMI を使用してみました.
アプリの終了の検出には,WMI のイベントシンクを使用しています.一連の処理を別ユニットにして使用する場合は,アプリの終了を検出したらメッセージを送信する方法が考えられます.
図7
ブラウザを閉じるとダイアログ表示
リスト2
ウェブブラウザの起動と,起動したウェブブラウザの終了を自動検出可能にするサンプル
IE の操作用に,タイプライブラリの取り込みで作成した Shell32_TLB を使用
WMI の操作用には,タイプライブラリの取り込みで作成した WbemScripting_TLB を使用
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
ShDocVw, WbemScripting_TLB;
type
TForm1 = class (TForm)
Button1: TButton;
RadioGroup1: TRadioGroup;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
FobjWMILocator : ISWbemLocator;
FobjWMIService : ISWbemServices;
FobjWMISink : TSWbemSink;
FCloseDlgFlag : Boolean;
function RunExeFile(AWnd: HWND; AExeName: string ; AParameters: string ;
IsDetectClose: Boolean=False; IsTOPMOST: Boolean=False): HWND;
procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
const objWbemAsyncContext: ISWbemNamedValueSet);
end ;
function QueryFullProcessImageNameW(Process: THandle; Flags: DWORD; Buffer: PChar;
Size: PDWORD): DWORD; stdcall ; external 'kernel32.dll' ;
function EnumTopWindowExeName(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
function GetRelatedExeName(FileExt: string ): string ;
function GetFirstCreateIEObject: InternetExplorer;
var
Form1: TForm1;
implementation
uses
Winapi.ShellAPI,
Winapi.ShLwApi,
Winapi.Dwmapi,
Winapi.MMSystem,
System.StrUtils,
Shell32_TLB;
{$R *.dfm}
// =============================================================================
// フォーム生成時の処理
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
RadioGroup1.ItemIndex := 0 ;
FobjWMILocator := nil ;
FobjWMIService := nil ;
FobjWMISink := nil ;
end ;
// =============================================================================
// 指定ブラウザのアプリでウェブページを表示
//
// Microsoft Edge は以下で起動可能
// MicrosoftEdge.exe, MSEdge.exe は Chromium 版専用
// shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge
// microsoft-edge: (末尾はコロン,またはコロンの後に URL)
// MicrosoftEdge.exe (.exe は省略可)
// MSEge.exe (.exe は省略可)
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LExeName : string ;
LCmdLine : string ;
LTargetWnd : HWND;
LText : string ;
begin
LExeName := '' ;
if RadioGroup1.ItemIndex = 0 then begin
LExeName := GetRelatedExeName('.html' );
end else
if RadioGroup1.ItemIndex = 1 then begin
LExeName := 'iexplore.exe' ;
end else
if RadioGroup1.ItemIndex = 2 then begin
LExeName := 'firefox.exe' ;
end else
if RadioGroup1.ItemIndex = 3 then begin
LExeName := 'chrome.exe' ;
end else
if RadioGroup1.ItemIndex = 4 then begin
LExeName := 'microsoft-edge:' ;
end ;
LCmdLine := 'http://mrxray.on.coocan.jp/index.htm' ;
if LExeName = 'microsoft-edge:' then begin
LExeName := LExeName + LCmdLine;
LCmdLine := '' ;
end ;
LTargetWnd := RunExeFile(Handle,
LExeName,
LCmdLine,
CheckBox2.Checked,
CheckBox1.Checked);
SetForegroundWindow(Handle);
if ContainsText(LExeName, 'microsoft-edge:' ) then begin
LExeName := LeftStr(LExeName, 15 );
end ;
if LTargetWnd = 0 then begin
LText := LExeName + sLineBreak + '起動に失敗しました' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
Exit;
end ;
end ;
// -----------------------------------------------------------------------------
// ShellExecuteEx 関数でアプリを起動
// 戻り値は対象のウィンドウハンドル.起動に失敗すると 0
// 起動待ちは EnumWindows を使用してウィンドウハンドルで調べる
//
// Microsoft Edge では
// TShellExecuteInfo.hProcess の値では起動待ちの判定不可
// -----------------------------------------------------------------------------
function TForm1.RunExeFile(AWnd: HWND; AExeName, AParameters: string ;
IsDetectClose: Boolean=False; IsTOPMOST: Boolean=False): HWND;
// -------------------------------------------------------------------
// 指定 EXE が起動しているかをチェック
// 起動していればそのウィンドウハンドルを返す
// -------------------------------------------------------------------
function CheckRunExeName(RunExeName: string ): HWND;
begin
EnumWindows(@EnumTopWindowExeName, LPARAM(@RunExeName));
Result := StrToIntDef(RunExeName, 0 );
end ;
// -------------------------------------------------------------------
const
navOpenInNewTab = $00000800 ;
var
LTargetWnd : THandle;
LIEObject : InternetExplorer;
LIEFlag : OleVariant;
LInfo : TShellExecuteInfo;
LResInfo : NativeUInt;
LStartTime : Cardinal;
LSQLStr : string ;
LProcessName : string ;
begin
LTargetWnd := 0 ;
Result := LTargetWnd;
// IE の場合 (既に起動している IE がある場合)
if (CheckRunExeName(AExeName) <> 0 ) and (AExeName = 'iexplore.exe' ) then begin
LIEObject := GetFirstCreateIEObject;
if LIEObject <> nil then begin
// 最初に作成された IE に表示する
LIEFlag := navOpenInNewTab;
LIEObject.Navigate2(AParameters, LIEFlag, EmptyParam, EmptyParam, EmptyParam);
LTargetWnd := LIEObject.HWnd;
if IsTOPMOST then begin
SetForegroundWindow(LTargetWnd);
SetWindowPos(LTargetWnd, HWND_TOPMOST,
0 , 0 , 0 , 0 ,
SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
end ;
LIEObject := nil ;
Result := LTargetWnd;
end ;
Exit;
end ;
// ブラウザの新規起動 (IE を含む)
// 起動中の場合は新規タブに URL のぺージを表示 (IE を除く.IE は上のコード)
FillChar(LInfo, SizeOf(LInfo), #0 );
LInfo.cbSize := SizeOf(LInfo);
LInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
LInfo.lpFile := PChar(AExeName);
LInfo.Wnd := AWnd;
LInfo.lpVerb := '' ;
LInfo.nShow := SW_SHOW;
LInfo.lpParameters := PChar(AParameters);
ShellExecuteEx(@LInfo);
// ShellExecuteEx は成功するとhInstApp に 33 以上の値を返す
LResInfo := LInfo.hInstApp;
if LResInfo < 33 then Exit;
try
// Microsoft Edge (UWP アプリ) 対策
// Microsoft Edge は TShellExecuteInfo.hProcess での判定は不可
LStartTime := timeGetTime;
while True do begin
LTargetWnd := CheckRunExeName(AExeName);
if (timeGetTime - LStartTime) >= 5000 then Break;
if LTargetWnd <> 0 then Break;
Application.ProcessMessages;
Sleep(50 );
end ;
if LTargetWnd = 0 then Exit;
if IsTOPMOST then begin
SetForegroundWindow(LTargetWnd);
SetWindowPos(LTargetWnd, HWND_TOPMOST,
0 , 0 , 0 , 0 ,
SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
end ;
finally
CloseHandle(LInfo.hProcess);
end ;
Result := LTargetWnd;
if Result = 0 then Exit;
// ----------------------------------------------------------------------
// WMI の組み込みイベントクラスを使用してプログラムの終了を監視
// __InstanceOperationEvent を使用
// 検出する EXE 名は Win32_Process クラスの caption プロパティで指定
// ----------------------------------------------------------------------
if FobjWMISink <> nil then begin
FobjWMISink.Cancel;
FobjWMILocator := nil ;
FobjWMIService := nil ;
FobjWMISink :=nil ;
FreeAndNil(FobjWMISink);
end ;
FCloseDlgFlag := False;
LProcessName := AExeName;
if RightStr(LowerCase(LProcessName), 4 ) <> '.exe' then begin
LProcessName := LProcessName + '.exe' ;
end ;
if ContainsText(AExeName, 'edge' ) then begin
// Chromium 版 Microsoft Edge のみ対応
LProcessName := 'MSEdge.exe' ;
end ;
if (LTargetWnd <> 0 ) and (IsDetectClose) then begin
FobjWMILocator := CoSWbemLocator.Create;
FobjWMIService := FobjWMILocator.ConnectServer(
'localhost' ,
'root\cimv2' ,
'' ,
'' ,
'' ,
'' ,
wbemConnectFlagUseMaxWait,
nil );
FobjWMISink := TSWbemSink.Create(Self);
FobjWMISink.OnObjectReady := EventOnObjectReady;
LSQLStr := 'SELECT * '
+ 'FROM __InstanceOperationEvent '
+ 'WITHIN 1 '
+ 'WHERE TargetInstance '
+ 'ISA "Win32_Process" and '
+ 'TargetInstance.caption = "' + LProcessName + '"' ;
FobjWMIService.ExecNotificationQueryAsync(
FobjWMISink.DefaultInterface,
LSQLStr,
'WQL' ,
0 ,
nil ,
nil );
end ;
end ;
// -----------------------------------------------------------------------------
// TSWbemSink の OnObjectReady イベントのコード
// イベントの宣言部と,この実装部は WbemScripting_TLB のコードをコピペ
//
// ルーチン内でダイアログを表示しているが,メッセージの送信の方がいいだろう
// -----------------------------------------------------------------------------
procedure TForm1.EventOnObjectReady(ASender: TObject;
const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
LPropVal : OleVariant;
LPropValue : OleVariant;
LText : string ;
begin
LPropVal := objWbemObject;
LPropValue := LPropVal.TargetInstance;
if VarToStr( LPropVal.Path_.Class ) = '__InstanceDeletionEvent' then begin
// 複数のプロセスが起動しているブラウザでは何回も実行されるのでフラグで抑制
if FCloseDlgFlag = False then begin
FCloseDlgFlag := True;
LText := VarToStr(LPropValue.Caption);
LText := LText + sLineBreak + 'ブラウザが閉じられました' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
SetActiveWindow(Handle);
SetForegroundWindow(Handle);
end ;
end ;
end ;
// -----------------------------------------------------------------------------
// EnumWindows のコールバック関数
// 引数 (lPar) と同じ EXE 名の EXE が起動したかの確認用
// 検出したらウィンドウハンドルの値を文字列にして引数 lPar に返す
//
// Microsoft Edge のプロセスの EXE 名は
// 非 Chromium 版では microsoftedge.exe
// Chromium 版では MSEdge.exe
// -----------------------------------------------------------------------------
function EnumTopWindowExeName(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
const
PROCESS_QUERY_LIMITED_INFORMATION = $1000 ;
DWMWA_CLOAKED = 14 ;
MSEDGE_APPID = 'Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge' ;
var
LExeName : string ;
LIsEdge : Boolean;
LCloaked : BOOL;
LProcessID : DWORD;
LhProcess : THandle;
LBuffer : array [0 ..MAX_PATH - 1 ] of Char;
LSTR_SIZE : DWORD;
LAppPath : string ;
begin
Result := True;
LExeName := LowerCase(PString(lPar)^);
if GetWindow(hWindow, GW_OWNER) <> 0 then exit;
if not IsWindowVisible(hWindow) then exit;
// 待機中またはバックグラウンドのウィンドウは対象外
DwmGetWindowAttribute(hWindow, DWMWA_CLOAKED, @LCloaked, SizeOf(LCloaked));
if LCloaked then Exit;
LExeName := ReplaceText(LExeName, '.exe' , '' );
LIsEdge := SameText(LExeName, 'msedge' )
or SameText(LExeName, 'MicrosoftEdge' )
or (LeftStr(LExeName, 15 ) = 'microsoft-edge:' )
or ContainsText(LExeName, MSEDGE_APPID);
// プロセス ID を取得.その値からプロセスのハンドル取得
GetWindowThreadProcessId(hWindow, Addr(LProcessID));
LhProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, LProcessID);
try
// プロセスのハンドルから EXE のフルパスを取得
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LSTR_SIZE := Length(LBuffer);
if QueryFullProcessImageNameW(LhProcess,
0 ,
@LBuffer[0 ],
@LSTR_SIZE) = 0 then Exit;
LAppPath := LBuffer;
LAppPath := ExtractFileName(LAppPath);
if LIsEdge then begin
if SameText(LAppPath, 'microsoftedge.exe' )
or SameText(LAppPath, 'msedge.exe' ) then begin
PString(lPar)^ := IntToStr(hWindow);
Result := False;
end ;
end else begin
if RightStr(LExeName, 4 ) <> '.exe' then LExeName := LExeName + '.exe' ;
if SameText(LAppPath, LExeName) then begin
PString(lPar)^ := IntToStr(hWindow);
Result := False;
end ;
end ;
finally
CloseHandle(LhProcess);
end ;
end ;
// -----------------------------------------------------------------------------
// 指定した拡張子に関連づけた実行ファイルのフルパス名を取得する関数
// 指定した拡張子に関連づけた実行ファイルのフルパス名を取得する関数
// AssocQueryString の使用には uses に Winapi.ShLwApi が必要
// -----------------------------------------------------------------------------
function GetRelatedExeName(FileExt: string ): string ;
var
LBuffer : array [0 ..MAX_PAtH-1 ] of Char;
LdwOut : DWORD;
begin
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LdwOut := MAX_PATH;
AssocQueryString(ASSOCF_NOTRUNCATE,
ASSOCSTR_EXECUTABLE,
PChar(FileExt),
nil ,
LBuffer,
@LdwOut);
Result := ExtractFileName(LBuffer);
if Length(Result) = 0 then Result := '' ;
end ;
// -----------------------------------------------------------------------------
// 最初に起動した IE を取得して返す関数
// ShellWindows の使用には uses に SHDocVw が必要
// -----------------------------------------------------------------------------
function GetFirstCreateIEObject: InternetExplorer;
var
LShell : Shell32_TLB.TShell;
LShWindows : ShellWindows;
LIEObj : InternetExplorer;
LExeName : string ;
i : Integer;
begin
LShell := TShell.Create(nil );
try
LShWindows := LShell.Windows as ShellWindows;
Result := nil ;
// ShWindows は起動した順に検出する
for i := 0 to LShWindows.Count - 1 do begin
LIEObj := LShWindows.Item(i) as InternetExplorer;
if LIEObj <> nil then begin
// ExeName の値はエクスプローラなら Explorer.EXE,IE であれば iexplore.exe
LExeName := ExtractFileName(LIEObj.FullName);
if LowerCase(LExeName) = 'iexplore.exe' then begin
// 最初に起動した IE を見つけたら終了
Result := LIEObj;
Break;
end ;
end ;
end ;
finally
FreeAndNil(LShell);
end ;
end ;
end .
03_ TOPMOST なウィンドウの動作確認テスト
上の 2 つのサンプルでは,ウィンドウハンドル取得の確認用に,起動したウェブブラウザを TOPMOST なウィンドウにしています.
TOPMOST なウィンドウは,常に最前面に表示することが可能になウインドウのことです.TOPMOST なウィンドウが複数あれば,それらは他のウィンドウよりも前面に表示できます.実際に最前面に表示可能なのは 1 つだけです.TOPMOST のウインドウを同時に最前面にはできません.この現象を当たり前と思う方もいるかも知れません.しかし,コミュニティの場では,このことを理解していないと思われる質問があることも事実です.
本サンプルは,そのことの確認用です.
起動中のウィンドウを TOPMOST なウィンドウにするには, SetWindowPos
関数を使用します.
Delphi では TForm.FormStyle プロパティの値を fsStayOnTop にすれば TOMOST なウィンドウにすることができます.
まず,アプリを起動する自分自身も,起動するアプリも TOPMOST にしない場合の確認です.これが通常のアプリの起動とも言えます.ここではメモ帳を起動します.
[備考]
TOPMOST なウインドウは,アプリのメインウィンドウで使われることはほとんどありませんが,タスクマネージャの様に設定位可能なアプリもあります.また,ポッププアップ的な表示で使われることがあります.例えばダイアログを表示する関数には,TOPMOST が指定可能なものがあります.
図8
[Button1] クリックでメモ帳を起動
図9
本サンプルのフォームの任意の場所をクリック
フォームか前面に表示される
これが通常のアプリの動作
次に,他のアプリを起動する自分自身も TOPMOST なウィンドウにしてアプリを起動します.
本サンプルではメモ帳を起動しますが,メモ帳はフォームの後ろに表示されます.メモ帳も TOPMOST なウィンドウにすると,メモ帳も本アプリのフォームも最前面に表示できることが確認できます.これ以外のアプリのウィンドウは,これらのウインドウよりも前面には表示できません.
図10
本サンプルのフォームを TOPMOST で起動
図11
[Button2] クリックでメモ帳を TOPMOST にする
メモ帳が最前面に表示される
本サンプルのフォームも前面に表示できる
他のアプリはメモ帳とこのフォームの前面には表示できない
リスト3
TOPMOST なウィンドウの動作確認テスト
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
ShellAPI;
{$R *.dfm}
// =============================================================================
// メモ帳を起動
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LText : string ;
begin
if FindWindow('Notepad' , nil ) > 0 then begin
LText := 'メモ帳は既に起動しています' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end else begin
ShellExecute(Handle, '' , 'Notepad.exe' , nil , nil , SW_SHOW);
end ;
end ;
// =============================================================================
// メモ帳を最前面に表示 (TOPMOST)
// =============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LHandle : HWND;
LFlags : Cardinal;
begin
LHandle := FindWindow('Notepad' , nil );
if LHandle <> 0 then begin
LFlags := SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW;
SetForegroundWindow(LHandle);
SetWindowPos(LHandle, HWND_TOPMOST, 0 , 0 , 0 , 0 , LFlags);
end ;
end ;
// ============== ===============================================================
// CheckBox1 のOnClick イベント処理
// このフォームを TOPMOST または通常の Z オーダにする
// =============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then begin
Self.FormStyle := fsStayOnTop;
end else begin
Self.FormStyle := fsNormal;
end ;
end ;
end .
04_ Microsoft Edge と Google Chrome のクラス名
デスクトップアプリのウィンドウは,ウィンドウのクラス名で検索することができます.Google Chrome ブラウザの (トップレベルの) ウィンドウのクラス名は Chrome_WidgetWin_1 です.本サンプルはこのクラス名のウィンドウを FindWindow 関数で調べます.
Google Chrome は起動しないで,Chromium 版の Microsoft Edge を起動してから本サンプルの TButton をクリックします.すると Google Chrome が起動していることになります.
非 Chromium 版の Microsoft Edge のウィンドウのクラス名は,UWP アプリ共通の〃クラス名です.一方,Chromium 版の Microsoft Edge のウィンドウのクラス名は Google Chrome と同じです.そのため下図の結果となります.ウィンドウのクラス名では Google Chromw と Microsoft Edge は区別できないことになります.
図12
Google Chrome ブラウザが起動しているかをクラス名で確認
起動していることになる
実際に起動しているのは Chromium 版の Microsoft Edge
Google Chrome は起動していない
リスト4
Microsoft Edge と Google Chrome はクラス名では区別できない
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// =============================================================================
// findWindow 関数を使用して,
// Google Chrome のウィンドウのクラス名のウィンドウが起動しているかを確認
// findWindow 関数を使用,
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LText : string ;
begin
if FindWindow('Chrome_WidgetWin_1' , nil ) > 0 then begin
LText := 'Google Chrome' + sLineBreak + '起動しています' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end else begin
LText := 'Google Chrome' + sLineBreak + '起動していません' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONWARNING);
end ;
end ;
end .
05_ 指定 EXE 名のウェブブラウザが起動中かを確認
Windows 10 の UWP アプリを識別するのはアプリケーション識別子 AppUserModelId の値です.デスクトップアプリでアプリケーションを識別するのは,EXE 名です.この EXE 名を使用すれば,その EXE が実行されているかを調べることができます.このことをウェブブラウザのアプリで確認するサンプルです.
EnumWindows 関数の引数に EXE 名を渡します. EnumWindows のコールバック関数内でその EXE のプロセスが生成しいるかを調べて,検出したら 引数にウィンドウハンドルの値を返します.
非 Chromium 版と Chromium 版の Microsoft Edge では,動作確認に使用する EXE 名が違います.非 Chromium 版の場合は microsoftedge.exe を使用します. Chromium 版では MSEdge.exe を使用します.どちらの EXE も非 Chromium 版ではコマンドとしては実行できません.Chromium 版ではどちらもコマンドとして実行して Microsoft Edge を起動することができます.
図13
実行例
対象のウェブブラウザを起動
対象のブラウザ名を選択して [Button1] をクック
リスト5
指定 EXE 名のウェブブラウザが起動中かを確認
ウェブブラウザ以外の EXE の検出も可能
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
RadioGroup1: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
function QueryFullProcessImageNameW(Process: THandle; Flags: DWORD; Buffer: PChar;
Size: PDWORD): DWORD; stdcall ; external 'kernel32.dll' ;
function EnumTopWindowExeName(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
var
Form1: TForm1;
implementation
uses
Winapi.Dwmapi,
System.StrUtils;
{$R *.dfm}
// =============================================================================
// フォーム生成時の処理
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
RadioGroup1.ItemIndex := 0 ;
end ;
// =============================================================================
// 指定 EXE 名のアプリが起動しているかを確認
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LExeName : string ;
LArgName : string ;
LText : string ;
begin
LExeName := '' ;
if RadioGroup1.ItemIndex = 0 then begin
LExeName := 'iexplore.exe' ;
end else
if RadioGroup1.ItemIndex = 1 then begin
LExeName := 'firefox.exe' ;
end else
if RadioGroup1.ItemIndex = 2 then begin
LExeName := 'chrome.exe' ;
end else
if RadioGroup1.ItemIndex = 3 then begin
// 非 Chromium 版の Microsoft Edge が起動しているかの確認用
// 非 Chromium 版は,この EXE 名では起動できない
LExeName := 'microsoftedge.exe' ;
end else
if RadioGroup1.ItemIndex = 4 then begin
// Chromium 版の Microsoft Edge が起動しているかの確認用
LExeName := 'MSEdge.exe' ;
end ;
LArgName := LExeName;
EnumWindows(@EnumTopWindowExeName, LPARAM(@LArgName));
if RadioGroup1.ItemIndex = 3 then LExeName := 'Microsoft Edge' ;
if StrToIntDef(LArgName, 0 ) <> 0 then begin
LText := LExeName + sLineBreak + '起動しています' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end else begin
LText := LExeName + sLineBreak + '起動していません' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONWARNING);
end ;
end ;
// -----------------------------------------------------------------------------
// EnumWindows のコールバック関数
// 引数 (lPar) と同じ EXE 名の EXE が起動しているかを検出
// 検出したらウィンドウハンドルの値を文字列にして引数 lPar に返す
//
// Microsoft Edge の EXE 名は Chromium 版と非 Chromium 版とでは異なる
// 非 Chromium 版では microsoftedge.exe
// Chromium 版では MSEdge.exe
// -----------------------------------------------------------------------------
function EnumTopWindowExeName(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
const
PROCESS_QUERY_LIMITED_INFORMATION = $1000 ;
DWMWA_CLOAKED = 14 ;
var
LExeName : string ;
LCloaked : BOOL;
LProcessID : DWORD;
LhProcess : THandle;
LBuffer : array [0 ..MAX_PATH - 1 ] of Char;
LSTR_SIZE : DWORD;
LAppPath : string ;
begin
Result := True;
LExeName := LowerCase(PString(lPar)^);
if GetWindow(hWindow, GW_OWNER) <> 0 then exit;
if not IsWindowVisible(hWindow) then exit;
// 待機中またはバックグラウンドのウィンドウは対象外
DwmGetWindowAttribute(hWindow, DWMWA_CLOAKED, @LCloaked, SizeOf(LCloaked));
if LCloaked then Exit;
// プロセス ID を取得.その値からプロセスのハンドル取得
GetWindowThreadProcessId(hWindow, Addr(LProcessID));
LhProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, LProcessID);
try
// プロセスのハンドルから EXE のフルパスを取得
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LSTR_SIZE := Length(LBuffer);
if QueryFullProcessImageNameW(LhProcess,
0 ,
@LBuffer[0 ],
@LSTR_SIZE) = 0 then Exit;
LAppPath := LBuffer;
LAppPath := ExtractFileName(LAppPath);
if RightStr(LExeName, 4 ) <> '.exe' then LExeName := LExeName + '.exe' ;
if SameText(LAppPath, LExeName) then begin
PString(lPar)^ := IntToStr(hWindow);
Result := False;
end ;
finally
CloseHandle(LhProcess);
end ;
end ;
end .
本サンプルは任意の EXE に対して利用できます.ただし,検出可能なのはデスクトップアプリの EXE だけです.デスクトップアプリの場合,Delphi のように,EXE 名が同じ別のアプリが複数存在することがありす.そのようなアプリの検出にはフルパス等,ディレクトリ名の一部を判定に使用する必要があります.
Windows 10 の電卓は UWP アプリです.calc または calc.exe で起動できますが,calc.exe が起動しているかを確認することはできません.calc.exe は,UWP アプリの電卓の本体ではありません.calc.exe は,電卓アプリを起動する時のコマンド,shell:AppsFolderMicrosoft.WindowsCalculator_8wekyb3d8bbwe!App のエイリアス (別名) です.
shell:xxx をシェルコスキーム,あるいはシェルコマンドとも言います.
図14
UWP アプリは検出不可
Windows 10 の電卓は Calc.exe で起動可能
ただし,calc.exe は検出できない
// =============================================================================
// 指定 EXE 名のアプリが起動しているかを確認
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LExeName : string ;
LArgName : string ;
LText : string ;
begin
LExeName := 'calc' ;
LArgName := LExeName;
EnumWindows(@EnumTopWindowExeName, LPARAM(@LArgName));
if StrToIntDef(LArgName, 0 ) <> 0 then begin
LText := LExeName + sLineBreak + '起動しています' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end else begin
LText := LExeName + sLineBreak + '起動していません' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONWARNING);
end ;
end ;
06_ Microsoft Edge が起動中かを確認
新旧に関係なく Microsoft Edge が起動中であるかを確認するには,EnumWindows 関数のコールバック関数内で,生成した EXE のプロセスを検出すれば可能です.そのサンプルです.
このサンプルでは,microsoftedge.exe または MSEdge.exe を検出したらコールバック関数の LPARAM にそのウィンドウハンドルの値を渡します.
リスト6
Microsoft Edge が起動中かを確認.EXE 名で確認するコード
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
function QueryFullProcessImageNameW(Process: THandle; Flags: DWORD; Buffer: PChar;
Size: PDWORD): DWORD; stdcall ; external 'kernel32.dll' ;
function EnumTopWindowMSEdge(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
var
Form1: TForm1;
implementation
uses
Winapi.Dwmapi,
System.StrUtils;
{$R *.dfm}
// =============================================================================
// Microsoft Edge が起動しているか確認
// プロセスの EXE 名で判定する方法
//
// Microsoft Edge は以下で起動可能
// MicrosoftEdge.exe, MSEdge.exe は Chromium 版専用
// shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge
// microsoft-edge: (末尾はコロン,またはコロンの後に URL)
// MicrosoftEdge.exe (.exe は省略可)
// MSEge.exe (.exe は省略可)
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LAppName : string ;
LTargetWnd : HWND;
LText : string ;
begin
LAppName := 'Microsoft Edge' ;
LTargetWnd := 0 ;
EnumWindows(@EnumTopWindowMSEdge, LPARAM(@LTargetWnd));
if LTargetWnd <> 0 then begin
LText := LAppName + sLineBreak + '起動しています' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end else begin
LText := LAppName + sLineBreak + '起動していません' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONWARNING);
end ;
end ;
// -----------------------------------------------------------------------------
// EnumWindows のコールバック関数
// EnumWindows のコールバック関数内で Microsoft Edge の検出が必要な場合
// 新旧に関係なく Microsoft Edge が起動しているかを調べたい場合
// 検出したらウィンドウハンドルの値を引数 lPar に返す
//
// Microsoft Edge のプロセスの EXE 名は
// 非 Chromium 版では microsoftedge.exe
// Chromium 版では MSEdge.exe
// -----------------------------------------------------------------------------
function EnumTopWindowMSEdge(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
const
PROCESS_QUERY_LIMITED_INFORMATION = $1000 ;
DWMWA_CLOAKED = 14 ;
var
LCloaked : BOOL;
LProcessID : DWORD;
LhProcess : THandle;
LBuffer : array [0 ..MAX_PATH - 1 ] of Char;
LSTR_SIZE : DWORD;
LAppPath : string ;
begin
Result := True;
if GetWindow(hWindow, GW_OWNER) <> 0 then exit;
if not IsWindowVisible(hWindow) then exit;
// 待機中またはバックグラウンドのウィンドウは対象外
DwmGetWindowAttribute(hWindow, DWMWA_CLOAKED, @LCloaked, SizeOf(LCloaked));
if LCloaked then Exit;
// プロセス ID を取得.その値からプロセスのハンドル取得
GetWindowThreadProcessId(hWindow, @LProcessID);
LhProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, LProcessID);
try
// プロセスのハンドルから EXE のフルパスを取得
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LSTR_SIZE := Length(LBuffer);
if QueryFullProcessImageNameW(LhProcess,
0 ,
@LBuffer[0 ],
@LSTR_SIZE) = 0 then Exit;
LAppPath := LBuffer;
LAppPath := ExtractFileName(LAppPath);
if SameText(LAppPath, 'microsoftedge.exe' )
or SameText(LAppPath, 'msedge.exe' ) then begin
PString(lPar)^ := IntToStr(hWindow);
Result := False;
end ;
finally
CloseHandle(LhProcess);
end ;
end ;
end .
次のように,ウィンドウのクラス名とウィンドウのタイトルに含まれる文字列で判定する方法も考えられます.
リスト7
Microsoft Edge が起動中かを確認.ウインドウのクラス名とタイトル名で確認するコード
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
function QueryFullProcessImageNameW(Process: THandle; Flags: DWORD; Buffer: PChar;
Size: PDWORD): DWORD; stdcall ; external 'kernel32.dll' ;
function EnumTopWindowMSEdge(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
function GetWindowClassName(hWindow: HWND): string ;
function GetWindowTitle(hWindow: HWND): string ;
var
Form1: TForm1;
implementation
uses
Winapi.Dwmapi,
System.StrUtils;
{$R *.dfm}
// =============================================================================
// Microsoft Edge が起動しているか確認
// ウインドウのクラス名とタイトルの文字列で判定する方法
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LAppName : string ;
LTargetWnd : HWND;
LText : string ;
begin
LAppName := 'Microsoft Edge' ;
LTargetWnd := 0 ;
EnumWindows(@EnumTopWindowMSEdge, LPARAM(@LTargetWnd));
if LTargetWnd <> 0 then begin
LText := LAppName + sLineBreak + '起動しています' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONINFORMATION);
end else begin
LText := LAppName + sLineBreak + '起動していません' ;
MessageBox(Handle, PChar(LText), '情報' , MB_TOPMOST or MB_ICONWARNING);
end ;
end ;
// -----------------------------------------------------------------------------
// EnumWindows のコールバック関数
// EnumWindows のコールバック関数内で Microsoft Edge の検出が必要な場合
// 新旧に関係なく Microsoft Edge が起動しているかを調べたい場合
// 検出したらウィンドウハンドルの値を引数 lPar に返す
//
// Midcrosoft Edge のウィンドウのタイトルには以下のどちらかの文字列がある
// microsoft' + #$200B + ' edge
// microsoft edge
//
// タイトルだけだと 他のウィンドウのタイトルにも存在する可能性がある
// 以下のクラス名も判定に使用
// Chromium 版のウィンドウのクラス名は Google Chrome と同じ
// 非 Chromium 版のウィンドウのクラス名は 他の UWP アプリと同じクラス名
// -----------------------------------------------------------------------------
function EnumTopWindowMSEdge(hWindow: HWND; lPar: LPARAM): BOOL; stdcall ;
const
UWP_FRAMEWND = 'ApplicationFrameWindow' ;
CHROME_CLASS = 'Chrome_WidgetWin_1' ;
TITLE_1 = 'microsoft' + #$200B + ' edge' ;
TITLE_2 = 'microsoft edge' ;
PROCESS_QUERY_LIMITED_INFORMATION = $1000 ;
DWMWA_CLOAKED = 14 ;
var
LCloaked : BOOL;
LClass : string ;
LTitle : string ;
begin
Result := True;
if GetWindow(hWindow, GW_OWNER) <> 0 then exit;
if not IsWindowVisible(hWindow) then exit;
// 待機中またはバックグラウンドのウィンドウは対象外
DwmGetWindowAttribute(hWindow, DWMWA_CLOAKED, @LCloaked, SizeOf(LCloaked));
if LCloaked then Exit;
LClass := GetWindowClassName(hWindow);
if (LClass = UWP_FRAMEWND) or (LClass = CHROME_CLASS) then begin
LTitle := GetWindowTitle(hWindow);
if ContainsText(LTitle, TITLE_1 ) or ContainsText(LTitle, TITLE_2) then begin
PNativeUInt(Lpar)^ := hWindow;
Result := False;
end ;
end ;
end ;
// -----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
// -----------------------------------------------------------------------------
function GetWindowClassName(hWindow: HWND): string ;
var
LBuff : array [0 ..MAX_PATH - 1 ] of Char;
begin
Result := '' ;
FillChar(LBuff, SizeOf(LBuff), #0 );
if (GetClassName(hWindow, @LBuff, MAX_PATH) > 0 ) then begin
Result := LBuff;
end ;
end ;
// -----------------------------------------------------------------------------
// ウィンドウのタイトルを取得する関数
// -----------------------------------------------------------------------------
function GetWindowTitle(hWindow: HWND): string ;
var
LBuff : array [0 ..MAX_PATH - 1 ] of Char;
begin
Result := '' ;
FillChar(LBuff, SizeOf(LBuff), #0 );
if (GetWindowText(hWindow, @LBuff, MAX_PATH) > 0 ) then begin
Result := LBuff;
end ;
end ;
end .
07_ Microsoft Edge のウィンドウのタイトル
前項のサンプルコードのコメントに書いておきましたが,Chromium 版の Microsoft Edge のウィンドウのタイトル (キャプション) には,次のように,Microsoft の後に文字コード #$200B があります.この後に半角の空白文字があり,Edge となっています.
Microsoft' + #$200B + ' Edge