unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Generics.Collections, Generics.Defaults;

type
  TAppInfo = record
    DisplayName     : string;
    InstallLocation : string;
    UninstallString : string;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    function Is64bitWindows: Boolean;
  public
    { Public 宣言 }
    FAppList : TList<TAppInfo>;
  end;

var
  Form1: TForm1;

implementation

uses
  Registry,
  StrUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  ジェネリックスのTListを生成
//  リストに格納するのは各アプリの情報を格納するレコード型
//
// ジェネリックスの使用にはusesにGenerics.Collectionsが必要 
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FAppList := TList<TAppInfo>.Create;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FAppList);
end;

//=============================================================================
//  インストール済みのアプリの一覧をレコード型に格納して一覧表示
//  正確にはHKEY_LOCAL_MACHINEの以下のキーの階層下のキーの項目を検索
//  (それらのキーのサブキーは検索しない - 再帰的な検索はしない)
//
//  64ビットWindowsの場合は以下の2つの場所
//  SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
//  SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall
//
//  32ビットWindowsの場合は以下の場所
//  SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
//
//  レコード型に格納するのは各キーの以下の項目の値
//  Windowsのセキュリティ用の更新ソフト(KBXXXX)は除外
//  DisplayName
//  InstallLocation
//  UninstallString
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  引数のARegKey内のサブキー内の項目を検索
  //  ジェネリックのTListに各アプリの情報をレコード型として格納
  //---------------------------------------------------------------------------
  procedure GetAppInfo(AReg: TRegistry; ARegKey: string; AList: TList<TAppInfo>);
  var
    LKeyNameList : TStringList;
    LKeyEachApp  : string;
    LDisplayName : string;
    LInstLocate  : string;
    LUninstStr   : string;
    LLoopCnt     : Integer;
    LAppInfo     : TAppInfo;
  begin
    LKeyNameList := TStringList.Create;
    try
      if not AReg.OpenKey(ARegKey, False) then exit;
      // ARegKey階層下のキー名の一覧を取得
      AReg.GetKeyNames(LKeyNameList);

      AReg.CloseKey;
      // キー名の一覧の各キーの項目を調べる
      for LLoopCnt := 0 to LKeyNameList.Count - 1 do begin
        try
          LKeyEachApp := ARegKey + PathDelim + LKeyNameList[LLoopCnt];
          if AReg.OpenKey(LKeyEachApp, False) then begin
            if not AReg.ValueExists('DisplayName') then Continue;
            if not AReg.ValueExists('UninstallString') then Continue;

            LDisplayName := AReg.ReadString('DisplayName');
            if ContainsText(LDisplayName, '(KB') then Continue;
            LUninstStr := AReg.ReadString('UninstallString');

            if not AReg.ValueExists('InstallLocation') then begin
              LInstLocate  := '';
            end else begin
              LInstLocate  := AReg.ReadString('InstallLocation');
            end;

            if (LDisplayName <> '') and (LUninstStr <> '') then begin
              LAppInfo.DisplayName     := LDisplayName;
              LAppInfo.InstallLocation := LInstLocate;
              LAppInfo.UninstallString := LUninstStr;
              AList.Add(LAppInfo);
            end;
          end;
        finally
          AReg.CloseKey;
        end;
      end;
    finally
      FreeAndNil(LKeyNameList);
    end;
  end;
  //---------------------------------------------------------------------------

var
  LRegistry    : TRegistry;
  LKeyUnInst   : String;
  LAppInfo     : TAppInfo;
  LDisplayName : string;
  LInstLocate  : string;
  LLoopCnt     : Integer;
begin
  Memo1.Lines.Clear;

  LRegistry := TRegistry.Create;
  try
    if Is64bitWindows then begin
      // 64ビットWindowsの場合
      LRegistry.Access  := KEY_READ or KEY_WOW64_32KEY;
      LRegistry.RootKey := HKEY_LOCAL_MACHINE;
      LKeyUnInst := 'Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
      GetAppInfo(LRegistry, LKeyUnInst, FAppList);
      LRegistry.CloseKey;

      LRegistry.Access := KEY_READ or KEY_WOW64_64KEY;
      LKeyUnInst := 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
      GetAppInfo(LRegistry, LKeyUnInst, FAppList);
    end else begin
      // 32ビットWindowsの場合
      LRegistry.Access  := KEY_READ;
      LRegistry.RootKey := HKEY_LOCAL_MACHINE;
      LKeyUnInst := 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
      GetAppInfo(LRegistry, LKeyUnInst, FAppList);
    end;
    LRegistry.CloseKey;

    //-------------------------------------------------------------------------
    //  リストのソート
    //  TComparer関係の使用にはusesにGenerics.Defaultsが必要
    //-------------------------------------------------------------------------
    FAppList.Sort(TComparer<TAppInfo>.Construct(
      function(const Left, Right: TAppInfo): Integer
      begin
        //DisplayNameの値でソート
        Result := SysUtils.CompareText(Left.DisplayName, Right.DisplayName);
      end)
    );
    //-------------------------------------------------------------------------

    // 重複項目を削除
    for LLoopCnt := FAppList.Count - 2 downto 0 do begin
      LDisplayName := FAppList[LLoopCnt].DisplayName;
      LInstLocate  := FAppList[LLoopCnt].InstallLocation;
      if (LDisplayName = FAppList[LLoopCnt + 1].DisplayName)
          and (LInstLocate = FAppList[LLoopCnt + 1].InstallLocation) then begin
        FAppList.Delete(LLoopCnt + 1);
      end;
    end;


    // DisplayNameだけを一覧表示
    // [プログラムのアンインストールまたは変更]のリストとほぼ同じ 
    Memo1.Lines.BeginUpdate;
    for LAppInfo in FAppList do begin
      Memo1.Lines.Add(LAppInfo.DisplayName);
    end;
    Memo1.Lines.EndUpdate;

    Label1.Caption := IntToStr(FAppList.Count);
  finally
    FreeAndNil(LRegistry);
  end;
end;

//-----------------------------------------------------------------------------
//  32ビットのWindowsか64ビットのWindowsかを調べる関数
//  64ビット版のWindowsの場合はTrueを返す
//-----------------------------------------------------------------------------
function TForm1.Is64bitWindows: Boolean;
var
  Wow64Proc : function(hProcess: THandle; var Wow64: BOOL): BOOL stdcall;
  RetFlag   : LongBool;
begin
  @Wow64Proc := GetProcAddress(GetModuleHandle('Kernel32.dll'), 'IsWow64Process');
  if @Wow64Proc <> nil then begin
    Wow64Proc(GetCurrentProcess, RetFlag);

    if SizeOf(THandle) = 4 then begin
      Result := RetFlag;
    end else
    if SizeOf(THandle) = 8 then begin
      Result := True;
    end;
  end else begin
    //Windows XPの64ビット版か
    Result := CheckWin32Version(5, 2);
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Generics.Collections, Generics.Defaults;

type
  TDelphiVerInfo = record
    ProductVer  : Double;
    AppFullPath : string;
    RegKeyBase  : string;
    VersionStr  : string;
    Enable64bit : Boolean;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FAppList : TList<TDelphiVerInfo>;
  end;

  procedure GetDelphiVerList(AList: TList<TDelphiVerInfo>);

var
  Form1: TForm1;

implementation

uses
  Registry,
  StrUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  ジェネリックスのリストを生成
//  リストに格納するのはDephiの各バージョンの情報を格納するレコード型
//
// ジェネリックスの使用にはusesにGenerics.Collectionsが必要 
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FAppList := TList<TDelphiVerInfo>.Create;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FAppList);
end;

//=============================================================================
//  インストール済みのDelphiの各バージョンの情報を取得して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LAppInfo : TDelphiVerInfo;
begin
  Memo1.Lines.Clear;
  FAppList.Clear;

  GetDelphiVerList(FAppList);

  Memo1.Lines.BeginUpdate;
  for LAppInfo in FAppList do begin
    Memo1.Lines.Add(LAppInfo.VersionStr);
    Memo1.Lines.Add('ProductVersion ' + FloatToStr(LAppInfo.ProductVer));
    Memo1.Lines.Add(LAppInfo.AppFullPath);
    Memo1.Lines.Add(LAppInfo.RegKeyBase);
    if LAppInfo.Enable64bit then begin
      Memo1.Lines.Add('Enable 64 bit Application');
    end;
    Memo1.Lines.Add('');
  end;
  Memo1.Lines.EndUpdate;

  Label1.Caption := IntToStr(FAppList.Count);
end;

//-----------------------------------------------------------------------------
//  インストール済みDelphiの各バージョンの情報をジェネリックスのリストに格納
//  リストに格納するのはDephiの各バージョンの情報を格納するレコード型
//-----------------------------------------------------------------------------
procedure GetDelphiVerList(AList: TList<TDelphiVerInfo>);

  procedure InitializeRecord(var AInfo: TDelphiVerInfo);
  begin
    AInfo.ProductVer  := 0.0;
    AInfo.AppFullPath := 'Empty';
    AInfo.RegKeyBase  := 'Empty';
    AInfo.VersionStr  := 'Empty';
    AInfo.Enable64bit := False;
  end;

const
  LArrayBDS : array [0..2] of string
              = ('\Borland\BDS', '\CodeGear\BDS', '\Embarcadero\BDS');
var
  LRegistry    : TRegistry;
  LKeyBDS      : string;
  LKeyEeachVer : string;
  LKeyNameList : TStringList;
  LKeyItemList : TStringList;
  LAppInfo     : TDelphiVerInfo;
  LTempValue   : string;
  LLoopCnt     : Integer;
  LLoopBDS     : Integer;
begin
  AList.Clear;

  LRegistry    := TRegistry.Create;
  LKeyNameList := TStringList.Create;
  LKeyItemList := TStringList.Create;

  try
    LRegistry.Access  := KEY_READ;
    LRegistry.RootKey := HKEY_LOCAL_MACHINE;

    //-------------------------------------------------------------------------
    // Delphi 2 - 7
    // Delphi 4 までは最初の項目がDelphi のバージョン文字列
    // Delphi 5 からは項目名の App がEXEのフルパス
    //-------------------------------------------------------------------------
    LKeyBDS := 'Software\Borland\Delphi';

    if LRegistry.OpenKey(LKeyBDS, False) then begin
      // 現在のキーの階層下のキー名の一覧を取得
      // このキーがDelphiの各バージョンごとのキー
      LRegistry.GetKeyNames(LKeyNameList);

      for LLoopCnt := 0 to LKeyNameList.Count - 1 do begin
        LKeyEeachVer := LKeyBDS + PathDelim + LKeyNameList[LLoopCnt];

        LRegistry.CloseKey;
        InitializeRecord(LAppInfo);

        if LRegistry.OpenKey(LKeyEeachVer, False) then begin
          LAppInfo.ProductVer := StrToFloat(LKeyNameList[LLoopCnt]);

          if LAppInfo.ProductVer < 5.0 then begin
            // 現在のDelphiのキー名の各項目名(名前:レジストリエントリ)一覧を取得
            LRegistry.GetValueNames(LKeyItemList);
            if LKeyItemList.Count < 1 then Continue;
            LAppInfo.AppFullPath  := LRegistry.ReadString(LKeyItemList[0]);
          end else begin
            if not LRegistry.ValueExists('App') then Continue;
            LAppInfo.AppFullPath := LRegistry.ReadString('App');
          end;

          // Delphi のバージョン文字列の作成
          // 小数点以下が 0 の時は整数部だけとする
          LTempValue := Trim(LKeyNameList[LLoopCnt]);
          if RightStr(LTempValue, 2) = '.0' then begin
            LTempValue := LeftStr(LTempValue, 1);
          end;

          LAppInfo.VersionStr := 'Delphi ' + LTempValue;
          LAppInfo.RegKeyBase := LKeyEeachVer;

          // ジェネリックスのリストにレコード型のデータを追加
          AList.Add(LAppInfo);
        end;
      end;
    end;
    LRegistry.CloseKey;


    //-------------------------------------------------------------------------
    // Delphi 2005 以降
    //-------------------------------------------------------------------------
    for LLoopBDS := 0 to Length(LArrayBDS) - 1 do begin
      LKeyBDS := 'Software' + LArrayBDS[LLoopBDS];

      if LRegistry.OpenKey(LKeyBDS, False) then begin
        // 現在のキーの階層下のキー名の一覧を取得
        // このキーがDelphiの各バージョンごとのキー
        LRegistry.GetKeyNames(LKeyNameList);

        for LLoopCnt := 0 to LKeyNameList.Count - 1 do begin
          LKeyEeachVer := LKeyBDS + PathDelim + LKeyNameList[LLoopCnt];

          LRegistry.CloseKey;
          InitializeRecord(LAppInfo);

          if LRegistry.OpenKey(LKeyEeachVer, False) then begin
            if not LRegistry.ValueExists('App') then Continue;
            LAppInfo.AppFullPath := LRegistry.ReadString('App');

            if LRegistry.ValueExists('ProductVersion') then begin
              LAppInfo.ProductVer := StrToFloat(LRegistry.ReadString('ProductVersion'));
            end;

            LRegistry.CloseKey;
            // Delphi XE,Delphi XE5,..等の文字列を取得
            if LRegistry.KeyExists(LKeyEeachVer + '\Personalities') then begin
              if LRegistry.OpenKey(LKeyEeachVer + '\Personalities', False) then begin
                if LRegistry.ValueExists('Delphi.Win32') then begin
                  LAppInfo.VersionStr := LRegistry.ReadString('Delphi.Win32');
                end;
              end;
            end;

            LAppInfo.RegKeyBase := LKeyEeachVer;

            // 64 ビットの開発が可能かを調査
            if ContainsText(LKeyBDS, 'Embarcadero\BDS') then begin
              LRegistry.CloseKey;
              if LRegistry.KeyExists(LKeyEeachVer + '\Library\Win64') then begin
                // 64ビット用のWindowsアプリが開発可能な場合はTrue
                LAppInfo.Enable64bit := True;
              end else begin
                LAppInfo.Enable64bit := False;
              end;
            end;

            AList.Add(LAppInfo);
          end;
        end;
      end;
      LRegistry.CloseKey;
    end;

    //---------------------------------------------------------
    //  プロダクトバージョンの値でリストをソート
    //  TComparer関係の使用にはusesにGenerics.Defaultsが必要
    //---------------------------------------------------------
    AList.Sort(TComparer<TDelphiVerInfo>.Construct(
      function(const Left, Right: TDelphiVerInfo): Integer
      begin
        Result := Trunc((Left.ProductVer - Right.ProductVer) * 10);
      end)
    );
  finally
    FreeAndNil(LRegistry);
    FreeAndNil(LKeyNameList);
    FreeAndNil(LKeyItemList);
  end;
end;

end.

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.ShellAPI,  Winapi.ActiveX, Winapi.ShlObj, Winapi.CommCtrl, Vcl.ImgList,
   Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    ListView1: TListView;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  function GetDispNameFromPItemID(ShFolder: IShellFolder; ItemID:
    PItemIDList; Flag: DWORD=SHGDN_NORMAL): string;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.BkColor    := ListView1.Color;
  ListView1.ViewStyle   := vsReport;
  ListView1.SmallImages := ImageList1;

  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 200;

  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := 'AppUserModelId';
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  仮想フォルダ AppsFolder 内のリストを取得 
//  ( アプリ名と AppUserModelId の値を列挙 )
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPath        : WideString;
  LSHDesktop   : IShellFolder;
  LSHAppFolder : IShellFolder;
  LpidlRoot    : PItemIDList;
  LAppIdList   : IEnumIDList;
  LFetched     : Cardinal;
  LpidlChild   : PItemIDList;
  LAppName     : string;
  LAppIDPath   : string;
  LpidlFull    : PItemIDList;
  LSHFileInfo  : TSHFileInfo;
  LIcon        : TIcon;
  LListItem    : TListItem;
begin
  Screen.Cursor := crHourGlass;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;
  ListView1.Items.BeginUpdate;

  LpidlRoot   := nil;
  LpidlChild  := nil;

  LPath := 'shell:AppsFolder';
  try
    // ファイルを項目識別子に変換
    LpidlRoot := ILCreateFromPath(PChar(LPath));
    if ILIsEmpty(LpidlRoot) then Exit;

    // 対象の項目識別子を[デスクトップ]のシェルフォルダオブジェクトにバインド
    // 対象のフォルダの IShellFolder オブジェクトが取得できる
    SHGetDesktopFolder(LSHDesktop);
    LSHDesktop.BindToObject(LpidlRoot, nil, IShellFolder, Pointer(LSHAppFolder));

    // ファイル (項目識別子) のリストを取得
    LSHAppFolder.EnumObjects(Handle, SHCONTF_NONFOLDERS, LAppIdList);

    // リストの各項目の表示名を調べる
    // ここで取得した項目識別子は解放しないこと
    LAppIdList.Reset;
    while (LAppIdList.Next(1, LpidlChild, LFetched) = S_OK) do begin
      LAppName := GetDispNameFromPItemID(LSHAppFolder, LpidlChild, SHGDN_NORMAL);
      if LAppName = '' then Continue;

      LAppIDPath := GetDispNameFromPItemID(LSHAppFolder, LpidlChild, SHGDN_FORPARSING);
      if LAppIDPath = '' then Continue;

      LListItem         := ListView1.Items.Add;
      LListItem.Caption := LAppName;
      LListItem.SubItems.Add(LAppIDPath);

      // ファイルの項目識別子の値からアイコンを取得
      LpidlFull := ILCombine(LpidlRoot, LpidlChild);
      SHGetFileInfo(Pointer(LpidlFull),
                    0,
                    LSHFileInfo,
                    SizeOf(TSHFileInfo),
                    SHGFI_PIDL or SHGFI_ICON or SHGFI_SMALLICON);
      LIcon := TIcon.Create;
      try
        LIcon.Handle := LSHFileInfo.hIcon;
        LListItem.ImageIndex := ListView1.SmallImages.AddIcon(LIcon);
      finally
        FreeAndNil(LIcon);
        CoTaskMemFree(LpidlFull);
      end;
    end;
  finally
    LSHDesktop := nil;
    LSHAppFolder := nil;
    CoTaskMemFree(LpidlRoot);
    Screen.Cursor := crDefault;
  end;

  ListView1.SortType := stText;
  ListView1.Items.EndUpdate;
  FormResize(nil);
end;

//=============================================================================
//  表示しているアプリ名と AppUserModelId の値をクリップボードにコピー
//  TAB 区切りテキスト．エクセルに貼り付け可能
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  Lindex   : Integer;
begin
  LStrList := TStringList.Create;
  try
    for Lindex := 0 to ListView1.Items.Count -1 do begin
      LText := ListView1.Items[Lindex].Caption + Char(VK_TAB)
             + ListView1.Items[Lindex].SubItems[0];
      LStrList.Add(LText);
    end;
    Clipboard.AsText := LStrList.Text;
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  TListView の OnDblClick イベント
//  ダブルクリックしたら選択しているアプリを起動
//  本 EXE が 32 ビットの場合，起動しない 64 ビットのアプリがある
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  LItem  : TListItem;
  LAppId : string;
begin
  LItem := ListView1.Selected;
  if LItem = nil then Exit;

  LAppId := 'shell:AppsFolder' + PathDelim + Litem.SubItems[0];
  ShellExecute(0, '', PChar(LAppId), nil, nil, SW_SHOW);
end;

//=============================================================================
//  TListView の OnSelectItem イベント
//  TListView の Item を選択したら AppUserModelId の値を TEdit に表示
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Item = nil then Exit;
  Edit1.Text := Item.SubItems[0];
end;

//=============================================================================
//  フォームの幅を変更したらカラムの幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
end;

//-----------------------------------------------------------------------------
//  相対項目識別子からフォルダまたはファイル名を求める
//  仮想フォルダは GUID 文字列として求まる
//
//  第 1 引数  対象の項目識別子を取得する際に使用したシェルフォルダオブジェクト
//  第 2 引数  対象の項目識別子．ShFolder 階層下の相対値
//  第 3 引数  フルパスを取得する場合は，SHGDN_FORPARSING
//             ファイル名だけ取得する場合は，SHGDN_NORMAL また はSHGDN_INFOLDER
//-----------------------------------------------------------------------------
function GetDispNameFromPItemID(ShFolder: IShellFolder; ItemID:
  PItemIDList; Flag: DWORD=SHGDN_NORMAL): string;
var
  StrRet : TStrRet;
begin
  Result := '';
  if ShFolder = nil then exit;
  if ItemID = nil then exit;

  FillChar(StrRet, SizeOf(StrRet), 0);
  if NOERROR = ShFolder.GetDisplayNameOf(ItemID, Flag, StrRet) then begin
    Result := StrRet.pOleStr;
  end;
end;

end.

  if Litem.SubItems[0] = 'Chrome' then begin
    LAppId := Litem.SubItems[0];
  end else begin
    LAppId := 'shell:AppsFolder' + PathDelim + Litem.SubItems[0];
  end;
  ShellExecute(0, '', PChar(LAppId), nil, nil, SW_SHOW);

//=============================================================================
//  Delphi 6 / Delphi 7 を起動するとエラーが発生する
//  このコードの実行には uses に Winapi.ShellAPI が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilepath : string;
begin
  LFilepath := 'C:\Program Files (x86)\Borland\Delphi6\Bin\delphi32.exe';
  ShellExecute(0, '', PChar(LFilepath), nil, nil, SW_SHOW);
end;

//=============================================================================
//  TListView の OnCompare イベント
//  Unicode の文字列としてソートする
//
//  TListView.SortType := stBoth にして，このイベントで
//  CompareText (System.SysUtils) 関数を使用してソートする
//=============================================================================
procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
  Compare := CompareText(Item1.Caption, Item2.Caption)
end;

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.ShellAPI,  Winapi.ActiveX, Winapi.ShlObj, Winapi.CommCtrl, Vcl.ImgList,
   Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    ListView1: TListView;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.BkColor    := ListView1.Color;
  ListView1.ViewStyle   := vsReport;
  ListView1.SmallImages := ImageList1;

  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 200;

  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := 'AppUserModelId';
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  仮想フォルダ AppsFolder 内のリストを取得 
//  ( アプリ名と AppUserModelId の値を列挙 )
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPath        : WideString;
  LpidlRoot    : PItemIDList;
  LShItemRoot  : IShellItem;
  LShItemChild : IShellItem;
  LEnumItems   : IEnumShellItems;
  LFetched     : LongInt;
  LAppName     : PWideChar;
  LAppIDPath   : PWideChar;
  LpidlFull    : PItemIDList;
  LSHFileInfo  : TSHFileInfo;
  LIcon        : TIcon;
  LListItem    : TListItem;
begin
  Screen.Cursor := crHourGlass;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;
  ListView1.Items.BeginUpdate;

  LpidlRoot    := nil;
  LShItemRoot  := nil;
  LShItemChild := nil;

  LPath := 'shell:AppsFolder';
  try
    // ファイルを項目識別子に変換
    LpidlRoot := ILCreateFromPath(PChar(LPath));
    if ILIsEmpty(LpidlRoot) then Exit;

    // フォルダの IShellItem オブジェクトを取得
    SHCreateItemFromIDList(LpidlRoot, IShellItem, LShItemRoot);

    // ファイル (IShellItem のリストを LEnumItems として取得
   LShItemRoot.BindToHandler(nil, BHID_EnumItems, IEnumShellItems, LEnumItems);

    // リストの各項目の表示名を調べる
    while (LEnumItems.Next(1, LShItemChild, @LFetched) = S_OK) do begin
      LShItemChild.GetDisplayName(SIGDN_NORMALDISPLAY, LAppName);
      if StrLen(LAppName) = 0 then Continue;
      LShItemChild.GetDisplayName(SIGDN_DESKTOPABSOLUTEPARSING, LAppIDPath);
    if StrLen(LAppIDPath) = 0 then Continue;

      LListItem         := ListView1.Items.Add;
      LListItem.Caption := LAppName;
      LListItem.SubItems.Add(LAppIDPath);

      // ファイルの項目識別子の値からアイコンを取得
      LPath := LAppIDPath;
      LPath := 'shell:AppsFolder' + PathDelim + LPath;
      LpidlFull := ILCreateFromPath(PWideChar(LPath));
      SHGetFileInfo(Pointer(LpidlFull),
                    0,
                    LSHFileInfo,
                    SizeOf(TSHFileInfo),
                    SHGFI_PIDL or SHGFI_ICON or SHGFI_SMALLICON);
      LIcon := TIcon.Create;
      try
        LIcon.Handle := LSHFileInfo.hIcon;
        LListItem.ImageIndex := ListView1.SmallImages.AddIcon(LIcon);
      finally
        FreeAndNil(LIcon);
        LShItemChild := nil;
        CoTaskMemFree(LpidlFull);
      end;
    end;
  finally
    LEnumItems := nil;
    LShItemRoot := nil;
    CoTaskMemFree(LpidlRoot);
    Screen.Cursor := crDefault;
  end;

  ListView1.SortType := stText;
  ListView1.Items.EndUpdate;
  FormResize(nil);
end;

//=============================================================================
//  表示しているアプリ名と AppUserModelId の値をクリップボードにコピー
//  TAB 区切りテキスト．エクセルに貼り付け可能
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  Lindex   : Integer;
begin
  LStrList := TStringList.Create;
  try
    for Lindex := 0 to ListView1.Items.Count -1 do begin
      LText := ListView1.Items[Lindex].Caption + Char(VK_TAB)
             + ListView1.Items[Lindex].SubItems[0];
      LStrList.Add(LText);
    end;
    Clipboard.AsText := LStrList.Text;
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  TListView の OnDblClick イベント
//  ダブルクリックしたら選択しているアプリを起動
//  本 EXE が 32 ビットの場合，起動しない 64 ビットのアプリがある
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  LItem  : TListItem;
  LAppId : string;
begin
  LItem := ListView1.Selected;
  if LItem = nil then Exit;

  LAppId := 'shell:AppsFolder' + PathDelim + Litem.SubItems[0];
  ShellExecute(0, '', PChar(LAppId), nil, nil, SW_SHOW);
end;

//=============================================================================
//  TListView の OnSelectItem イベント
//  TListView の Item を選択したら AppUserModelId の値を TEdit に表示
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Item = nil then Exit;
  Edit1.Text := Item.SubItems[0];
end;

//=============================================================================
//  フォームの幅を変更したらカラムの幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
end;

end.

implementation

uses
  Shell32_TLB;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption    := 'AppUserModelId 一覧';

  ListView1.ViewStyle   := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 230;
  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := 'AppUserModelId';
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  TShell を使用して仮想フォルダ AppsFolder 内のリストを取得 
//  ( アプリ名と AppUserModelId の値を列挙 )
//
//  処理が非常に遅いコード
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LShell       : Shell32_TLB.TShell;
  LShellFolder : Shell32_TLB.Folder;
  LFolderItem  : Shell32_TLB.FolderItem;
  LListItem    : TListItem;
  LIndex       : Integer;
begin
  Screen.Cursor := crHourGlass;
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;

  LShell := TShell.Create(Self);
  try
    LShellFolder := LShell.NameSpace('shell:AppsFolder');

    for LIndex := 0 to LShellFolder.Items.Count - 1 do begin
      LFolderItem := LShellFolder.Items.Item(LIndex);

      LListItem := ListView1.Items.Add;
      LListItem.Caption := LFolderItem.Name;
      LListItem.SubItems.Add(LFolderItem.Path);
    end;
  finally
    FreeAndNil(LShell);
  end;
  ListView1.SortType := stText;
  ListView1.Items.EndUpdate;
  Screen.Cursor := crDefault;
end;

implementation

uses
  Shell32_TLB;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption    := 'AppUserModelId 一覧';

  ListView1.ViewStyle   := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 230;
  ListView1.Columns.Add;
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
  ListView1.Columns[1].Caption := 'AppUserModelId';
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  仮想フォルダ AppsFolder 内のリストを取得 
//  ( TShell を使用してアプリ名と AppUserModelId の値を列挙 )
//
//  処理が速いコード
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LShell       : Shell32_TLB.TShell;
  LFolderItems : Shell32_TLB.FolderItems;
  LFolderItem  : Shell32_TLB.FolderItem;
  LListItem    : TListItem;
  LIndex       : Integer;
begin
  Screen.Cursor := crHourGlass;
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;

  LShell := TShell.Create(Self);
  try
    // あらかじめリストを作成しておく
    LFolderItems := LShell.NameSpace('shell:AppsFolder').Items;

    for LIndex := 0 to LFolderItems.Count - 1 do begin
      LFolderItem := LFolderItems.Item(LIndex);

      LListItem := ListView1.Items.Add;
      LListItem.Caption := LFolderItem.Name;
      LListItem.SubItems.Add(LFolderItem.Path);
    end;
  finally
    FreeAndNil(LShell);
  end;
  ListView1.SortType := stText;
  ListView1.Items.EndUpdate;
  Screen.Cursor := crDefault;
end;

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.ShellAPI,  Winapi.ActiveX, Winapi.ShlObj, Winapi.CommCtrl, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Generics.Collections,
  Generics.Defaults,
  Shell32_TLB;

{$R *.DFM}

type
  PAppIdItem = ^TAppIdItem;
  TAppIdItem = Record
    AppName : string;
    AppID   : string;
    IconIdx : Integer;
  end;

var
  FAppIDList : TList<TAppIdItem>;

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo : TSHFileInfo ;
  LhImgList   : THandle;
begin
  Self.Caption    := 'AppUserModelId 一覧';

  ListView1.ViewStyle   := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 230;
  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := 'AppUserModelId';

  FAppIDList := TList<TAppIdItem>.Create;

  // システムのイメージリストのハンドルを取得
  LhImgList := SHGetFileInfo('',
                             0,
                             LSHFileInfo,
                             SizeOf(LSHFileInfo),
                             SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX);
  ListView_SetImageList(ListView1.Handle, LhImgList, LVSIL_SMALL);
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FAppIDList);
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  仮想フォルダ AppsFolder 内のリストを取得 
//  ( アプリ名と AppUserModelId の値を列挙 )
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPath        : WideString;
  LAppItem     : TAppIdItem;
  LShell       : Shell32_TLB.TShell;
  LFolderItems : Shell32_TLB.FolderItems;
  LFolderItem  : Shell32_TLB.FolderItem;
  LIndex       : Integer;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;

  FAppIDList.Clear;

  LPath := 'shell:AppsFolder';

  LShell := TShell.Create(Self);
  try
    LFolderItems := LShell.NameSpace(LPath).Items;

    for LIndex := 0 to LFolderItems.Count - 1 do begin
      LFolderItem := LFolderItems.Item(LIndex);

      LAppItem.AppName := LFolderItem.Name;
      LAppItem.AppID   := LFolderItem.Path;
      LAppItem.IconIdx := -1;
      FAppIDList.Add(LAppItem);
    end;
  finally
    FreeAndNil(LShell);
  end;

    //----------------------------------------------------
    //  リストのソート
    //  TComparer関係の使用には Generics.Defaults が必要
    //----------------------------------------------------
    FAppIDList.Sort(TComparer<TAppIdItem>.Construct(
      function(const Left, Right: TAppIdItem): Integer
      begin
        // AppName の値でソート
        Result := CompareText(Left.AppName, Right.AppName);
      end)
    );

  ListView1.Items.Count := FAppIDList.Count;

  ListView1.Items.EndUpdate;
  FormResize(nil);
end;

//=============================================================================
//  ListView1 の OnData イベント (仮想リストビューのイベント)
//  ListView の各 Item の描画が必要となった場合に発生
//  ListView の Item と SubItem に値をセットする
//  このイベントは ListView1.OwnerData := True; でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  LAppId      : string;
  LSHFileInfo : TSHFileInfo;
  LpidlFull   : PItemIDList;
begin
  if Item.Index  > FAppIDList.Count then Exit;

  Item.Caption := FAppIDList[Item.Index].AppName;
  Item.SubItems.Add(FAppIDList[Item.Index].AppID);

  if Item.ImageIndex > 0 then Exit;

  // アイコンの取得と設定
  LAppId := 'shell:AppsFolder' + PathDelim + Item.SubItems[0];
  LpidlFull := ILCreateFromPath(PChar(LAppId));
  SHGetFileInfo(Pointer(LpidlFull),
                        0,
                        LSHFileInfo,
                        SizeOf(LSHFileInfo),
                        SHGFI_PIDL or SHGFI_SYSICONINDEX);
  Item.ImageIndex := LSHFileInfo.iIcon;
  CoTaskMemFree(LpidlFull);
end;

//=============================================================================
//  フォームの幅を変更したらカラムの幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
end;

end.

//-----------------------------------------------------------------------------
//  引数の AppUserModelId の値から UWP アプリかを判定する関数
//
//  以下の値を比較して判定
//  (1) HKEY_CURRENT_USER\Software\Classes\ActivatableClasses\Package
//      階層下のキー名からバージョン関係文字列を除いた値
//  (2) 引数の AppUserModelId の値
//
//  完全には判定できない．UWP アプリによっては誤認識の可能性あり
//-----------------------------------------------------------------------------
function IsUWPApp(AppID: string): Boolean;
var
  LRegistry    : TRegistry;
  LPkgNameList : TStringList;
  LKeyPkgRoot  : string;
  LPkgName     : string;
  LIndex       : Integer;
begin
  Result := False;

  LPkgNameList := TStringList.Create;
  LRegistry := TRegistry.Create;
  try
    LRegistry.Access  := KEY_READ;
    LRegistry.RootKey := HKEY_CURRENT_USER;
    LKeyPkgRoot      := 'Software\Classes\ActivatableClasses\Package';
    if not LRegistry.OpenKey(LKeyPkgRoot, False) then Exit;

    LRegistry.GetKeyNames(LPkgNameList);
    LRegistry.CloseKey;

    // バージョン関係文字列を削除して検索
    for LIndex := 0 to LPkgNameList.Count - 1 do begin
      LPkgName := TRegEx.Replace(LPkgNameList[LIndex], '_(.+)_', '_');
      if SameText(LPkgName, LeftStr(AppID, Length(LPkgName)))
          or (Pos('!', AppID) > 0) then begin
        Result := True;
        Break;
      end;
    end;
  finally
    FreeAndNil(LRegistry);
    FreeAndNil(LPkgNameList);
  end;
end;

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.ShellAPI,  Winapi.ActiveX, Winapi.ShlObj, Winapi.CommCtrl, Vcl.ComCtrls,
   Vcl.Menus, plContextMenu;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    plContextMenu1: TplContextMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure plContextMenu1Popup(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure FormDestroy(Sender: TObject);
    procedure plContextMenu1BeforeContextShowMenu(Sender: TObject;
      MenuHandle: HWND);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  function IsUWPApp(AppID: string): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  System.Win.Registry,
  System.StrUtils,
  Generics.Collections,
  Generics.Defaults,
  System.RegularExpressions;

{$R *.DFM}

type
  PAppIdItem = ^TAppIdItem;
  TAppIdItem = Record
    AppName : string;
    AppID   : string;
    IconIdx : Integer;
  end;

var
  FAppIDList : TList<TAppIdItem>;

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo : TSHFileInfo ;
  LhImgList   : THandle;
begin
  Self.Caption    := 'AppUserModelId 一覧';
  Label1.Caption  := '';
  Button2.Enabled := False;

  ListView1.ViewStyle   := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 230;
  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := 'AppUserModelId';

  FAppIDList := TList<TAppIdItem>.Create;

  // システムのイメージリストのハンドルを取得
  LhImgList := SHGetFileInfo('',
                             0,
                             LSHFileInfo,
                             SizeOf(LSHFileInfo),
                             SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX);
  ListView_SetImageList(ListView1.Handle, LhImgList, LVSIL_SMALL);
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FAppIDList);
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  仮想フォルダ AppsFolder 内のリストを取得 
//  ( アプリ名と AppUserModelId の値を列挙 )
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPath        : WideString;
  LpidlRoot    : PItemIDList;
  LShItemRoot  : IShellItem;
  LShItemChild : IShellItem;
  LEnumItems   : IEnumShellItems;
  LFetched     : LongInt;
  LAppName     : PWideChar;
  LAppIDPath   : PWideChar;
  LAppItem     : TAppIdItem;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;

  FAppIDList.Clear;

  LpidlRoot    := nil;
  LShItemRoot  := nil;
  LShItemChild := nil;

  LPath := 'shell:AppsFolder';
  try
    // ファイルを項目識別子に変換
    LpidlRoot := ILCreateFromPath(PChar(LPath));
    if ILIsEmpty(LpidlRoot) then Exit;

    // フォルダの IShellItem オブジェクトを取得
    SHCreateItemFromIDList(LpidlRoot, IShellItem, LShItemRoot);

    // ファイル (IShellItem のリストを LEnumItems として取得
   LShItemRoot.BindToHandler(nil, BHID_EnumItems, IEnumShellItems, LEnumItems);

    // リストの各項目の表示名を調べる
    while (LEnumItems.Next(1, LShItemChild, @LFetched) = S_OK) do begin
      LShItemChild.GetDisplayName(SIGDN_NORMALDISPLAY, LAppName);
      if StrLen(LAppName) = 0 then Continue;
      LShItemChild.GetDisplayName(SIGDN_DESKTOPABSOLUTEPARSING, LAppIDPath);
      if StrLen(LAppIDPath) = 0 then Continue;

      LAppItem.AppName := LAppName;
      LAppItem.AppID   := LAppIDPath;
      LAppItem.IconIdx := -1;
      FAppIDList.Add(LAppItem);
    end;

    //----------------------------------------------------
    //  リストのソート
    //  TComparer関係の使用には Generics.Defaults が必要
    //----------------------------------------------------
    FAppIDList.Sort(TComparer<TAppIdItem>.Construct(
      function(const Left, Right: TAppIdItem): Integer
      begin
        // AppName の値でソート
        Result := CompareText(Left.AppName, Right.AppName);
      end)
    );

    ListView1.Items.Count := FAppIDList.Count;
  finally
    LEnumItems := nil;
    LShItemRoot := nil;
    CoTaskMemFree(LpidlRoot);
  end;

  ListView1.Items.EndUpdate;
  Button2.Enabled := FAppIDList.Count > 0;
  FormResize(nil);
end;

//=============================================================================
//  表示しているアプリ名と AppUserModelId の値をクリップボードにコピー
//  TAB 区切りテキスト．エクセルに貼り付け可能
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  Lindex   : Integer;
begin
  LStrList := TStringList.Create;
  try
    for Lindex := 0 to FAppIDList.Count -1 do begin
      LText := FAppIDList[Lindex].AppName + Char(VK_TAB)
             + FAppIDList[Lindex].AppID;
      LStrList.Add(LText);
    end;
    Clipboard.AsText := LStrList.Text;
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  TListView の OnDblClick イベント
//  ダブルクリックしたら選択しているアプリを起動
//  本 EXE が 32 ビットの場合，起動しない 64 ビットのアプリがある
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  LItem  : TListItem;
  LAppId : string;
begin
  LItem := ListView1.Selected;
  if LItem = nil then Exit;

  LAppId := 'shell:AppsFolder' + PathDelim + Litem.SubItems[0];
  ShellExecute(0, '', PChar(LAppId), nil, nil, SW_SHOW);
end;

//=============================================================================
//  TListView の OnSelectItem イベント
//  TListView の Item を選択したら AppUserModelId の値を TEdit に表示
//  UWP アプリか非 UWP アプリかの判定結果も表示
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  LAppId : string;
begin
  if Item = nil then Exit;

  LAppId := Item.SubItems[0];
  Edit1.Text := LAppId;

  if IsUWPApp(LAppId) then begin
    Label1.Caption := 'UWP';
  end else begin
    Label1.Caption := 'not UWP';
  end;
end;

//=============================================================================
//  ListView1 の OnData イベント (仮想リストビューのイベント)
//  ListView の各 Item の描画が必要となった場合に発生
//  ListView の Item と SubItem に値をセットする
//  このイベントは ListView1.OwnerData := True; でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  LAppId      : string;
  LSHFileInfo : TSHFileInfo;
  LpidlFull   : PItemIDList;
begin
  if Item.Index  > FAppIDList.Count then Exit;

  Item.Caption := FAppIDList[Item.Index].AppName;
  Item.SubItems.Add(FAppIDList[Item.Index].AppID);

  if Item.ImageIndex > 0 then Exit;

  // アイコンの取得と設定
  LAppId := 'shell:AppsFolder' + PathDelim + Item.SubItems[0];
  LpidlFull := ILCreateFromPath(PChar(LAppId));
  SHGetFileInfo(Pointer(LpidlFull),
                        0,
                        LSHFileInfo,
                        SizeOf(LSHFileInfo),
                        SHGFI_PIDL or SHGFI_SYSICONINDEX);
  Item.ImageIndex := LSHFileInfo.iIcon;
  CoTaskMemFree(LpidlFull);
end;

//=============================================================================
//  フォームの幅を変更したらカラムの幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
end;

//=============================================================================
//  plContextMenu1 の OnPopup イベント
//  コンテキストメニューの表示
//
//  拙作の TplContextMenu コンポーネントをフォームに配置
//  フォームの PopupMenu プロパティを plContextMenu1 にしておく
//
//  表示項目は UWP アプリと非 UWP とでは異なる
//  [スタート] メニューの項目におけるコンテキストのメニューの項目とは異なる
//=============================================================================
procedure TForm1.plContextMenu1Popup(Sender: TObject);
var
  LItem  : TListItem;
  LAppId : string;
begin
  LItem := ListView1.Selected;
  if LItem = nil then Exit;

  LAppId :=  Litem.SubItems[0];

  plContextMenu1.Directory := 'shell:AppsFolder';
  plContextMenu1.Files.Clear;
  plContextMenu1.Files.Add(LAppId);
end;

//=============================================================================
//  plContextMenu1 の OnBeforeContextShowMenu イベント
//  [ピン留めする] 項目を削除
//=============================================================================
procedure TForm1.plContextMenu1BeforeContextShowMenu(Sender: TObject;
  MenuHandle: HWND);
var
  LCount   : Integer;
  LCmdIdx  : Cardinal;
  LBuffer  : array [0..MAX_COLUMN_NAME_LEN - 1] of Char;
  LIndex   : Integer;
begin
  LCount := GetMenuItemCount(MenuHandle);

  for LIndex := LCount - 1 downto 0 do begin
    LCmdIdx := GetMenuItemID(MenuHandle, LIndex);
    FillChar(LBuffer, SizeOf(LBuffer), #0);
    GetMenuString(MenuHandle, LCmdIdx, @LBuffer, Length(LBuffer), MF_BYCOMMAND);
    if ContainsText(LBuffer, 'ピン留めする') then begin
      RemoveMenu(MenuHandle, LCmdIdx, MF_BYCOMMAND);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  引数の AppUserModelId の値から UWP アプリかを判定する関数
//
//  以下の値を比較して判定
//  (1) HKEY_CURRENT_USER\Software\Classes\ActivatableClasses\Package
//      階層下のキー名からバージョン関係文字列を除いた値
//  (2) 引数の AppUserModelId の値
//
//  完全には判定できない．UWP アプリによっては誤認識の可能性あり
//-----------------------------------------------------------------------------
function IsUWPApp(AppID: string): Boolean;
var
  LRegistry    : TRegistry;
  LPkgNameList : TStringList;
  LKeyPkgRoot  : string;
  LPkgName     : string;
  LIndex       : Integer;
begin
  Result := False;

  LPkgNameList := TStringList.Create;
  LRegistry := TRegistry.Create;
  try
    LRegistry.Access  := KEY_READ;
    LRegistry.RootKey := HKEY_CURRENT_USER;
    LKeyPkgRoot      := 'Software\Classes\ActivatableClasses\Package';
    if not LRegistry.OpenKey(LKeyPkgRoot, False) then Exit;

    LRegistry.GetKeyNames(LPkgNameList);
    LRegistry.CloseKey;

    // バージョン関係文字列を削除して検索
    for LIndex := 0 to LPkgNameList.Count - 1 do begin
      LPkgName := TRegEx.Replace(LPkgNameList[LIndex], '_(.+)_', '_');
      if SameText(LPkgName, LeftStr(AppID, Length(LPkgName)))
          or (Pos('!', AppID) > 0) then begin
        Result := True;
        Break;
      end;
    end;
  finally
    FreeAndNil(LRegistry);
    FreeAndNil(LPkgNameList);
  end;
end;

end.

//-----------------------------------------------------------------------------
//  指定場所にショートカットを作成
//
//  AszFileName : リンク元のファイルのフルパス名
//  ADirectory  : ショートカットを作成する場所(ディレクトリ名)
//  AWorkDie    : 作業ディレクトリ
//  AswFileName : ショートカットに付ける名前
//                空文字の場合はリンク先のファイル名+'へのショートカット.lnk'
//
//  CreateComObject の使用には uses に System.Win.ComObj が必要
//  IShellLink の 使用には uses に Winapi.ShlObj が 必要
//  IPersistFile の使用には uses に Winapi.ActiveX が必要
//-----------------------------------------------------------------------------
function CreateShortCutLink(AszFileName: string; ADirectory: string;
  AWorkDir: string; AswFileName: string): Boolean;
var
  LUnknownObject : IUnknown;
  LIShellLink    : IShellLink;
  LIPersistFile  : IPersistFile;
  LwFileName     : string;
begin
  Result := False;

  // IShellLink,IPersistFileインターフェイスのオブジェクトを生成
  LUnknownObject := CreateComObject(CLSID_SHELLLINK);
  LIShellLink    := LUnknownObject as IShellLink;
  LIPersistFile  := LUnknownObject as IPersistFile;
  if not Assigned(LIShellLink) or not Assigned(LIPersistFile) then exit;

  // リンク元の指定
  LIShellLink.SetPath(PChar(AszFileName));
  LIShellLink.SetWorkingDirectory(PChar(AWorkDir));

  // シュートカットに付ける名前を作成
  if AswFileName <> '' then begin
    // 本関数の引数に名前の指定があればそれを使用
    LwFileName := IncludeTrailingPathDelimiter(ADirectory) +
                  AswFileName + '.lnk';
  end else begin
    // 名前の指定がなければデフォルトで以下にする
    LwFileName := IncludeTrailingPathDelimiter(ADirectory) +
                  ExtractFileName(AszFileName) + 'へのショートカット.lnk';
  end;
  // リンク作成
  // IPersistFile.Save メソッドを実行すると結果が反映される
  if LIPersistFile.Save(PChar(LwFileName), False) = S_OK then begin
    Result := True;
  end;
end;

//-----------------------------------------------------------------------------
//  特殊フォルダのフルパスを CSIDL 値から取得する関数
//-----------------------------------------------------------------------------
function GetDirectoryFromCSIDL(AnFolder: Cardinal): string;
var
  LBuff : array [0..MAX_PATH-1] of Char;
  LiRet : HRESULT;
  LDir  : string;
begin
  Result := '';

  FillChar(LBuff, SizeOf(LBuff), #0);
  LiRet := SHGetFolderPath(0, AnFolder, 0, SHGFP_TYPE_CURRENT, @LBuff);
  if LiRet = S_OK then begin
    Result := LBuff;
  end;
end;

//=============================================================================
//  plContextMenu1 の OnBeforeContextInvoke イベント
//  ショートカットを別の場所に作成
//=============================================================================
procedure TForm1.plContextMenu1BeforeContextInvoke(Sender: TObject;
  CmdIndex: Integer; VerbNameStr: string; var InvokeFlag: Boolean);
var
  LAppIdPath : string;
  LDestDir   : string;
begin
  // 17 はショートカットの作成
  if CmdIndex = 17 then begin
    LAppIdPath := 'shell:AppsFolder\' + ListView1.Selected.SubItems[0];
    LDestDir := ExtractFilePath(Application.ExeName) + '000';
    ForceDirectories(LDestDir);

    CreateShortCutLink(LAppIdPath, LDestDir, '', ListView1.Selected.Caption);
    InvokeFlag := False;
  end;
end;

    LDestDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);

    //----------------------------------------------------
    //  リストのソート
    //  TComparer関係の使用には Generics.Defaults が必要
    //  AnsiCompareText を使用すると
    //   TListView.SortType := stText; と同じになる
    //----------------------------------------------------
    FAppIDList.Sort(TComparer<TAppIdItem>.Construct(
      function(const Left, Right: TAppIdItem): Integer
      begin
        // AppName の値でソート
        Result := AnsiCompareText(Left.AppName, Right.AppName);
      end)
    );

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.ShellAPI,  Winapi.ActiveX, Winapi.ShlObj, Winapi.CommCtrl, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  System.Win.Registry,
  System.StrUtils,
  Generics.Collections,
  Generics.Defaults,
  System.RegularExpressions;

{$R *.DFM}

type
  PAppIdItem = ^TAppIdItem;
  TAppIdItem = Record
    AppName : string;
    AppID   : string;
    IconIdx : Integer;
  end;

var
  FAppIDList   : TList<TAppIdItem>;
  FPkgNameList : TStringList;

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo : TSHFileInfo ;
  LhImgList   : THandle;
  LRegistry   : TRegistry;
  LKeyPkgRoot : string;
  LIndex      : Integer;
begin

  Self.Caption    := 'AppUserModelId 一覧 ( UWP アプリ )';
  Button2.Enabled := False;

  ListView1.ViewStyle   := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 230;
  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := 'AppUserModelId';

  FAppIDList := TList<TAppIdItem>.Create;

  // システムのイメージリストのハンドルを取得
  LhImgList := SHGetFileInfo('',
                             0,
                             LSHFileInfo,
                             SizeOf(LSHFileInfo),
                             SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX);
  ListView_SetImageList(ListView1.Handle, LhImgList, LVSIL_SMALL);


  // レジストリの以下のキー名のリストを作成
  // これが UWP アプリのフルパッケージ名
  //  このパッケージの全てが AppUserModelId のリストにあるわけではない
  // HKEY_CURRENT_USER\Software\Classes\ActivatableClasses\Package
  FPkgNameList := TStringList.Create;
  LRegistry := TRegistry.Create;
  try
    LRegistry.Access  := KEY_READ;
    LRegistry.RootKey := HKEY_CURRENT_USER;
    LKeyPkgRoot      := 'Software\Classes\ActivatableClasses\Package';
    if not LRegistry.OpenKey(LKeyPkgRoot, False) then Exit;

    LRegistry.GetKeyNames(FPkgNameList);
    LRegistry.CloseKey;

    // バージョン関係文字列を削除しておく
    for LIndex := 0 to FPkgNameList.Count - 1 do begin
      FPkgNameList[LIndex] := TRegEx.Replace(FPkgNameList[LIndex], '_(.+)_', '_');
    end;
  finally
    FreeAndNil(LRegistry);
  end;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FAppIDList);
  FreeAndNil(FPkgNameList);
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  仮想フォルダ AppsFolder 内の UWP アプリだけをリスト
//  UWP アプリの判定は一部誤認識あり
//  ( アプリ名と AppUserModelId の値を列挙 )
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPath        : WideString;
  LpidlRoot    : PItemIDList;
  LShItemRoot  : IShellItem;
  LShItemChild : IShellItem;
  LEnumItems   : IEnumShellItems;
  LFetched     : LongInt;
  LAppName     : PWideChar;
  LAppIDPath   : PWideChar;
  LAppItem     : TAppIdItem;
  LPkgName     : string;
  LUWPFlag     : Boolean;
  LIndex       : Integer;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;

  FAppIDList.Clear;

  LpidlRoot    := nil;
  LShItemRoot  := nil;
  LShItemChild := nil;

  LPath := 'shell:AppsFolder';
  try
    // ファイルを項目識別子に変換
    LpidlRoot := ILCreateFromPath(PChar(LPath));
    if ILIsEmpty(LpidlRoot) then Exit;

    // フォルダの IShellItem オブジェクトを取得
    SHCreateItemFromIDList(LpidlRoot, IShellItem, LShItemRoot);

    // ファイル (IShellItem のリストを LEnumItems として取得
   LShItemRoot.BindToHandler(nil, BHID_EnumItems, IEnumShellItems, LEnumItems);

    // リストの各項目の表示名を調べる
    while (LEnumItems.Next(1, LShItemChild, @LFetched) = S_OK) do begin
      LShItemChild.GetDisplayName(SIGDN_DESKTOPABSOLUTEPARSING, LAppIDPath);
      if StrLen(LAppIDPath) = 0 then Continue;
      LShItemChild.GetDisplayName(SIGDN_NORMALDISPLAY, LAppName);
      if StrLen(LAppName) = 0 then Continue;

      // レジストリにパッケージ名が存在するアプリ (UWP アプリ) のみリストに追加
      for LIndex := 0 to FPkgNameList.Count - 1 do begin
        LPkgName := FPkgNameList[LIndex];
        LUWPFlag := (Pos('!', LAppIDPath) > 0)
                 or SameText(LPkgName, LeftStr(LAppIDPath, Length(LPkgName)));

        if LUWPFlag then begin
          LAppItem.AppName := LAppName;
          LAppItem.AppID   := LAppIDPath;
          LAppItem.IconIdx := -1;
          FAppIDList.Add(LAppItem);
          Break;
        end;
      end;
    end;

    //----------------------------------------------------
    //  リストのソート
    //  TComparer関係の使用には Generics.Defaults が必要
    //----------------------------------------------------
    FAppIDList.Sort(TComparer<TAppIdItem>.Construct(
      function(const Left, Right: TAppIdItem): Integer
      begin
        // AppName の値でソート
        Result := CompareText(Left.AppName, Right.AppName);
      end)
    );

    ListView1.Items.Count := FAppIDList.Count;
  finally
    LEnumItems := nil;
    LShItemRoot := nil;
    CoTaskMemFree(LpidlRoot);
  end;

  ListView1.Items.EndUpdate;
  Button2.Enabled := FAppIDList.Count > 0;
  FormResize(nil);
end;

//=============================================================================
//  表示しているアプリ名と AppUserModelId の値をクリップボードにコピー
//  TAB 区切りテキスト．エクセルに貼り付け可能
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  Lindex   : Integer;
begin
  LStrList := TStringList.Create;
  try
    for Lindex := 0 to FAppIDList.Count -1 do begin
      LText := FAppIDList[Lindex].AppName + Char(VK_TAB)
             + FAppIDList[Lindex].AppID;
      LStrList.Add(LText);
    end;
    Clipboard.AsText := LStrList.Text;
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  TListView の OnDblClick イベント
//  ダブルクリックしたら選択しているアプリを起動
//  本 EXE が 32 ビットの場合，起動しない 64 ビットのアプリがある
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  LItem  : TListItem;
  LAppId : string;
begin
  LItem := ListView1.Selected;
  if LItem = nil then Exit;

  LAppId := 'shell:AppsFolder' + PathDelim + Litem.SubItems[0];
  ShellExecute(0, '', PChar(LAppId), nil, nil, SW_SHOW);
end;

//=============================================================================
//  TListView の OnSelectItem イベント
//  TListView の Item を選択したら AppUserModelId の値を TEdit に表示
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  LAppId : string;
begin
  if Item = nil then Exit;

  LAppId := Item.SubItems[0];
  Edit1.Text := LAppId;
end;

//=============================================================================
//  ListView1 の OnData イベント (仮想リストビューのイベント)
//  ListView の各 Item の描画が必要となった場合に発生
//  ListView の Item と SubItem に値をセットする
//  このイベントは ListView1.OwnerData := True; でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  LAppId      : string;
  LSHFileInfo : TSHFileInfo;
  LpidlFull   : PItemIDList;
begin
  if Item.Index  > FAppIDList.Count then Exit;

  Item.Caption := FAppIDList[Item.Index].AppName;
  Item.SubItems.Add(FAppIDList[Item.Index].AppID);

  if Item.ImageIndex > 0 then Exit;

  // アイコンの取得と設定
  LAppId := 'shell:AppsFolder' + PathDelim + Item.SubItems[0];
  LpidlFull := ILCreateFromPath(PChar(LAppId));
  SHGetFileInfo(Pointer(LpidlFull),
                        0,
                        LSHFileInfo,
                        SizeOf(LSHFileInfo),
                        SHGFI_PIDL or SHGFI_SYSICONINDEX);
  Item.ImageIndex := LSHFileInfo.iIcon;
  CoTaskMemFree(LpidlFull);
end;

//=============================================================================
//  フォームの幅を変更したらカラムの幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
end;

end.

// アプリケーション識別子としてのメモ帳のシェル名前空間における絶対パス
// 通常のファイルシステムにおけるパスは存在しない
shell:AppsFolder\{1AC14E77-02E7-4E5D-B744-2EB1AE5198B7}\notepad.exe

// 現在のユーザ固有
%APPDATA%\Microsoft\Windows\Start Menu\Programs
// ユーザ共通
%PROGRAMDATA%\Microsoft\Windows\Start Menu\Programs

C:\windows\system32\notepad.exe   // 64 ビット版のメモ帳
C:\windows\sysWOW64\notepad.exe   // 32 ビット版のメモ帳

control                   // コントロールパネル
shell:ControlPanelFolder  // コントロールパネル
ms-settings:              // 設定

//=============================================================================
//  [ファイル名を指定して実行] のダイアログを ShellExecute 関数で起動
//  ダイアログの表示位置は画面の左下ではない
//  uses に Winapi.ShellAPI が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCmd : string;
  LArg : string;
begin
  LCmd := 'rundll32.exe';
  LArg := 'shell32.dll,#61';
  ShellExecute(0, '', PChar(LCmd), PChar(LArg), nil, SW_SHOW);
end;

//=============================================================================
//  [ファイル名を指定して実行] のダイアログを ShellExecute 関数で起動
//  Shell コマンドを使用する例
//  ダイアログの表示位置は画面の左下
//  uses に Winapi.ShellAPI が必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LCmd : string;
begin
  LCmd := 'shell:::{2559a1f3-21d7-11d4-bdaf-00c04f60b9f0}';
  ShellExecute(0, '', PChar(LCmd), nil, nil, SW_SHOW);
end;

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.ShellAPI,  Winapi.ActiveX, Winapi.ShlObj, Winapi.CommCtrl, Vcl.ComCtrls,
   System.StrUtils, System.IOUtils, System.Types, System.Win.ComObj,
   Generics.Collections, Generics.Defaults;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  PStartMenuItem = ^TStartMenuItem;
  TStartMenuItem = Record
    Name     : string;
    FullPath : string;
  end;

  function Wow64DisableWow64FsRedirection(var flgRedirec: LongBool): LongBool; stdcall;
    external 'Kernel32.dll' Name 'Wow64DisableWow64FsRedirection';

  function GetStartMenuShortCutList(AShortCutList: TList<TStartMenuItem>): Integer;
  function GetLinkPathName(ALinkFilePath: string; var ArgStr: string;
    var WorkDir: string): string;
  function ExpandEnvPath(AEnvPath: string): string;

var
  Form1: TForm1;

implementation

uses
  System.Win.Registry,
  System.RegularExpressions;

{$R *.DFM}

type
  PAppIdItem = ^TAppIdItem;
  TAppIdItem = Record
    AppName  : string;
    AppID    : string;
    LinkPath : string;
    ExePath  : string;
    ArgStr   : string;
    WorkDir  : string;
    IconIdx  : Integer;
  end;

var
  FAppIDList : TList<TAppIdItem>;

//=============================================================================
//  フォーム生成時の処理
//  一覧表示用の TListView の設定等
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo : TSHFileInfo ;
  LhImgList   : THandle;
  LDirect     : LongBool;
begin
  // ファイルシステムのリダイレクト機能を無効化
  Wow64DisableWow64FsRedirection(LDirect);

  Self.Caption    := 'AppUserModelId 一覧 ( デスクトップアプリの EXE )';

  ListView1.ViewStyle   := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' 名前';
  ListView1.Columns[0].Width   := 230;
  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := 'AppUserModelId';

  FAppIDList := TList<TAppIdItem>.Create;

  // システムのイメージリストのハンドルを取得
  LhImgList := SHGetFileInfo('',
                             0,
                             LSHFileInfo,
                             SizeOf(LSHFileInfo),
                             SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX);
  ListView_SetImageList(ListView1.Handle, LhImgList, LVSIL_SMALL);
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FAppIDList);
end;

//=============================================================================
//  インストールされているアプリをリスト - Windows 10
//  仮想フォルダ AppsFolder 内のリスト作成
//  アプリ名と AppUserModelId の値を列挙
//  スタートメニューのリストからアプリのリンク先も取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LShortCutList : TList<TStartMenuItem>;
  LPath         : WideString;
  LpidlRoot     : PItemIDList;
  LShItemRoot   : IShellItem;
  LShItemChild  : IShellItem;
  LEnumItems    : IEnumShellItems;
  LFetched      : LongInt;
  LAppName      : PWideChar;
  LAppIDPath    : PWideChar;
  LAppItem      : TAppIdItem;
  LShortName    : string;
  LExePath      : string;
  LArgStr       : string;
  LWorkDir      : string;
  LIndex        : Integer;
  LListIndex    : Integer;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  ListView1.RowSelect := True;

  // スタートメニューのショートカットファイルのリストを作成
  LShortCutList := TList<TStartMenuItem>.Create;
  GetStartMenuShortCutList(LShortCutList);

  FAppIDList.Clear;

  LpidlRoot    := nil;
  LShItemRoot  := nil;
  LShItemChild := nil;

  LPath := 'shell:AppsFolder';
  try
    // ファイルを項目識別子に変換
    LpidlRoot := ILCreateFromPath(PChar(LPath));
    if ILIsEmpty(LpidlRoot) then Exit;

    // フォルダの IShellItem オブジェクトを取得
    SHCreateItemFromIDList(LpidlRoot, IShellItem, LShItemRoot);

    // ファイル (IShellItem のリストを LEnumItems として取得
    LShItemRoot.BindToHandler(nil, BHID_EnumItems, IEnumShellItems, LEnumItems);

    // リストの各項目の表示名を調べる
    while (LEnumItems.Next(1, LShItemChild, @LFetched) = S_OK) do begin
      LShItemChild.GetDisplayName(SIGDN_DESKTOPABSOLUTEPARSING, LAppIDPath);
      if StrLen(LAppIDPath) = 0 then Continue;
      LShItemChild.GetDisplayName(SIGDN_NORMALDISPLAY, LAppName);
      if StrLen(LAppName) = 0 then Continue;

      // レコード型の初期化と AppUserModelId とその表示名の代入
      LAppItem := Default(TAppIdItem);
      LAppItem.AppName := LAppName;
      LAppItem.AppID   := LAppIDPath;
      LAppItem.IconIdx := -1;

      // ショートカットのリストから AppUserModelId と同じ名前を検出
      // 重複名を検出しないように，検出したショートカットの項目を削除
      for LIndex := LShortCutList.Count - 1 downto 0 do begin
        LListIndex := LShortCutList.Count - LIndex - 1;

        LShortName := LShortCutList[LListIndex].Name;

        // 筆者の環境ではショートカットの「設定」がコントロールパネルになっている
        // 「設定」は本来 UWP のアプリ名
        // その対策用の処理コード
        if (LShortName = 'コントロール パネル') or (LShortName = '設定') then begin
          LExePath := GetLinkPathName(LShortCutList[LListIndex].FullPath,
                                      LArgStr,
                                      LWorkDir);
          if LExePath = '' then Continue;
          LShortName := 'コントロール パネル';
        end;

        if SameText(LAppName, LShortName) then begin

          LAppItem.LinkPath := LShortCutList[LListIndex].FullPath;
          LExePath := GetLinkPathName(LAppItem.LinkPath, LArgStr, LWorkDir);
          LAppItem.ExePath := LExePath;
          LAppItem.ArgStr  := LArgStr;
          LAppItem.WorkDir := LWorkDir;

          LShortCutList.Delete(LListIndex);
          Break;
        end;
      end;
      FAppIDList.Add(LAppItem);
    end;

    //----------------------------------------------------
    //  リストのソート
    //  TComparer関係の使用には Generics.Defaults が必要
    //----------------------------------------------------
    FAppIDList.Sort(TComparer<TAppIdItem>.Construct(
      function(const Left, Right: TAppIdItem): Integer
      begin
        // AppName の値でソート
        Result := CompareText(Left.AppName, Right.AppName);
      end)
    );

    ListView1.Items.Count := FAppIDList.Count;
  finally
    LEnumItems := nil;
    LShItemRoot := nil;
    CoTaskMemFree(LpidlRoot);
    FreeAndNil(LShortCutList);
  end;

  ListView1.Items.EndUpdate;
  FormResize(nil);
end;

//=============================================================================
//  TListView の OnDblClick イベント
//  ダブルクリックしたら選択しているアプリを起動
//  TEdit に表示している EXE または実行可能ファイルを実行
//
//  筆者の 64 ビット版の Windows 10 では
//  Delhi 6 / 7 起動時に rtl60.bpl 等の読み込みエラーが発生
//  IDE からではなく EXE から起動すればエラーは発生しない
//  ショートカットを実行する場合も現象は同じ
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  LItem    : TListItem;
  LExePath : string;
  LArgStr  : string;
  LRes     : HRESULT;
  LText    : string;
begin
  LItem := ListView1.Selected;
  if LItem = nil then Exit;

  LExePath := ExpandEnvPath(FAppIDList[LItem.Index].ExePath);
  LArgStr  := ExpandEnvPath(FAppIDList[LItem.Index].ArgStr);

  if LExePath = '' then begin
    LText := '実行可能なファイルがありません。';
    MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
  end else begin
    // システム関係フォルダ内のファイルが存在しない場合の処理
    // フォルダ名を決め打ちにしているので将来の保証なし
    if not FileExists(LExePath) then begin
      if SizeOf(THandle) = 4 then begin
        LExePath := ReplaceText(LExePath, 'Program Files (x86)', 'Program Files');
        LExePath := ReplaceText(LExePath, 'SysWOW64', 'System32');
      end else begin
        LExePath := ReplaceText(LExePath, 'Program Files', 'Program Files (x86)');
        LExePath := ReplaceText(LExePath, 'System32', 'SysWOW64');
      end;
    end;

    LRes := ShellExecute(0, '', PChar(LExePath), PChar(LArgStr), nil, SW_SHOW);
    if LRes <= 32 then begin
      LText := SysErrorMessage(GetLastError);
      MessageBox(Handle, PChar(LText), '情報', MB_ICONWARNING);
    end;
  end;
end;

//=============================================================================
//  TListView の OnSelectItem イベント
//  TListView の Item を選択したら EXE のフルパスを取得して TEdit に表示
//  UWP アプリは空白とする
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  LExePath : string;
  LArgStr  : string;
begin
  if Item = nil then Exit;

  LExePath := FAppIDList[Item.Index].ExePath;
  LArgStr  := FAppIDList[Item.Index].ArgStr;
  Edit1.Text := LExePath;
  if LArgStr <> '' then Edit1.Text := LExePath + ' ' + LArgStr;
end;

//=============================================================================
//  ListView1 の OnData イベント (仮想リストビューのイベント)
//  ListView の各 Item の描画が必要となった場合に発生
//  ListView の Item と SubItem に値をセットする
//  このイベントは ListView1.OwnerData := True; でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  LAppId      : string;
  LSHFileInfo : TSHFileInfo;
  LpidlFull   : PItemIDList;
begin
  if Item.Index  > FAppIDList.Count then Exit;

  Item.Caption := FAppIDList[Item.Index].AppName;
  Item.SubItems.Add(FAppIDList[Item.Index].AppID);

  if Item.ImageIndex > 0 then Exit;

  // アイコンの取得と設定
  LAppId := 'shell:AppsFolder' + PathDelim + Item.SubItems[0];
  LpidlFull := ILCreateFromPath(PChar(LAppId));
  SHGetFileInfo(Pointer(LpidlFull),
                        0,
                        LSHFileInfo,
                        SizeOf(LSHFileInfo),
                        SHGFI_PIDL or SHGFI_SYSICONINDEX);
  Item.ImageIndex := LSHFileInfo.iIcon;
  CoTaskMemFree(LpidlFull);
end;

//=============================================================================
//  フォームの幅を変更したらカラムの幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  ListView1.Columns[1].Width := ListView1.ClientWidth - ListView1.Columns[0].Width;
end;

//-----------------------------------------------------------------------------
//  スタートメニューのショートカットファイルのリストを作成
//  TStartMenuItem はショートカットの名前とパス名格納用のレコード型
//
//  このリストには UWP アプリはない
//-----------------------------------------------------------------------------
function GetStartMenuShortCutList(AShortCutList: TList<TStartMenuItem>): Integer;
const
  LINK_SUB_DIR = 'Microsoft\Windows\Start Menu\Programs';
var
  LRootDir   : string;
  LListItem  : TStartMenuItem;
  LOption    : TSearchOption;
  LFilesList : TStringDynArray;
  LpidlFull  : PItemIDList;
  LShelItem  : IShellItem;
  LFileName  : PWideChar;
  LDirIndex  : Integer;
  LIndex     : Integer;
begin
  AShortCutList.Clear;

  for LDirIndex := 0 to 1 do begin
    if LDirIndex = 0 then begin
      // 現在のユーザ固有
      LRootDir := GetEnvironmentVariable('APPDATA') + PathDelim + LINK_SUB_DIR;
    end else begin
      // ユーザ共通
      LRootDir := GetEnvironmentVariable('PROGRAMDATA') + PathDelim + LINK_SUB_DIR;
  end;

    LOption := TSearchOption.soAllDirectories;
    LFilesList := TDirectory.GetFiles(LRootDir, '*.lnk', LOption);

    // ショートカットのエクスプローラにおける表示名を取得
    // 例 : notepad.lnk --> メモ帳
    for LIndex := 0 to Length(LFilesList) - 1 do begin
      LpidlFull := ILCreateFromPath(PWideChar(LFilesList[LIndex]));
      SHCreateItemFromIDList(LpidlFull, IShellItem, LShelItem);
      LShelItem.GetDisplayName(SIGDN_NORMALDISPLAY, LFileName);

      CoTaskMemFree(LpidlFull);

      // レコード型のメンバに代入して，そのレコードをリストに追加
      LListItem.Name     := LFileName;
      LListItem.FullPath := LFilesList[LIndex];
      AShortCutList.Add(LListItem);
    end;
  end;

 //----------------------------------------------------
  //  リストのソート
  //  TComparer関係の使用には Generics.Defaults が必要
  //----------------------------------------------------
  AShortCutList.Sort(TComparer<TStartMenuItem>.Construct(
    function(const Left, Right: TStartMenuItem): Integer
    begin
      // Name の値でソート
      Result := CompareText(Left.Name, Right.Name);
    end)
  );

  Result := AShortCutList.Count;
end;

//-----------------------------------------------------------------------------
//  ショートカット (拡張子.lnk) のリンク先のフルパスとコマンドライン引数を取得
//  引数の ArgStr はコマンドラインの引数
//  引数の WorkDir は作業ディレクトリ
//
//  64 版の Windows の場合，32 ビットの EXE と 64 ビットの EXE から取得した場合，
//  以下の値が含まれる時の結果に違い (リダイレクト) があることに注意
//  %ProgramFiles% (Program Files と Program Files (x86)
//  System32 と SysWOW64
//-----------------------------------------------------------------------------
function GetLinkPathName(ALinkFilePath: string; var ArgStr: string;
  var WorkDir: string): string;
var
  LIShellLink   : IShellLink;
  LIPersistFile : IPersistFile;
  LFileData     : TWin32FindData;
  LFilePath     : array [0..MAX_PATH - 1] of Char;
  LArgPath      : array [0..MAX_PATH - 1] of Char;
  LWorkDir      : array [0..MAX_PATH - 1] of Char;
begin
  Result  := '';
  ArgStr  := '';
  WorkDir := '';

  // IShellLink, IPersistFile インターフェイスのオブジェクトを生成
  LIShellLink   := CreateComObject(CLSID_ShellLink) as IShellLink;
  LIPersistFile := LIShellLink as IPersistFile;

  if Succeeded(LIPersistFile.Load(PChar(ALinkFilePath), STGM_READ)) then begin

    // ショートカットファイルのリンク先を取得
    FillChar(LFilePath, SizeOf(LFilePath), #0);
    LIShellLink.GetPath(@LFilePath, MAX_PATH, LFileData, SLGP_UNCPRIORITY);

    // コマンドラインの引数の値を取得
    FillChar(LArgPath, SizeOf(LArgPath), #0);
    LIShellLink.GetArguments(@LArgPath, MAX_PATH);

    // 作業ディレクトリの値を取得
    FillChar(LWorkDir, SizeOf(LWorkDir), #0);
    LIShellLink.GetWorkingDirectory(@LWorkDir, MAX_PATH);

    // 関数の戻り値にセット
    ArgStr  := LArgPath;
    WorkDir := LWorkDir;
    Result := LFilePath;
  end;
end;

//-----------------------------------------------------------------------------
//  環境変数を含むパス名を実パスに変換する関数
//-----------------------------------------------------------------------------
function ExpandEnvPath(AEnvPath: string): string;
var
  LBuff : array [0..MAX_PATH - 1] of Char;
  LLen  : Integer;
begin
  FillChar(LBuff, SizeOf(LBuff), #0);
  LLen := Length(LBuff);
  ExpandEnvironmentStrings(PChar(AEnvPath), @LBuff, LLen);
  Result := LBuff;
end;

end.

//=============================================================================
//  ファイルの表示名を取得
//  SHGetFileInfo 関数 (Winapi.ShellAPI) を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LLinkPath : string;
  LFileInfo : TSHFileInfo;
  LDispName : string;
begin
  LLinkPath := 'C:\ProgramData\Microsoft\Windows\Start Menu'
             + '\Programs\Accessories\Notepad.lnk';

  //表示名の取得
  SHGetFileInfo(PChar(LLinkPath),
                0,
                LFileInfo,
                SizeOf(LFileInfo),
                SHGFI_DISPLAYNAME);
  LDispName := LFileInfo.szDisplayName;
  MessageBox(Handle, Pchar(LDispName), '結果', MB_ICONINFORMATION);
end;

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;
    Edit1: TEdit;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  System.Win.Registry,
  Generics.Collections,
  Generics.Defaults,
  System.StrUtils,
  System.IOUtils,
  System.Types,
  Winapi.ShellAPI,
  System.RegularExpressions;

{$R *.DFM}

type
  PUwpPkgItem = ^TUwpPkgItem;
  TUwpPkgItem = record
    RegKeyName  : string;
    PgkFullPath : string;
  end;

  var
    FUwpPkgList     : TList<TUwpPkgItem>;
    FPkgExeFullPath : string;
    FPkgFullPath    : string;

//=============================================================================
//  フォーム生成時の処理
//
//  レジストリのパッケージのキー名のリストを作成
//  インストール先のフルパッケージ名 (ディレクトリ名) も取得しておく
//  結果はレコード型のデータとして格納
//  そのレコード型のデータをパッケージ情報格納用のリストに追加していく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LRegistry   : TRegistry;
  LKeyPkgRoot : string;
  LKeyPkg     : string;
  LKeyList    : TStringList;
  LPkgPath    : string;
  LPkgItem    : TUwpPkgItem;
  LIndex      : Integer;
begin
  Button2.Enabled := False;
  Button3.Enabled := False;

  // UWP アプリ 電卓の AppUserModelId の値
  Edit1.Text:= 'Microsoft.WindowsCalculator_8wekyb3d8bbwe!App';


  FUwpPkgList := TList<TUwpPkgItem>.Create;

  LRegistry := TRegistry.Create;
  try
    LRegistry.Access  := KEY_READ;
    LRegistry.RootKey := HKEY_CLASSES_ROOT;
    LKeyPkgRoot := 'Local Settings\Software\Microsoft\Windows\CurrentVersion'
                 + '\AppModel\Repository\Packages';
    LKeyList := TStringList.Create;
    try
      if not LRegistry.OpenKey(LKeyPkgRoot, False) then Exit;

      LRegistry.GetKeyNames(LKeyList);
      LRegistry.CloseKey;

      for LIndex := 0 to LKeyList.Count - 1 do begin
        LKeyPkg := LKeyPkgRoot + PathDelim + LKeyList[LIndex];
        if LRegistry.OpenKey(LKeyPkg, False) then begin
          LPkgPath := LRegistry.ReadString('PackageRootFolder');
          if LPkgPath <> '' then begin
            LPkgItem.RegKeyName  := LKeyList[LIndex];
            LPkgItem.PgkFullPath := LPkgPath;
            FUwpPkgList.Add(LPkgItem);
          end;
        end;
        LRegistry.CloseKey;
      end;
    finally
      FreeAndNil(LKeyList);
    end;
  finally
    FreeAndNil(LRegistry);
  end;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FUwpPkgList);
end;

//=============================================================================
//  指定した AppUserModelId のインストールのフルパッケージ名を調べる
//  UWP アプリによってはこのコードで取得できない場合あり
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LAppId     : string;
  LKeyPkg    : string;
  LFilesList : TStringDynArray;
  LpkgPath   : string;
  LOption    : TSearchOption;
  LIndex     : Integer;
  LExeIndex  : Integer;
  LText      : string;
begin
  Memo1.Lines.Clear;

  // アプリケーション識別子 AppUserModelId の値
  LAppId := Trim(Edit1.Text);

  for LIndex := 0 to FUwpPkgList.Count - 1 do begin
    // バージョン関係文字列を削除して検索
    LKeyPkg := TRegEx.Replace(FUwpPkgList[LIndex].RegKeyName, '_(.+)_', '_');
    if not SameText(LKeyPkg, LeftStr(LAppId, Length(LKeyPkg))) then Continue;

    // EXE のフルパスを取得
    // EXE は 2 つ以上ある場合がある
    LpkgPath := FUwpPkgList[LIndex].PgkFullPath;
    LOption := TSearchOption.soAllDirectories;
    LFilesList := TDirectory.GetFiles(LpkgPath, '*.exe', LOption);

    Memo1.Lines.Add(FUwpPkgList[LIndex].PgkFullPath);
    Memo1.Lines.Add('');
    for LExeIndex := 0 to Length(LFilesList) - 1 do begin
      Memo1.Lines.Add(ExtractFileName(LFilesList[LExeIndex]));
    end;
    FPkgExeFullPath := LFilesList[0];
    FPkgFullPath    := LpkgPath;
    Break;
  end;

  Button2.Enabled := Length(LFilesList) > 0;
  Button3.Enabled := Length(LFilesList) > 0;

  if Length(LFilesList) = 0 then begin
    LText := 'パッケージが見つかりませんでした。';
    MessageBox(Handle, PChar(LText), '情報', MB_ICONWARNING);
  end;
end;

//=============================================================================
//  パッケージ内の EXE を起動してみる
//  起動不可を確認
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LRes  : HRESULT;
  LText : string;
begin
  if FPkgExeFullPath = '' then Exit;

  LRes := ShellExecute(0, '', PChar(FPkgExeFullPath), nil, nil, SW_SHOW);
  if LRes <= 32 then begin
    LText := SysErrorMessage(GetLastError);
    MessageBox(Handle, PChar(LText), '情報', MB_ICONWARNING);
  end;
end;

//=============================================================================
//  パッケージ内をエクスプローラで表示してみる
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LRes  : HRESULT;
  LText : string;
begin
  if FPkgFullPath = '' then Exit;

  LRes := ShellExecute(0, '', PChar(FPkgFullPath), nil, nil, SW_SHOW);
  if LRes <= 32 then begin
    LText := SysErrorMessage(GetLastError);
    MessageBox(Handle, PChar(LText), '情報', MB_ICONWARNING);
  end;
end;

end.

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;
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  function GetPackagePathFromAppId(AppId: string): string;

var
  Form1: TForm1;

implementation

uses
  System.Win.Registry,
  Generics.Collections,
  System.StrUtils,
  System.RegularExpressions,
  Winapi.ShellAPI,
  Winapi.msxml,
  System.Win.ComObj;

{$R *.DFM}

// =============================================================================
// フォーム生成時の処理
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // UWP アプリ マップの AppUserModelId の値
  Edit1.Text := 'Microsoft.WindowsMaps_8wekyb3d8bbwe!App';
end;

// ===========================================================================
//  UWP アプリのパッケージから URL スキームの値を取得
//  URL スキームは全ての UWP アプリにあるわけではない
//
//  uses に Winapi.msxml, System.Win.ComObj が必要
// ===========================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPkgPath     : string;
  LFilePath    : string;
  LStrList     : TStringList;
  LXMLDomDoc   : IXMLDOMDocument;
  LDOMNodeList : IXMLDOMNodeList;
  LIndex       : Integer;
begin
   ListBox1.Items.Clear;

  // IXMLDOMDocument のインスタンスを生成
  LXMLDomDoc := CreateComObject(CLASS_DOMDocument) as IXMLDOMDocument;
  LXMLDomDoc.async := False;
  LXMLDomDoc.preserveWhiteSpace := True;


  // AppUserModelId の値がら UWP アプリのインストール先のパッケージを取得
  // 設定関係の XML ファイルを読み込む
  // その XML コードを IXMLDOMDocument の XML コードにする
  LPkgPath := GetPackagePathFromAppId(Trim(Edit1.Text));
  if LPkgPath = '' then Exit;

  LFilePath := LPkgPath + PathDelim + 'AppxManifest.xml';
  LStrList := TStringList.Create;
  try
    LStrList.LoadFromFile(LFilePath, TEncoding.UTF8);
    LXMLDomDoc.loadXML(LStrList.Text);

    LStrList.SaveToFile('AppxManifest.xml', TEncoding.UTF8);
  finally
    FreeAndNil(LStrList);
  end;


  // URL スキームの値があるノードを取得
  LDOMNodeList := LXMLDomDoc.getElementsByTagName('uap:Protocol/@Name');

  if LDOMNodeList <> nil then begin
    // URL スキームの値を列挙
    for LIndex := 0 to LDOMNodeList.length - 1 do begin
      // 末尾に : (コロン) を追加
      ListBox1.Items.Add(LDOMNodeList[LIndex].nodeValue + ':');
    end;
  end;
  ListBox1.Items.SaveToFile('URLScheme.txt');

  LDOMNodeList := nil;
  LXMLDomDoc := nil;
end;

// ===========================================================================
//  ListBox1 の OnDblClick イベント
//  URL スキームで UWP アプリを起動
// ===========================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LURLScheme : string;
begin
  if ListBox1.ItemIndex < 0 then Exit;

  LURLScheme := ListBox1.Items[ListBox1.ItemIndex];
  ShellExecute(0, '', PChar(LURLScheme), nil, nil, SW_SHOW);
end;

// -----------------------------------------------------------------------------
// AppUserModelId の値からインストール先のフルパスを取得する関数
// レジストリのキー名のリストから探す
// -----------------------------------------------------------------------------
function GetPackagePathFromAppId(AppId: string): string;
var
  LRegistry   : TRegistry;
  LKeyPkgRoot : string;
  LPkgName    : string;
  LKeyPkg     : string;
  LKeyList    : TStringList;
  LPkgPath    : string;
  LIndex      : Integer;
begin
  Result := '';

  LRegistry := TRegistry.Create;
  try
    LRegistry.Access  := KEY_READ;
    LRegistry.RootKey := HKEY_CLASSES_ROOT;
    LKeyPkgRoot := 'Local Settings\Software\Microsoft\Windows\CurrentVersion'
                 + '\AppModel\Repository\Packages';
    LKeyList := TStringList.Create;
    try
      if not LRegistry.OpenKey(LKeyPkgRoot, False) then Exit;

      LRegistry.GetKeyNames(LKeyList);
      LRegistry.CloseKey;

      for LIndex := 0 to LKeyList.Count - 1 do begin
        LKeyPkg := LKeyPkgRoot + PathDelim + LKeyList[LIndex];
        if not LRegistry.OpenKey(LKeyPkg, False) then Continue;

        LPkgName := LKeyList[LIndex];
        LPkgPath := LRegistry.ReadString('PackageRootFolder');

        LRegistry.CloseKey;
        if LPkgPath = '' then Continue;

        LPkgName := TRegEx.Replace(LPkgName, '_(.+)_', '_');
        if not SameText(LPkgName, LeftStr(AppId, Length(LPkgName))) then Continue;

        Result := LPkgPath;
        Break;
      end;
    finally
      FreeAndNil(LKeyList);
    end;
  finally
    FreeAndNil(LRegistry);
  end;
end;

end.

  // URL スキームの値があるノードを取得
  // documentElement.selectNodes を使用する場合は先頭に / を追加する
  LXPath := '//Applications/Application'
          + '/Extensions/uap:Extension/uap:Protocol/@Name';
  LDOMNodeList := LXMLDomDoc.documentElement.selectNodes(LXPath);