unit SomeDialogsUnit;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
//  指定したファイルを実行する(Halbow資料館のWinExecAndWait32V2を修正)
//  ここでは表示位置変更のためのコードを追加．また終了を待つのではなく，起動を
//  待つように修正している．
//-----------------------------------------------------------------------------
function WinExecAndWait32V2(FileName: string; Visibility: Integer): DWORD;
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
  Ret         : DWORD;
begin
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb          := SizeOf(StartupInfo);
  //以下の3行とdwFlagsにSTARTF_USERPOSITIONを追加
  StartupInfo.dwX         := 0;
  StartupInfo.dwY         := Form1.Top;
  StartupInfo.dwFlags     := STARTF_USESHOWWINDOW or
                             STARTF_USEPOSITION;
  StartupInfo.wShowWindow := Visibility;

  //参照カウンタ対策
  UniqueString(FileName);

  if not CreateProcess(nil,
    PChar(FileName),      // pointer to command line string
    nil,                  // pointer to process security attributes
    nil,                  // pointer to thread security attributes
    False,                // handle inheritance flag
    CREATE_NEW_CONSOLE or // creation flags
    NORMAL_PRIORITY_CLASS,
    nil,                  //pointer to new environment block
    nil,                  // pointer to current directory name
    StartupInfo,          // pointer to STARTUPINFO
    ProcessInfo)          // pointer to PROCESS_INF
  then Result := WAIT_FAILED
  else
  begin
    repeat
      Ret := WaitForInputIdle(ProcessInfo.hProcess, 100);
      Application.ProcessMessages;
    until Ret <> WAIT_TIMEOUT;
    Sleep(100);

    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    Result:=WAIT_TIMEOUT
  end;
end; { WinExecAndWait32 }

//=============================================================================
//  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に動作を示す文字列と起動するcplファイル名をセット
//  cplには起動オプションを指定できるものがある．ここでは例として[画面のプロパ
//  ティ]の起動時に，[スクリーンセーバ]タブを選択状態にするオプションを追加し
//  たItemsを追加してみた
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);

  //---------------------------------------------------------------------------
  //  Delphiにも同名の関数があるが，AnsiStringなのでString型で再定義
  //---------------------------------------------------------------------------
  function NewStr(S: String): PString;
  begin
    New(Result);
    Result^ := S;
  end;

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

//-----------------------------------------------------------------------------
begin
  AddItem('コンピューターの簡単操作センター',   'access.cpl');
  AddItem('プログラムと機能',                   'appwiz.cpl');
  AddItem('BDE Administrator',                  'bdeadmin.cpl');
  AddItem('画面の解像度',                       'desk.cpl');
  AddItem('画面のプロパティ[スクリーンセーバ]', 'desk.cpl,,1');
  AddItem('Windowsファイアーウォール',          'firewall.cpl');
  AddItem('Windows Update',                     'wuaucpl.cpl');
  AddItem('インターネットのプロパティ',         'inetcpl.cpl');
  AddItem('地域と言語',                         'intl.cpl');
  AddItem('ゲームコントローラ',                 'joy.cpl');
  AddItem('マウスのプロパティ',                 'main.cpl');
  AddItem('キーボードのプロパティ',             'main.cpl,@1');
  AddItem('サウンド',                           'mmsys.cpl');
  AddItem('電話とモデム',                       'telephon.cpl');
  AddItem('ネットワーク接続',                   'ncpa.cpl');
  AddItem('ネットワークのセットアップ',         'netsetup.cpl');
  AddItem('ユーザアカウント',                   'nusrmgr.cpl');
  AddItem('電源オプション',                     'powercfg.cpl');
  AddItem('システムのプロパティ',               'sysdm.cpl');
  AddItem('日付と時刻',                         'timedate.cpl');

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

//=============================================================================
//  ListBox1のOnDblClickイベント処理
//  ListBox1のアイテムをクリックしたら該当ダイアログを表示
//
//  参考のために以下の関数を選択して実行できるようにしている
//    WinExec
//    CreateProcess
//    ShellExecute
//
//  CreateProcessは表示位置を指定しているが，指定を無視するダイアログもある
//  OSや環境によっても起動しないダイアログもある
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LItemStr     : string;
  LAnsiItemStr : AnsiString;
begin
  if ListBox1.ItemIndex < 0 then exit;

  //選択中のItemsの.cplファイル名を取得して起動名文字列を作成
  LItemStr     := PString(ListBox1.Items.Objects[ListBox1.ItemIndex])^;
  LAnsiItemStr := AnsiString(LItemStr);

  case RadioGroup1.ItemIndex of
    0: ShellExecute(Handle, '', 'control.exe', PChar(LItemStr), nil, SW_SHOW);
    1: WinExecAndWait32V2('control.exe ' + LItemStr, SW_SHOWNORMAL);
    2: WinExec(PAnsiChar('control.exe ' + LAnsiItemStr), SW_SHOWNORMAL);
  end;
end;

//=============================================================================
//  ListBox1のOnDblClickイベント処理
//  実行ファイル名を表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  LItemStr : string;
begin
  if ListBox1.ItemIndex < 0 then exit;

  //選択中のItemsの.cplファイル名を取得して起動名文字列を作成
  LItemStr := PString(ListBox1.Items.Objects[ListBox1.ItemIndex])^;
  Edit1.Text := LItemStr;
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.

procedure TForm1.ListBox1Click(Sender: TObject);
var
  LItemStr   : string;
  LParameter : string;
begin
  if ListBox1.ItemIndex < 0 then exit;

  //選択中のItemsの.cplファイル名を取得して起動名文字列を作成
  LItemStr   := PString(ListBox1.Items.Objects[ListBox1.ItemIndex])^;
  LParameter := 'Shell32.dll, Control_RunDLL ' + LItemStr;

  ShellExecute(Handle, '', 'Rundll32.exe', PChar(LParameter), nil, SW_SHOW);
end;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    ImageList1: TImageList;
    Label1: TLabel;
    procedure ListView1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Types,
  IOUtils,
  cpl,
  ShellAPI,
  CommCtrl;

{$R *.dfm}

{ TForm1 }

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Visible := False;
  Button1Click(nil);
end;

//=============================================================================
//  cplファイルを列挙
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSysDir        : array [0..MAX_PATH - 1] of Char;
  LInfoName      : array [0..MAX_PATH - 1] of Char;
  LInfoComment   : array [0..MAX_PATH - 1] of Char;
  LFilesList     : TStringDynArray;
  LFilePath      : String;
  LFileName      : String;
  LListItem      : TListItem;
  LhLib          : THandle;
  LCplAppletProc : TCPLApplet;
  LCplItemCnt    : Integer;
  LCplInfo       : TCPLInfo;
  LNewCPLInfo    : TNewCPLInfo;
  LIcon          : TIcon;
  i              : Integer;
begin
  //システムディレクトリを取得
  //ここにcplファイルがある
  GetSystemDirectory(LSysDir, MAX_PATH);

  //テキスト表示を補完するツールチップを非表示にする
  ListView_SetToolTips(ListView1.Handle, 0);
  ListView1.Items.Clear;
  ListView1.Items.BeginUpdate;
  ListView1.SmallImages.Clear;

  ListView1.Column[0].Width := 180;
  ListView1.Column[1].Width := 140;
  ListView1.Column[2].Width := -1;


  //指定ディレクトリのサブディレクトリ内も検索
  LFilesList := TDirectory.GetFileSystemEntries(LSysDir, '*.cpl');
  for LFilePath in LFilesList do begin
    LFileName := TPath.GetFileName(LFilePath);
    LListItem := ListView1.Items.Add;
    LListItem.Caption := LFileName;
    LListItem.ImageIndex := -1;

    //DLLとしてのcplファイルのロード
    LhLib := LoadLibrary(PChar(LFileName));
    if LhLib = 0 then Continue;

    try
      //関数のアドレスを取得
      LCplAppletProc := TCPLApplet(GetProcAddress(LhLib, 'CPlApplet'));
      if @LCplAppletProc = nil then Continue;

      LCplAppletProc(Handle, CPL_INIT, 0, 0);
      //同じcpl内に複数のダイアログが存在する場合がある
      //その数を取得
      LCplItemCnt := LCplAppletProc(Handle, CPL_GETCOUNT, 0, 0);
      for i := 0 to LCplItemCnt - 1 do begin
        if i > 0 then begin
          LListItem := ListView1.Items.Add;
          LListItem.Caption := LFileName;
        end;

        //TCPLInfo構造体の情報を取得
        FillChar(LCplInfo, Sizeof(TCPLInfo), 0);
        LCplAppletProc(Handle, CPL_INQUIRE, i, LPARAM(@LCplInfo));

        //ダイアログの種類名と説明文を取り出す
        LoadString(LhLib, LCplInfo.idName, @LInfoName, MAX_PATH);
        LoadString(LhLib, LCplInfo.idInfo, @LInfoComment, MAX_PATH);

        //アイコンの生成
        LIcon := TIcon.Create;
        try
          //TNewCPLInfoでの設定がある場合を検出
          FillChar(LNewCPLInfo, Sizeof(TNewCPLInfo), 0);
          LCplAppletProc(Handle, CPL_NEWINQUIRE, i, LPARAM(@LNewCPLInfo));

          if LCplInfo.idName = CPL_DYNAMIC_RES then begin
            StrCopy(LInfoName, LNewCPLInfo.szName);
          end;
          if LCplInfo.idInfo = CPL_DYNAMIC_RES then begin
            StrCopy(LInfoComment, LNewCPLInfo.szInfo);
          end;

          //アイコンの取得
          if LCplInfo.idIcon = CPL_DYNAMIC_RES then begin
            LIcon.Handle := LNewCPLInfo.hIcon;
          end else begin
            LIcon.Handle := LoadIcon(LhLib, MAKEINTRESOURCE(LCplInfo.idIcon));
            ListView1.SmallImages.AddIcon(LIcon);
          end;
          LListItem.ImageIndex := ListView1.SmallImages.Count - 1;
        finally
          FreeAndNil(LIcon);
        end;

        LListItem.SubItems.Add(LInfoName);
        LListItem.SubItems.Add(LInfoComment);

        //同名のcplファイルで異なるダイアログの時はその番号を保持
        //TListView.TListItemのDataプロパティに代入しておく
        LListItem.Data := PInteger(i);

        LCplAppletProc(Handle, CPL_STOP, i, LCplInfo.lData);
        LCplAppletProc(Handle, CPL_EXIT, 0, 0);
      end;
    finally
      FreeLibrary(LhLib);
    end;
  end;
  ListView1.Items.EndUpdate;

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

//=============================================================================
//  ListView1のOnDblClickイベント処理
//  選択中のcplを実行する
//
//  64ビットWindowsでは,32ビットEXEで起動しないダイアログがある
//  リストにあっても起動しないダイアログがある(詳細な動作仕様については不明)
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  LInfoName      : array [0..MAX_PATH - 1] of Char;
  LIndex         : Integer;
  LhLib          : THandle;
  LCplAppletProc : TCPLApplet;
  LCplInfo       : TCPLInfo;
  LCplItemIndex  : Integer;
  LCmdText       : string;
  LiRet          : Integer;
begin
  LIndex := ListView1.ItemIndex;
  if LIndex < 0 then exit;

  //DLLとしてのcplファイルのロード
  LhLib := LoadLibrary(PChar(ListView1.Items[LIndex].Caption));
  if LhLib = 0 then exit;

  //同名のcplファイルで異なるダイアログの時はその番号を取得
  //この値はTListView.TListItemのDataプロパティに格納している
  LCplItemIndex := Integer(ListView1.Items[LIndex].Data);

  LiRet := 0;
  //関数のアドレスを取得
  LCplAppletProc := TCPLApplet(GetProcAddress(LhLib, 'CPlApplet'));
  if @LCplAppletProc <> nil then begin
    try
      //cplを初期化してダブルクリックの動作を実行して後処理を行う
      LCplAppletProc(Handle, CPL_INIT, 0, 0);
      FillChar(LCplInfo, Sizeof(TCPLInfo), 0);
      LCplAppletProc(Handle, CPL_INQUIRE, LCplItemIndex, LongInt(@LCplInfo));
      LoadString(LhLib, LCplInfo.idName, @LInfoName, MAX_PATH);
      if string(LInfoName) <> '' then begin
        LiRet := 1;
        LCplAppletProc(Handle, CPL_DBLCLK, LCplItemIndex, LCplInfo.lData);
        LCplAppletProc(Handle, CPL_STOP, LCplItemIndex, LCplInfo.lData);
      end;
      LCplAppletProc(Handle, CPL_EXIT, 0, 0);
    finally
      FreeLibrary(LhLib);
    end;
  end;

  //関数のアドレスが取得できなかった場合はShellExecuteで実行
  //TCPLInfo.idNameが取得できなかった場合もShellExecuteで実行
  if LiRet = 0 then begin
    LCmdText := ListView1.Items[LIndex].Caption;
    ShellExecute(Handle, '', 'control.exe', PChar(LCmdText), nil, SW_SHOW);
  end;
end;

//=============================================================================
//  ListView1のOnKeyDownイベント処理
//  [Enter]キー押下でOnDblClickと同じ動作とする
//=============================================================================
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListView1DblClick(nil);
    Key := 0;
  end;
end;

end.