unit ShowDialog_SystemUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private 宣言 }
    FCmdPath : string;
    FCmdPara : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  ShellAPI,
  StrUtils;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  ListBox1に起動用の文字列をセット
//
//  SystemDialogList.txtには，最初のカンマまでがTListBoxに表示する文字列
//  そこから最後までが実際のパス名とそのオプション関係の文字列となっいる
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);

  //---------------------------------------------------------------------------
  //  ListBox1に文字列と実行用のパス名をセット
  //---------------------------------------------------------------------------
  procedure AddItem(ACaption, APath: String);
  var
    LpAddStr : PString;
  begin
    New(LpAddStr);
    LpAddStr^ := APath;
    ListBox1.AddItem(ACaption, TObject(LpAddStr));
  end;
  //---------------------------------------------------------------------------

var
  LStringList : TStringList;
  LPos        : Integer;
  LStrCaption : string;
  LStrPath    : string;
  i           : Integer;
begin
  ListBox1.Sorted := True;

  //表示用の文字列とパス名を格納したファイルを読み込んで処理
  LStringList := TStringList.Create;
  try
    LStringList.LoadFromFile('SystemDialogList.txt');
    for i := 0 to LStringList.Count - 1 do begin
      LPos        := Pos(',', LStringList[i]);
      LStrCaption := Copy(LStringList[i], 1, LPos -1);
      LStrPath    := Trim(Copy(LStringList[i], LPos + 1, Length(LStringList[i])));

      //ListBox1のItemに追加
      AddItem(LStrCaption, LStrPath);
    end;
  finally
    FreeAndNil(LStringList);
  end;
  ListBox1.ItemIndex := 0;
  ListBox1Click(nil);
end;

//=============================================================================
//  フォーム破棄時の処理
//  ListBox1のオブジェクトを破棄
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
var
  i : Integer;
begin
  for i := 0 to ListBox1.Items.Count-1 do begin
    Dispose(PString(ListBox1.Items.Objects[i]));
  end;
end;

//=============================================================================
//  ListBox1のOnDblClickイベント処理
//  ListBoxで選択しているダイアログ等を起動
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LRetCode : Integer;
begin
  if ListBox1.ItemIndex < 0 then exit;
  if FCmdPath = '' then exit;

  LRetCode := ShellExecute(Handle, '', PChar(FCmdPath), PChar(FCmdPara), nil, SW_SHOW);

  if LRetCode <=32 then begin
    MessageBox(Handle, PChar(SysErrorMessage(LRetCode)), '情報', MB_ICONINFORMATION);
  end;
end;

//=============================================================================
//  ListBox1のOnClickイベント処理
//  選択項目のShellExecute関数に渡す引数の文字列を作成
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  環境変数を含む(%等の文字を含む)を実際のパス名に変換
  //---------------------------------------------------------------------------
  function ExpandEnvironmentString(S: String): String;
  var
    LDstChar : array [0..MAX_PATH - 1] of Char;
  begin
    ExpandEnvironmentStrings(PChar(S), LDstChar, MAX_PATH);
    Result := LDstChar;
  end;
  //---------------------------------------------------------------------------

var
  LStringList : TStringList;
  LOriginCmd  : string;
  LEnvPath    : string;
begin
  if ListBox1.ItemIndex < 0 then exit;

  //選択中のItems文字列を取得してコマンド文字列を作成
  LOriginCmd := Trim(PString(ListBox1.Items.Objects[ListBox1.ItemIndex])^);
  LEnvPath := ExpandEnvironmentString(LOriginCmd);

  //実行ファイル名とパラメータに分解
  LStringList := TStringList.Create;
  try
    LStringList.Delimiter       := ' ';
    LStringList.StrictDelimiter := True;
    LStringList.DelimitedText   := LEnvPath;

    if LStringList.Count = 1 then begin
      FCmdPath := Trim(LEnvPath);
      FCmdPara := '';
    end else begin
      FCmdPath := Trim(LStringList[0]);
      FCmdPara := Trim(StringReplace(LEnvPath, FCmdPath, '', [rfIgnoreCase]));
    end;
  finally
    FreeAndNil(LStringList);
  end;

  //パス名の空白までをパスと認識してしまうのでダブルクォーテーションで囲む
  //パラメータはそのままとする
  if Pos(' ', FCmdPath) > 1 then begin
    if LeftStr(FCmdPath, 1) <> '"' then begin
      FCmdPath := AnsiQuotedStr(FCmdPath, '"');
    end;
  end;
  Edit1.Text := LOriginCmd;
end;

//=============================================================================
//  ListBox1のOnKeyDownイベント処理
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ListBox1.ItemIndex < 0 then exit;

  if Key = VK_RETURN then begin
    ListBox1DblClick(nil);
    Key := 0;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    Edit1: TEdit;
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Registry,
  ShellAPI;

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//  レジストリからcanonical nameのリストを取得
//  usesにRegistryが必要
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LRegistry : TRegistry;
  LRegKey   : string;
  LRegItem  : string;
  LItemList : TStringList;
  i         : Integer;
begin
  Edit1.Text := '';

  LItemList         := TStringList.Create;
  LRegistry         := TRegistry.Create;
  LRegistry.Access  := KEY_READ;
  LRegistry.RootKey := HKEY_LOCAL_MACHINE;
  try
    LRegKey := 'SOFTWARE\Classes\CLSID';

    //CLSID階層下のキー名(GUID)を列挙
    if LRegistry.OpenKey(LRegKey, False) then begin
      LRegistry.GetKeyNames(LItemList);
    end;
    LRegistry.CloseKey;

    //列挙したキーのSystem.ApplicationName項目の値を取得してTListBoxに追加
    ListBox1.Sorted := True;
    ListBox1.Items.Clear;
    ListBox1.Items.BeginUpdate;
    for i := 0 to LItemList.Count - 1 do begin
      try
        if LRegistry.OpenKey(LRegKey + PathDelim + LItemList[i], False) then begin
          LRegItem := LRegistry.ReadString('System.ApplicationName');
          if LRegItem <> '' then begin
            ListBox1.Items.Add('/name ' + LRegItem);
          end;
        end;
      finally
        LRegistry.CloseKey;
      end;
    end;
    ListBox1.Items.EndUpdate;
    Label1.Caption := IntToStr(ListBox1.Items.Count);
  finally
    FreeAndNil(LRegistry);
    FreeAndNil(LItemList);
  end;

  ListBox1.ItemIndex := 0;
  ListBox1Click(nil);
end;

//=============================================================================
//  ListBox1のOnDblClickイベント処理
//  TListBoxの選択中のcanonical nameのダイアログを実行
//
//  64ビットWindowsでの実行
//  32ビットのEXEでは表示できないダイアログがある
//  64ビットのEXEを作成して実行すれば表示可能　
//
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LShellCmd : string;
begin
  if ListBox1.ItemIndex < 0 then exit;

  LShellCmd := ListBox1.Items[ListBox1.ItemIndex];
  ShellExecute(Handle, '', 'control.exe', PChar(LShellCmd), nil, SW_SHOW);
end;

//=============================================================================
//  ListBox1のOnClickイベント処理
//  Edit1にcanonical name文字列を表示する8コピー用)
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  if ListBox1.ItemIndex < 0 then exit;

  Edit1.Text := 'control.exe ' + ListBox1.Items[ListBox1.ItemIndex];
end;

//=============================================================================
//  ListBox1のOnKeyDownイベント処理
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ListBox1.ItemIndex < 0 then exit;

  if Key = VK_RETURN then begin
    ListBox1DblClick(nil);
    Key := 0;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ShellCtrls, Buttons;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    ShellListView1: TShellListView;
    Label1: TLabel;
    procedure ShellListView1AddFolder(Sender: TObject; AFolder: TShellFolder;
      var CanAdd: Boolean);
    procedure ShellListView1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  CommCtrl,
  Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//  mscファイルの一覧を作成
//  Delphiに添付のシェルコンポーネントを利用
//
//  ShellListView1の設定
//    AutoContextMenur := False;
//    AutoRefresh := False;
//    ReadOnly := True;
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LSysDir       : array [0..MAX_PATH - 1] of Char;
  LTargetFolder : string;
  LViewStyle    : Cardinal;
  i             : Integer;
begin
  Self.ActiveControl := ShellListView1;

  //システムディレクトリを取得してja-jpのフルパス名を生成
  GetSystemDirectory(LSysDir, MAX_PATH);
  LTargetFolder  := LSysDir;
  LTargetFolder  := IncludeTrailingPathDelimiter(LTargetFolder) + 'ja-JP';

  ShellListView1.DoubleBuffered    := True;
  ShellListView1.ShowColumnHeaders := False;
  ShellListView1.ViewStyle         := vsReport;
  ShellListView1.Root              := LTargetFolder;

  //Columns[0](名前のカラム)以外は不要なので削除
  for i := ShellListView1.Columns.Count -1 downto 1 do begin
    ShellListView1.Columns.Delete(i);
  end;

  ShellListView1.ItemIndex := 0;
  ShellListView1Click(nil);

  //表示形式をタイルにする
  LViewStyle := LV_VIEW_TILE;
  SendMessage(ShellListView1.Handle, LVM_SETVIEW, WPARAM(LViewStyle), 0);

  Label1.Caption := IntToStr(ShellListView1.Items.Count);
end;

//=============================================================================
//  TEditのテキストをクリップボードにコピー
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Clipboard.AsText := Edit1.Text;
end;

//=============================================================================
//  ShellListView1のOnAddFolderイベント処理
//  指定拡張子だけをリストする
//=============================================================================
procedure TForm1.ShellListView1AddFolder(Sender: TObject; AFolder: TShellFolder;
  var CanAdd: Boolean);
var
  LExt : String;
begin
  LExt   := ExtractFileExt(AFolder.PathName);
  CanAdd := LowerCase(LExt) = '.msc';
end;

//=============================================================================
//  ShellListView1のOnClickイベント処理
//  選択したItemのフルパスをTEditにセット
//=============================================================================
procedure TForm1.ShellListView1Click(Sender: TObject);
var
  LItem   : TListItem;
  LFolder : TShellFolder;
begin
  LItem := ShellListView1.Selected;
  if LItem <> nil then begin
    LFolder := ShellListView1.Folders[LItem.Index];
    Edit1.Text := LFolder.PathName;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  [システム情報]ダイアログを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //%SystemRoot%\System32\は省略できる
  ShellExecute(Handle, 'open', 'msinfo32.exe', nil, nil, SW_SHOW);
end;

end.

//=============================================================================
//  IOpenControlPanelインターフェイスによるシステム関係ダイアログの表示例
//  ここでは[地域と言語]の設定ダイアログを表示
//
//  usesにShlObj, ActiveXが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LiOpenCtrlPnl : IOpenControlPanel;
  LCtrlPnlName  : String;
  LPage         : String;
begin
  //IOpenControlPanelのインスタンスを生成
  if Failed(CoCreateInstance(CLSID_OpenControlPanel,
                             nil,
                             CLSCTX_INPROC_SERVER,
                             IOpenControlPanel,
                             LiOpenCtrlPnl)) then exit;

  LCtrlPnlName := 'Microsoft.RegionalAndLanguageOptions';
  LPage        := '';
  LiOpenCtrlPnl.Open(PChar(LCtrlPnlName), PChar(LPage), nil);
end;

//=============================================================================
//  IOpenControlPanelインターフェイスによるシステム関係ダイアログの表示例
//  ここでは[インストールされた更新プログラム]の設定ダイアログを表示
//
//  usesにShlObj, ActiveXが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LiOpenCtrlPnl : IOpenControlPanel;
  LCtrlPnlName  : String;
  LPage         : String;
begin
  //IOpenControlPanelのインスタンスを生成
  if Failed(CoCreateInstance(CLSID_OpenControlPanel,
                             nil,
                             CLSCTX_INPROC_SERVER,
                             IOpenControlPanel,
                             LiOpenCtrlPnl)) then exit;

  LCtrlPnlName := 'Microsoft.ProgramsAndFeatures';
  LPage        := '::{D450A8A1-9568-45C7-9C0E-B4F9FB4537BD}';
  LiOpenCtrlPnl.Open(PChar(LCtrlPnlName), PChar(LPage), nil);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LiOpenCtrlPnl : IOpenControlPanel;
  LCtrlPnlName  : String;
  LPage         : String;
begin
  //IOpenControlPanelのインスタンスを生成
  //CreateComObjectの使用にはusesにComObjが必要
  LiOpenCtrlPnl := CreateComObject(CLSID_OpenControlPanel) as IOpenControlPanel;

  LCtrlPnlName := 'Microsoft.ProgramsAndFeatures';
  LPage        := '::{D450A8A1-9568-45C7-9C0E-B4F9FB4537BD}';
  LiOpenCtrlPnl.Open(PChar(LCtrlPnlName), PChar(LPage), nil);
end;

  //---------------------------------------------------------------------------
  //  shell32.dllの序数59の名前なし関数を使用するための関数の定義．この関数の第3
  //  引数はExitWiddowExの引数と同じ．
  //  Delphiが関数類のヘッダ宣言を提供していない場合は，この様に利用者が定義して
  //  使用する
  //  この関数は非公開API関数
  //
  //  Shell32.dllを使用するにはusesにShellAPIが必要．
  //---------------------------------------------------------------------------
  SH_RestartDialog = function (Handle   : THandle;
                              lpPrompt : PChar;
                              uFlag    : Integer):Integer; stdcall;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [システム設定の変更]ダイアログを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LpPrompt     : PChar;
  LuFlage      : Integer;
  LSHRebootDlg : SH_RestartDialog;
  LhDllHandle  : THandle;
begin
  LpPrompt    := '';
  LuFlage     := EWX_REBOOT;
  LhDllHandle := LoadLibrary('shell32.dll');
  try
    LSHRebootDlg := GetProcAddress(LhDllHandle, PChar(59));
    if LSHRebootDlg(Handle, LpPrompt, LuFlage) = IDOK then begin
      //[はい]をクリックした時の処理
    end else begin
      //[いいえ]をクリックした時の処理
    end;
  finally
    FreeLibrary(LhDllHandle);
  end;
end;