Delphi Programming / Object Pascal
[掲載 2021年10月01日] [更新 2021年10月02日] Delphi サンプルプログラム集 |
358_インストールされているウェブブラウザ一覧 |
動作確認等 |
Windows 10 ビルド 19042 + Delphi XE5(UP2) Pro VCL-32 |
|
358_Installed_WebBrowser.zip [1.8 MB] 2021年10月02日版 (EXE 同梱) |
システムにインストールされているウェブブラウザを取得して一覧表示するサンプルです.
インストールされているウェブブラウザの情報は,レジストリの以下の場所にあります.そこから情報を取得しています.uses 部の Scripting_TLB は,バージョンを取得するために使用しています.バージョンは,IFileSystem3 インターフェイスを使用して取得しています.このユニットは ZIP 書庫に添付しています. |
HKEY_LOCAL_MACHINE\SOFTWARE\Clients\StartMenuInternet |
|
図1
実行結果
|
リスト1
インストールされているウェブブラウザ一覧 |
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,
Winapi.CommCtrl, Vcl.ImgList, Vcl.ComCtrls;
type
TForm1 = class(TForm)
ImageList1: TImageList;
ListView1: TListView;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
System.Win.Registry,
Scripting_TLB,
Winapi.ShellAPI,
System.StrUtils,
Winapi.ShlObj,
Winapi.ActiveX,
System.RegularExpressions;
{$R *.DFM}
//=============================================================================
// フォーム生成時の処理
// 一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
ImageList1.BkColor := ListView1.Color;
ListView1.ViewStyle := vsReport;
ListView1.SmallImages := ImageList1;
ListView1.RowSelect := True;
ListView1.Columns.Add;
ListView1.Columns[0].Width := 130;
ListView1.Columns[0].Caption := '名前';
ListView1.Columns.Add;
ListView1.Columns[1].Width := 100;
ListView1.Columns[1].Caption := 'バージョン';
ListView1.Columns.Add;
ListView1.Columns[2].Caption := 'EXE パス';
end;
//=============================================================================
// インストールされているウェブプラウさをリスト
// [スタート] メニューに登録されているアプリのみ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LRegistry : TRegistry;
LKeyBase : string;
LKeyList : TStringList;
LKeyCurrent : string;
LAppPath : string;
LFileSystem : Scripting_TLB.IFileSystem3;
LVersion : string;
LpidlPath : PItemIDList;
LSHFileInfo : TSHFileInfo;
LIcon : TIcon;
LItemIndex : Integer;
LIndex : Integer;
begin
ListView1.Items.Clear;
ListView1.Items.BeginUpdate;
LRegistry := TRegistry.Create;
LKeyList := TStringList.Create;
LFileSystem := CoFileSystemObject.Create;
try
LRegistry.Access := KEY_READ;
LRegistry.RootKey := HKEY_LOCAL_MACHINE;
LKeyBase :='SOFTWARE\Clients\StartMenuInternet';
if not LRegistry.OpenKey(LKeyBase, False) then Exit;
LRegistry.GetKeyNames(LKeyList);
LRegistry.CloseKey;
// アプリ名
for LIndex := 0 to LKeyList.Count - 1 do begin
LKeyCurrent := LKeyBase + '\' + LKeyList[LIndex];
LRegistry.OpenKey(LKeyCurrent, False);
ListView1.Items.Add.Caption := LRegistry.ReadString('');
LRegistry.CloseKey;
end;
// EXE のフルパスとバージョン番号
for LIndex := 0 to LKeyList.Count - 1 do begin
LKeyCurrent := LKeyBase + '\' + LKeyList[LIndex] + '\shell\open\command';
LRegistry.OpenKey(LKeyCurrent, False);
LAppPath := LRegistry.ReadString('');
LAppPath := AnsiDequotedStr(LAppPath, '"');
LVersion := LFileSystem.GetFileVersion(LAppPath);
ListView1.Items[LIndex].SubItems.Add(LVersion);
ListView1.Items[LIndex].SubItems.Add(LAppPath);
LRegistry.CloseKey;
LIcon := TIcon.Create;
try
// ファイルのアイコンを取得
SHGetFileInfo(PChar(LAppPath),
0,
LSHFileInfo,
SizeOf(LSHFileInfo),
SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SHELLICONSIZE);
LIcon.Handle := LSHFileInfo.hIcon;
ListView1.Items[LIndex].ImageIndex := ListView1.SmallImages.AddIcon(LIcon);
finally
FreeAndNil(LIcon);
end;
end;
//---------------------------------------------------------
// ここから先は Chromium 版ではない Microsoft Edge 検出用
// 2020年1月以降に Windows 10 を Update していれば不要
//---------------------------------------------------------
for LIndex := 0 to LKeyList.Count - 1 do begin
LAppPath := LKeyList[LIndex];
if ContainsText(LAppPath, 'Microsoft Edge') then begin
LAppPath := 'True';
Break;
end;
end;
if LAppPath = 'True' then Exit;
LRegistry.RootKey := HKEY_CLASSES_ROOT;
LKeyCurrent := 'Local Settings\Software\Microsoft'
+ '\Windows\CurrentVersion\AppModel\Repository\Packages';
if not LRegistry.OpenKey(LKeyCurrent, False) then Exit;
LRegistry.GetKeyNames(LKeyList);
LRegistry.CloseKey;
for LIndex := 0 to LKeyList.Count - 1 do begin
if not ContainsText(LKeyList[LIndex], 'Microsoft.MicrosoftEdge_') then Continue;
if not ContainsText(LKeyList[LIndex], '8wekyb3d8bbwe') then Continue;
ListView1.Items.Add.Caption := 'Microsoft Edge';
LItemIndex := ListView1.Items.Count - 1;
LVersion := TRegEx.Match(LKeyList[LIndex], '_(.+?)_').Value;
LVersion := ReplaceText(LVersion, '_', '');
ListView1.Items[LItemIndex].SubItems.Add(LVersion);
LAppPath := 'Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge';
ListView1.Items[LItemIndex].SubItems.Add( 'shell:AppsFolder\' + LAppPath);
LRegistry.CloseKey;
LpidlPath := nil;
LIcon := TIcon.Create;
try
// 項目識別子を使用してアイコンを取得
LAppPath := 'shell:AppsFolder\' + LAppPath;
LpidlPath := ILCreateFromPath(PChar(LAppPath));
SHGetFileInfo(Pointer(LpidlPath),
0,
LSHFileInfo,
SizeOf(LSHFileInfo),
SHGFI_PIDL or SHGFI_ICON or SHGFI_SMALLICON);
LIcon.Handle := LSHFileInfo.hIcon;
ListView1.Items[LItemIndex].ImageIndex := ListView1.SmallImages.AddIcon(LIcon);
finally
FreeAndNil(LIcon);
CoTaskMemFree(LpidlPath);
end;
Break;
end;
finally
FreeAndNil(LRegistry);
FreeAndNil(LKeyList);
LFileSystem := nil;
ListView1.Items.EndUpdate;
end;
end;
//=============================================================================
// TListView の OnDblClick イベント
// ダブルクリックしたら選択しているアプリを起動
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
LItem : TListItem;
LExePath : string;
begin
LItem := ListView1.Selected;
if LItem = nil then Exit;
//
LExePath := LItem.SubItems[1];
ShellExecute(0, '', PChar(LExePath), nil, nil, SW_SHOW);
end;
//=============================================================================
// フォームの幅を変更したらカラムの幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
ListView1.Columns[2].Width := ListView1.ClientWidth
- ListView1.Columns[0].Width
- ListView1.Columns[1].Width;
end;
end.
2020年1月に Microsoft Edge は,Google の Chromium をベースとしたブラウザになりました.Microsoft Edge は,Windows の Update の際,自動的に Chromium 版に更新されるようになっています.
現在のシステムで有効な Microsoft Edge が Chromium 版であるかは,アイコン画像で確認できます.下図を参考にしてください. |
|
図2
Chromium 版の Microsoft Edge |
|
図3
Chromium 版ではない Microsoft Edge
- Chromium 版の Microsoft Edge には,この AppUserModelId に相当するアイコン画像はない
|
02_Microsoft Edge を ShellExecute 関数で起動 |
ShellExecute 関数等を使用して Microsoft Edge を起動する例です.以下の URL スキームの場合,ウェブブラウザからも起動できます.URL スキームでは非 Chromium 版の Microsoft Edge も Chromium 版の Microsoft Edge も起動できます.MSEdge コマンドの場合,非 Chromium 版の Microsoft Edge は起動できません. |
リスト2
Microsoft Edge を ShellExecute 関数で起動 |
implementation
uses
Winapi.ShellAPI;
{$R *.DFM}
//=============================================================================
// Microoft Edge を ShellExecute 関数で起動する
//
// コマンドとして以下が使用できる
// (1) microsoft-edge: (末尾はコロンまたはコロンの後に URL)
// (2) shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge
// (3) MSEdge (Chromium 版専用)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LShellItem : string;
LParameter : string;
begin
LShellItem := 'MSEdge';
LParameter := 'http://mrxray.on.coocan.jp/';
ShellExecute(0, '', PChar(LShellItem), PChar(LParameter), nil, SW_SHOW);
end;
|