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 アプリです．




01_起動したウェブブラウザの終了を待つ


指定したウェブブラウザを起動し，それが終了するまで待つことを可能にする例です．
起動するウェブブラウザを選択して [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 を使用		 
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.



02_起動したウェブブラウザの終了を自動検出


起動したウェブブラウザの終了を自動的に検出可能にするサンプルです．
上のサンプルに CheckRunHandle という関数内関数があります．その関数を定期的に実行すれば，起動したウェブブラウザの終了を検出できますが，ここでは WMI を使用してみました．
アプリの終了の検出には，WMI のイベントシンクを使用しています．一連の処理を別ユニットにして使用する場合は，アプリの終了を検出したらメッセージを送信する方法が考えられます．


図7
ブラウザを閉じるとダイアログ表示

リスト2
ウェブブラウザの起動と，起動したウェブブラウザの終了を自動検出可能にするサンプル
IE の操作用に，タイプライブラリの取り込みで作成した Shell32_TLB を使用
WMI の操作用には，タイプライブラリの取り込みで作成した WbemScripting_TLB を使用		 
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 なウィンドウの動作確認テスト		 
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 はクラス名では区別できない		 
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 の検出も可能		 
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 名で確認するコード		 
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 が起動中かを確認．ウインドウのクラス名とタイトル名で確認するコード		 
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