unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, 
  KnownFolders, 
  ActiveX;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  if not CheckWin32Version(6, 0) then begin
    Button3.Enabled := False;
    Button4.Enabled := False;
  end;
end;

//=============================================================================
//  CSIDL値からフォルダのパス名を取得
//
//  SHGetFolderPath の使用には，uses に ShlObj が必要
//  CSIDL_XXX の使用には，usesにShlObj が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBuff : array [0..MAX_PATH-1] of Char;
  LiRet : HRESULT;
  LDir  : string;
begin
  FillChar(LBuff, SizeOf(LBuff), #0);

  LiRet := SHGetFolderPath(0, CSIDL_PROGRAM_FILES, 0, SHGFP_TYPE_CURRENT, @LBuff);
  if LiRet = S_OK then begin
    LDir := LBuff;
    MessageBox(0, PChar(LDir), '結果', MB_OK);
  end;
end;

//=============================================================================
//  CSIDL 値からフォルダの項目識別子を取得
//
//  SHGetFolderLocation の使用には，uses に ShlObj が必要
//  CSIDL_XXXの使用には，uses に ShlObj が必要
//  CoTaskMemFree の使用には，uses に ActiveX が必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LItemID : PItemIDList;
  LBuff   : array [0..MAX_PATH-1] of Char;
  LDir    : string;
begin
  // 最初に nil にしておくと，解放の際に nil がどうかで判定が可能
  LItemID := nil;

  if SHGetFolderLocation(0, CSIDL_PROGRAM_FILES, 0, 0, LItemID) = S_OK then begin
    //項目識別子からパス名を取得
    FillChar(LBuff, SizeOf(LBuff), #0);
    SHGetPathFromIDList(LItemID, @LBuff);
    LDir := LBuff;
  end;

  // 項目識別子のメモリアロケートの解放
  if LItemID <> nil then CoTaskMemFree(LItemID);

  MessageBox(0, PChar(LDir), '結果', MB_OK);
end;

//=============================================================================
//  FOLDERID からフォルダのパス名を取得
//  Windows Vista 以降用
//
//  SHGetKnownFolderPath の使用には，uses に ShlObj が必要
//  FOLDERID_XXX の使用には，uses に KnownFolders が必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LpFolderPath : PChar;
  LiRet        : HRESULT;
  FolderPath  : string;
begin
  LiRet := SHGetKnownFolderPath(FOLDERID_ProgramFiles, 0, 0, LpFolderPath);

  if LiRet = S_OK then begin
    FolderPath := LpFolderPath;
    MessageBox(0, PChar(FolderPath), '結果', MB_OK);
  end;
end;

//=============================================================================
//  FOLDERID からフォルダの項目識別子を取得
//  Windows Vista 以降用
//
//  SHGetKnownFolderIDList の使用には，uses に ShlObj が必要
//  FOLDERID_XXX の使用には，uses に KnownFolders が必要
//  CoTaskMemFree の使用には，uses に ActiveX が必要
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LItemID : PItemIDList;
  LBuff   : array [0..MAX_PATH-1] of Char;
  LDir    : string;
begin
  // 最初に ni lにしておくと，解放の際にnilがどうかで判定が可能
  LItemID := nil;

  if SHGetKnownFolderIDList(FOLDERID_ProgramFiles, 0, 0, LItemID) = S_OK then begin
    // 項目識別子からパス名を取得
    FillChar(LBuff, SizeOf(LBuff), #0);
    SHGetPathFromIDList(LItemID, @LBuff);
    LDir := LBuff;
  end;

  // 項目識別子のメモリアロケートの解放
  if LItemID <> nil then CoTaskMemFree(LItemID);

  MessageBox(0, PChar(LDir), '結果', MB_OK);
end;

end.

procedure TForm1.Button1Click(Sender: TObject);
var
  LpFolderPath : PChar;
  LFolderPath  : String;
begin
  LpFolderPath := StrAlloc(MAX_PATH + 1);
  try
    if SHGetFolderPath(0, CSIDL_PROGRAM_FILES, 0, 0, LpFolderPath) = S_OK then begin
      LFolderPath := LpFolderPath;
      MessageBox(0, PChar(LFolderPath), '結果', MB_OK);
    end;
  finally
    StrDispose(LpFolderPath);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LFolderPath : String;
begin
  SetLength(LFolderPath, MAX_PATH);
  if SHGetFolderPath(0, CSIDL_PROGRAM_FILES, 0, 0, PChar(LFolderPath)) = S_OK then begin
    MessageBox(0, PChar(LFolderPath), '結果', MB_OK);
  end;
end;

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, 
  ShellAPI;

//=============================================================================
//  Form 生成時の処理
//  ディスクから CSIDL 値を格納したファイルを読み込み
//  ListBox1 の各 Item に AddObject で表示する文字列と各 CSIDL 値をセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LStrList     : TStringList;
  LTempStrList : TStringList;
  LIndex       : Integer;
begin
  LStrList     := TStringList.Create;
  LTempStrList := TStringList.Create;
  try
    LStrList.LoadFromFile('../CSIDL_List.csv');
    LStrList.Sort;

    // CSV を操作するのでデリミタを設定
    LTempStrList.Delimiter       := ',';
    LTempStrList.StrictDelimiter := True;

    ListBox1.Items.BeginUpdate;
    for LIndex := 0 to LStrList.Count - 1 do begin
      LTempStrList.DelimitedText := LStrList[LIndex];
      ListBox1.Items.AddObject(LTempStrList[0], TObject(StrToInt(LTempStrList[1])));
    end;
    ListBox1.Items.EndUpdate;
  finally
    FreeAndNil(LStrList);
    FreeAndNil(LTempStrList);
  end;
end;

//=============================================================================
//  ListBox の項目をダブルクリックしたらその CSIDL に相当するのフォルダ名を取得
//  そのフォルダを [ファイルを開く] ダイアログまたはエクスプローラで開く
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex   : Integer;
  LCSIDL   : Integer;
  LBuff    : array [0..MAX_PATH] of Char;
  LDir     : string;
  LExeFile : string;
  LhInst   : Cardinal;
begin
  Edit1.Text := '';

  // ListBox1 の Index を取得してその TObject で定義した値を取出す
  LIndex  := ListBox1.ItemIndex;
  LCSIDL  := Integer(ListBox1.Items.Objects[LIndex]);

  FillChar(LBuff, SizeOf(LBuff), #0);
  if SHGetFolderPath(0, LCSIDL, 0, 0, @LBuff) = S_OK then begin
    LDir       := LBuff;
    Edit1.Text := LDir;

    // 以下，取得した値の確認用
    if (Sender <> nil) and (LDir <> '') then begin
      if RadioGroup1.ItemIndex = 0 then begin
        OpenDialog1.InitialDir := LDir;
        OpenDialog1.Execute;
        Update;
      end else begin
        // 実際には起動アプリが空でもエクスプローラは起動する
        // あるいは，起動ファイルにパス名を指定すれば起動する
        LExeFile := 'explorer.exe';
        LhInst   := ShellExecute(Handle,
                                 'open',
                                 PChar(LExeFile),
                                 PChar(LDir),
                                nil,
                                 SW_SHOW);
        if LhInst <= 32 then begin
          MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
        end;
      end;
    end;
  end;
end;

//=============================================================================
//  ListBox1 の項目を選択したら，パス名を取得して Edit1 に表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  ListBox1 で [Enter] キーを押したら，ダブルクリックと同じ動作をさせる
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListBox1DblClick(Sender);
  end;
end;

//=============================================================================
//  RaditoGroup1 の OnClick イベント処理
//  ListBox1 にフォーカス移動して [Enter] キー操作可能にする
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  ListBox1.SetFocus;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, 
  ActiveX, 
  ShellAPI;

//=============================================================================
//  Form 生成時の処理
//  ディスクから CSIDL 値を格納したファイルを読み込み
//  ListBox1 の各 Item に AddObject で表示する文字列と各 CSIDL 値をセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LStrList     : TStringList;
  LTempStrList : TStringList;
  LIndex       : Integer;
begin
  LStrList     := TStringList.Create;
  LTempStrList := TStringList.Create;
  try
    LStrList.LoadFromFile('../CSIDL_List.csv');
    LStrList.Sort;

    // CSV を操作するのでデリミタを設定
    LTempStrList.Delimiter       := ',';
    LTempStrList.StrictDelimiter := True;

    ListBox1.Items.BeginUpdate;
    for LIndex := 0 to LStrList.Count - 1 do begin
      LTempStrList.DelimitedText := LStrList[LIndex];
      ListBox1.Items.AddObject(LTempStrList[0], TObject(StrToInt(LTempStrList[1])));
    end;
    ListBox1.Items.EndUpdate;
  finally
    FreeAndNil(LStrList);
    FreeAndNil(LTempStrList);
  end;
end;

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

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

//=============================================================================
//  TListBox の項目をダブルクリックしたらその CSIDL に相当する項目識別子を取得
//  その項目識別子に相当するフォルダを
//  [ファイルを開く]ダイアログまたはエクスプローラで開く
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex          : Integer;
  LCSIDL          : Integer;
  LItemID         : PItemIDList;
  LpDesktopFolder : IShellFolder;
  LDisplayName    : string;
  LFolderPath     : string;
  LExeFile        : string;
  LhInst          : Cardinal;
begin
  Edit1.Text := '';
  Edit2.Text := '';
  LItemID     := nil;

  // ListBox1 の Index を取得してその TObject で定義した値を取出す
  LIndex := ListBox1.ItemIndex;
  LCSIDL := Integer(ListBox1.Items.Objects[LIndex]);

  // CSIDL に相当する項目識別子を取得
  if SHGetFolderLocation(0, LCSIDL, 0, 0, LItemID) = S_OK then begin

    //  [デスクトップ] のシェルフォルダオブジェクトを取得
    SHGetDesktopFolder(LpDesktopFolder);

    // 取得した項目識別子から表示名とバス名を取得
    LDisplayName := GetDispNameFromPItemID(LpDesktopFolder, LItemID, SHGDN_INFOLDER);
    LFolderPath  := GetDispNameFromPItemID(LpDesktopFolder, LItemID, SHGDN_FORPARSING);

    Edit1.Text := LFolderPath;
    Edit2.Text := LDisplayName;

    // 以下，取得した値の確認用
    if (Sender <> nil) and (LFolderPath <> '') then begin
      if RadioGroup1.ItemIndex = 0 then begin
        OpenDialog1.InitialDir := LFolderPath;
        OpenDialog1.Execute;
        Update;
      end else begin
        // 実際には起動アプリが空でもエクスプローラは起動する
        // あるいは，起動ファイルにパス名を指定すれば起動する
        LExeFile := 'explorer.exe';
        LhInst   := ShellExecute(Handle,
                                 'open',
                                 PChar(LExeFile),
                                 PChar(LFolderPath),
                                 nil,
                                 SW_SHOW);
        if LhInst <= 32 then begin
          MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
        end;
      end;
    end;
  end;

  // 項目識別子のメモリアロケートの解放
  if LItemID <> nil then CoTaskMemFree(LItemID);
end;

//=============================================================================
//  ListBox1 の項目を選択したら，パス名を取得して Edit1 に表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  ListBox1 で [Enter] キーを押したら，ダブルクリックと同じ動作をさせる
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListBox1DblClick(Sender);
  end;
end;

//=============================================================================
//  RaditoGroup1 の OnClick イベント処理
//  ListBox1 にフォーカス移動して [Enter] キー操作可能にする
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  ListBox1.SetFocus;
end;

end.

unit Unit1;

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 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}

uses 
  ShlObj, 
  ShellAPI, 
  ActiveX;

//=============================================================================
//  Form生成時の処理
//  ディスクから CSIDL 値を格納したファイルを読み込み
//  ListBox1 の各 Item に AddObject で表示する文字列と各 CSIDL 値をセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LStrList     : TStringList;
  LTempStrList : TStringList;
  LIndex       : Integer;
begin
  LStrList     := TStringList.Create;
  LTempStrList := TStringList.Create;
  try
    LStrList.LoadFromFile('../CSIDL_List.csv');
    LStrList.Sort;

    // CSV を操作するのでデリミタを設定
    LTempStrList.Delimiter       := ',';
    LTempStrList.StrictDelimiter := True;

    ListBox1.Items.BeginUpdate;
    for LIndex := 0 to LStrList.Count - 1 do begin
      LTempStrList.DelimitedText := LStrList[LIndex];
      ListBox1.Items.AddObject(LTempStrList[0], TObject(StrToInt(LTempStrList[1])));
    end;
    ListBox1.Items.EndUpdate;
  finally
    FreeAndNil(LStrList);
    FreeAndNil(LTempStrList);
  end;
end;

//-----------------------------------------------------------------------------
//  ShellExecuteEx で指定ファイルを実行
//
//  SEE_MASK_NOCLOSEPROCESS
//    ShellExcuteEx 実行後，プロセスを維持 Process にプロセスのハンドルを返す
//  SEE_MASK_FLAG_NO_UI
//    エラー発生時にメッセージBoxを表示しない
//  SEE_MASK_IDLIST
//    項目識別子を使用する
//-----------------------------------------------------------------------------
function RunExeFilePIDL(hWnd: HWND; AFile: String; pidlFile: PItemIDList;
   Verb: string): Cardinal;
var
  LInfo : TShellExecuteInfo;
  LRet  : DWORD;
begin
  FillChar(LInfo, SizeOf(LInfo), 0);
  LInfo.cbSize   := SizeOf(LInfo);
  LInfo.Wnd      := hWnd;
  LInfo.fMask    := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI or SEE_MASK_IDLIST;
  LInfo.lpVerb   := PChar(Verb);
  LInfo.lpFile   := PChar(AFile);
  LInfo.lpIDList := pidlFile;
  LInfo.nShow    := SW_SHOW;

  ShellExecuteEx(@LInfo);

  // ShellExecuteEx は成功すると hInstApp に 33 以上の値を返す
  if LInfo.hInstApp >= 33 then
  begin
    repeat
      LRet := WaitForInputIdle(LInfo.hProcess, 50);
      Application.ProcessMessages;
    until LRet <> WAIT_TIMEOUT;
  end;
  CloseHandle(LInfo.hProcess);

  Result := LInfo.hInstApp;
end;

//=============================================================================
//  TListBox の項目をダブルクリックしたらその CSIDL に相当する項目識別子を取得
//  その項目識別子のフォルダをエクスプローラで表示
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex   : Integer;
  LCSIDL   : Integer;
  LItemID  : PItemIDList;
  LBuff    : array [0..MAX_PATH] of Char;
  LExeFile : string;
  LiRet    : Cardinal;
begin
  Edit1.Text := '';
  LItemID    := nil;

  // ListBox1 の Index を取得してその TObject で定義した値を取出す
  LIndex := ListBox1.ItemIndex;
  LCSIDL := Integer(ListBox1.Items.Objects[LIndex]);

  // LCSIDL に相当する項目識別子を取得
  if SHGetFolderLocation(0, LCSIDL, 0, 0, LItemID) = S_OK then begin

    // 項目識別子からパス名を取得
    // 仮想フォルダは取得できない
    FillChar(LBuff, SizeOf(LBuff), #0);
    SHGetPathFromIDList(LItemID, LBuff);
    Edit1.Text := LBuff;

    // 以下，取得した値の確認用
    // 実際には起動アプリが空でもエクスプローラは起動する
    // あるいは，起動ファイルにパス名を指定すれば起動する
    LExeFile := 'explorer.exe';
    if Sender <> nil then begin
      if LItemID <> nil then begin
        LiRet := RunExeFilePIDL(0, LExeFile, LItemID, '');
        if LiRet <= 32 then begin
          MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
        end;
      end;
    end;
  end;

  // 項目識別子のメモリアロケートの解放
  if LItemID <> nil then CoTaskMemFree(LItemID);
end;

//=============================================================================
//  ListBox1 の項目を選択したら，パス名を取得して Edit1 に表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  ListBox1 で [Enter] キーを押したら，ダブルクリックと同じ動作をさせる
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListBox1DblClick(Sender);
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    RadioGroup1: TRadioGroup;
    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);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { Private 宣言 }
    FStrList : TStringList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, 
  ShellAPI;

//=============================================================================
//  Form生成時の処理
//  ディスクからファイルを読み込み
//  ListBox1 の各 Item に表示する FOLDERID の文字列をセット
//  実際に使用する FOLDERID の TGUIDは 文字列として TStringList に残す
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LTempStrList : TStringList;
  LIndex       : Integer;
begin
  FStrList     := TStringList.Create;
  LTempStrList := TStringList.Create;
  try
    FStrList.LoadFromFile('../FOLDERID_List.csv');
    FStrList.Sort;

    // CSV を操作するのでデリミタを設定
    LTempStrList.Delimiter       := ',';
    LTempStrList.StrictDelimiter := True;

    for LIndex := 0 to FStrList.Count - 1 do begin
      LTempStrList.DelimitedText := FStrList[LIndex];
      ListBox1.Items.Add(Trim(LTempStrList[0]));
      FStrList[LIndex] := Trim(LTempStrList[1]);
    end;
  finally
    FreeAndNil(LTempStrList);
  end;
end;

//=============================================================================
//  終了時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FStrList);
end;

//=============================================================================
//  TListBox の項目をダブルクリックしたらその FOLDERID に相当するフォルダ名を取得
//  そのフォルダで[ファイル選択]ダイアログまたはエクスプローラで表示
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex        : Integer;
  LFolderID     : TGUID;
  LpFolderPath  : PChar;
  LFolderPath   : string;
  LExeFile      : string;
  LhInst        : Cardinal;
begin
  Edit1.Text := '';

  // FOLDERIDのTGUID の値を取得
  LIndex    := ListBox1.ItemIndex;
  LFolderID := StringToGUID(FStrList[LIndex]);

  // フォルダのパス名を取得
  if SHGetKnownFolderPath(LFolderID, 0, 0, LpFolderPath) = S_OK then begin

    LFolderPath := LpFolderPath;
    Edit1.Text  := LFolderPath;

    // 以下，取得した値の確認用
    if (Sender <> nil) and (LFolderPath <> '') then begin
      if RadioGroup1.ItemIndex = 0 then begin
        OpenDialog1.InitialDir := LFolderPath;
        OpenDialog1.Execute;
        Update;
      end else begin
        // 実際には起動アプリが空でもエクスプローラは起動する
        // あるいは，起動ファイルにパス名を指定すれば起動する
        LExeFile := 'explorer.exe';
        LhInst   := ShellExecute(Handle,
                                 'open',
                                 PChar(LExeFile),
                                 PChar(LFolderPath),
                                 nil,
                                 SW_SHOW);
        if LhInst <= 32 then begin
          MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
        end;
      end;
    end;
  end;
end;

//=============================================================================
//  ListBox1 の項目を選択したら，パス名を取得して Edit1 に表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  ListBox1 で [Enter] キーを押したら，ダブルクリックと同じ動作をさせる
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListBox1DblClick(Sender);
  end;
end;

//=============================================================================
//  RaditoGroup1 の OnClick イベント処理
//  ListBox1にフォーカス移動して [Enter] キー操作可能にする
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  ListBox1.SetFocus;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    RadioGroup1: TRadioGroup;
    Edit2: 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);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { Private 宣言 }
    FStrList : TStringList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, 
  ActiveX, 
  ShellAPI;

//=============================================================================
//  Form 生成時の処理
//  ディスクからファイルを読み込み
//  ListBox1 の各 Item に表示する FOLDERID の文字列をセット
//  実際に使用する FOLDERID の TGUID は文字列として TStringList に残す
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LTempStrList : TStringList;
  LIndex       : Integer;
begin
  FStrList     := TStringList.Create;
  LTempStrList := TStringList.Create;
  try
    FStrList.LoadFromFile('../FOLDERID_List.csv');
    FStrList.Sort;

    // CSV を操作するのでデリミタを設定
    LTempStrList.Delimiter       := ',';
    LTempStrList.StrictDelimiter := True;

    for LIndex := 0 to FStrList.Count - 1 do begin
      LTempStrList.DelimitedText := FStrList[LIndex];
      ListBox1.Items.Add(Trim(LTempStrList[0]));
      FStrList[LIndex] := Trim(LTempStrList[1]);
    end;
  finally
    FreeAndNil(LTempStrList);
  end;
end;

//=============================================================================
//  終了時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FStrList);
end;

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

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

//=============================================================================
//  TListBox の項目をダブルクリックしたらその FOLDERID に相当する項目識別子を取得
//  その項目識別子に相当するフォルダで
//  [ファイル選択] ダイアログまたはエクスプローラを開く
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex          : Integer;
  LFolderID       : TGUID;
  LItemID         : PItemIDList;
  LpDesktopFolder : IShellFolder;
  LDisplayName    : string;
  LFolderPath     : string;
  LExeFile        : string;
  LhInst          : Cardinal;
begin
  Edit1.Text := '';
  Edit2.Text := '';
  LItemID    := nil;

  // FOLDERID の TGUID の値を取得
  LIndex    := ListBox1.ItemIndex;
  LFolderID := StringToGUID(FStrList[LIndex]);

  // FOLDERID の TGUID に相当する項目識別子を取得
  if SHGetKnownFolderIDList(LFolderID, 0, 0, LItemID) = S_OK then begin

    // [デスクトップ] のシェルフォルダオブジェクトを取得
    SHGetDesktopFolder(LpDesktopFolder);

    // 取得した項目識別子から表示名とバス名を取得
    LDisplayName := GetDispNameFromPItemID(LpDesktopFolder, LItemID, SHGDN_INFOLDER);
    LFolderPath  := GetDispNameFromPItemID(LpDesktopFolder, LItemID, SHGDN_FORPARSING);

    Edit1.Text := LFolderPath;
    Edit2.Text := LDisplayName;

    // 以下，取得した値の確認用
    if (Sender <> nil) and (LFolderPath <> '') then begin
      if RadioGroup1.ItemIndex = 0 then begin
        OpenDialog1.InitialDir := LFolderPath;
        OpenDialog1.Execute;
        Update;
      end else begin
        // 実際には起動アプリが空でもエクスプローラは起動する
        // あるいは，起動ファイルにパス名を指定すれば起動する
        LExeFile := 'explorer.exe';
        LhInst   := ShellExecute(Handle,
                                'open',
                                PChar(LExeFile),
                                PChar(LFolderPath),
                                nil,
                                SW_SHOW);
        if LhInst <= 32 then begin
          MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
        end;
      end;
    end;
  end;

  // 項目識別子のメモリアロケートの解放
  if LItemID <> nil then CoTaskMemFree(LItemID);
end;

//=============================================================================
//  ListBox1 の項目を選択したら，パス名を取得して Edit1 に表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  ListBox1 で [Enter] キーを押したら，ダブルクリックと同じ動作をさせる
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListBox1DblClick(Sender);
  end;
end;

//=============================================================================
//  RaditoGroup1 の OnClick イベント処理
//  ListBox1 にフォーカス移動して [Enter] キー操作可能にする
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  ListBox1.SetFocus;
end;

end.

unit Unit1;

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 ListBox1Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private 宣言 }
    FStrList : TStringList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, 
  ShellAPI, 
  ActiveX;

//=============================================================================
//  Form 生成時の処理
//  ディスクからファイルを読み込み
//  ListBox1 の各 Item に表示する FOLDERID の文字列をセット
//  実際に使用する FOLDERID の TGUID は文字列として TStringList に残す
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LTempStrList : TStringList;
  LIndex       : Integer;
begin
  FStrList     := TStringList.Create;
  LTempStrList := TStringList.Create;
  try
    FStrList.LoadFromFile('../FOLDERID_List.csv');
    FStrList.Sort;

    // CSV を操作するのでデリミタを設定
    LTempStrList.Delimiter       := ',';
    LTempStrList.StrictDelimiter := True;

    for LIndex := 0 to FStrList.Count - 1 do begin
      LTempStrList.DelimitedText := FStrList[LIndex];
      ListBox1.Items.Add(Trim(LTempStrList[0]));
      FStrList[LIndex] := Trim(LTempStrList[1]);
    end;
  finally
    FreeAndNil(LTempStrList);
  end;
end;

//=============================================================================
//  終了時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FStrList);
end;

//-----------------------------------------------------------------------------
//  ShellExecuteEx で指定ファイルを実行
//
//  SEE_MASK_NOCLOSEPROCESS
//    ShellExcuteEx 実行後，プロセスを維持Processにプロセスのハンドルを返す
//  SEE_MASK_FLAG_NO_UI
//    エラー発生時にメッセージ Box を表示しない
//  SEE_MASK_IDLIST
//    項目識別子を使用する
//-----------------------------------------------------------------------------
function RunExeFilePIDL(hWnd: HWND; AFile: String; pidlFile: PItemIDList;
   Verb: string): Cardinal;
var
  LInfo : TShellExecuteInfo;
  LRet  : DWORD;
begin
  FillChar(LInfo, SizeOf(LInfo), 0);
  LInfo.cbSize := SizeOf(LInfo);
  LInfo.Wnd      := hWnd;
  LInfo.fMask    := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI or SEE_MASK_IDLIST;
  LInfo.lpVerb   := PChar(Verb);
  LInfo.lpFile   := PChar(AFile);
  LInfo.lpIDList := pidlFile;
  LInfo.nShow    := SW_SHOW;

  ShellExecuteEx(@LInfo);

  // ShellExecuteEx は成功すると hInstAppに 33 以上の値を返す
  if LInfo.hInstApp >= 33 then
  begin
    repeat
      LRet := WaitForInputIdle(LInfo.hProcess, 50);
      Application.ProcessMessages;
    until LRet <> WAIT_TIMEOUT;
  end;
  CloseHandle(LInfo.hProcess);

  Result := LInfo.hInstApp;
end;

//=============================================================================
//  TListBox の項目をダブルクリックしたらその FOLDERID に相当する項目識別子を取得
//  その項目識別子に相当するフォルダをエクスプローラで開く
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex    : Integer;
  LFolderID : TGUID;
  LItemID   : PItemIDList;
  LBuff     : array [0..MAX_PATH] of Char;
  LExeFile  : string;
  LiRet     : Cardinal;
begin
  Edit1.Text := '';
  LItemID     := nil;

  // LFolderID の TGUID の値を取得
  LIndex    := ListBox1.ItemIndex;
  LFolderID := StringToGUID(FStrList[LIndex]);

  // LFolderID の TGUID に相当する項目識別子を取得
  if SHGetKnownFolderIDList(LFolderID, 0, 0, LItemID) = S_OK then begin

    // 項目識別子からパス名を取得
    // 仮想フォルダは取得できない
    FillChar(LBuff, SizeOf(LBuff), #0);
    SHGetPathFromIDList(LItemID, LBuff);
    Edit1.Text := LBuff;

    // 以下，取得した値の確認用
    // 実際には起動アプリが空でもエクスプローラは起動する
    // あるいは，起動ファイルにパス名を指定すれば起動する
    LExeFile := 'explorer.exe';
    if Sender <> nil then begin
      if LItemID <> nil then begin
        LiRet := RunExeFilePIDL(0, LExeFile, LItemID, '');
        if LiRet <= 32 then begin
          MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
        end;
      end;
    end;
  end;

  // 項目識別子のメモリアロケートの解放
  if LItemID <> nil then CoTaskMemFree(LItemID);
end;

//=============================================================================
//  ListBox1 の項目を選択したら，パス名を取得して Edit1 に表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  ListBox1 で [Enter] キーを押したら，ダブルクリックと同じ動作をさせる
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListBox1DblClick(Sender);
  end;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, 
  ShellAPI, 
  ActiveX;

//=============================================================================
//  Form 生成時の処理
//  ディスクからファイルを読み込み
//  ListBox1 の各 Item に表示する FOLDERID の文字列をセット
//  実際に使用する FOLDERID の TGUID は文字列として TStringList に残す
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LTempStrList : TStringList;
  LIndex       : Integer;
begin
  FStrList     := TStringList.Create;
  LTempStrList := TStringList.Create;
  try
    FStrList.LoadFromFile('../FOLDERID_List.csv');
    FStrList.Sort;

    // CSV を操作するのでデリミタを設定
    LTempStrList.Delimiter       := ',';
    LTempStrList.StrictDelimiter := True;

    for LIndex := 0 to FStrList.Count - 1 do begin
      LTempStrList.DelimitedText := FStrList[LIndex];
      ListBox1.Items.Add(Trim(LTempStrList[0]));
      FStrList[LIndex] := Trim(LTempStrList[1]);
    end;
  finally
    FreeAndNil(LTempStrList);
  end;
end;

//=============================================================================
//  終了時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FStrList);
end;

//=============================================================================
//  ダブルクリックした らFOLDERID に相当する IShellItem オブジェクトを取得
//  IShellItem の GetDisplayName メソッドでフォルダのパス名と表示名を取得
//  そのフォルダを [ファイルを開く] ダイアログまはたエクスプローラで表示
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex        : Integer;
  LFolderID     : TGUID;
  LpItem        : IShellItem;
  LiRet         : HRESULT;
  LpFilePath    : PChar;
  LpDisplayName : PChar;
  LExeFile      : string;
  LhInst        : Cardinal;
begin
  Edit1.Text    := '';
  Edit2.Text    := '';
  LpFilePath    := nil;
  LpDisplayName := nil;

  // ListBox1 の Index を取得してその TObject で定義した値を取出す
  LIndex    := ListBox1.ItemIndex;
  LFolderID := StringToGUID(FStrList[LIndex]);

  // FOLDERID に相当する IShellItem オブジェクトを取得
  LiRet := SHGetKnownFolderItem(LFolderID, 0, 0, IID_IShellItem, Pointer(LpItem));

  if LiRet = S_OK then begin
    //GetDisplayNameメソッドでパス名と表示名を取得
    // SIGDN_FILESYSPATH にすると仮想フォルダ等の GUID 文字列は取得できない
    LpItem.GetDisplayName(SIGDN_DESKTOPABSOLUTEPARSING, LpFilePath);
    LpItem.GetDisplayName(SIGDN_NORMALDISPLAY,          LpDisplayName);

    Edit1.Text := LpFilePath;
    Edit2.Text := LpDisplayName;

    // 以下，取得した値の確認用
    if (Sender <> nil) and (LpFilePath <> nil) then begin
      if RadioGroup1.ItemIndex = 0 then begin
        OpenDialog1.InitialDir := LpFilePath;
        OpenDialog1.Execute;
        Update;
      end else begin
        // 実際には起動アプリが空でもエクスプローラは起動する
        // あるいは，起動ファイルにパス名を指定すれば起動する
        LExeFile := 'explorer.exe';
        LhInst   := ShellExecute(Handle,
                                 'open',
                                 PChar(LExeFile),
                                 LpFilePath,
                                 nil,
                                 SW_SHOW);
        if LhInst <= 32 then begin
          MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
        end;
      end;
    end;
  end;

  if LpFilePath    <> nil then CoTaskMemFree(LpFilePath);
  if LpDisplayName <> nil then CoTaskMemFree(LpDisplayName);
end;

//=============================================================================
//  ListBox1 の項目を選択したら，パス名を取得し てEdit1 に表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  ListBox1 で [Enter] キーを押したら，ダブルクリックと同じ動作をさせる
//=============================================================================
procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    ListBox1DblClick(Sender);
  end;
end;

//=============================================================================
//  RaditoGroup1 の OnClick イベント処理
//  ListBox1 にフォーカス移動して [Enter] キー操作可能にする
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  ListBox1.SetFocus;
end;

end.

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  LIndex        : Integer;
  LFolderID     : TGUID;
  LpKonw        : IKnownFolderManager;
  LpKonwFolder  : IKnownFolder;
  LpItem        : IShellItem;
  LpFilePath    : PChar;
  LpDisplayName : PChar;
begin
  Edit1.Text    := '';
  Edit2.Text    := '';
  LpFilePath    := nil;
  LpDisplayName := nil;

  LIndex    := ListBox1.ItemIndex;
  LFolderID := StringToGUID(SL[LIndex]);

  if Failed(CoCreateInstance(CLSID_KnownFolderManager,
                             nil,
                             CLSCTX_INPROC_SERVER,
                             IKnownFolderManager,
                             LpKonw)) then exit;


  if LpKonw.GetFolder(LFolderID, LpKonwFolder) = S_OK then begin
    if LpKonwFolder.GetShellItem(0, IID_IShellItem, LpItem) = S_OK then begin
      LpItem.GetDisplayName(SIGDN_DESKTOPABSOLUTEEDITING, LpFilePath);
      LpItem.GetDisplayName(SIGDN_NORMALDISPLAY, LpDisplayName);
      Edit1.Text := LpFilePath;
      Edit2.Text := LpDisplayName;
    end;
  end;

  if LpFilePath    <> nil then CoTaskMemFree(LpFilePath);
  if LpDisplayName <> nil then CoTaskMemFree(LpDisplayName);
end;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  GetSystemDirectory 関数
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBuff : array[0..MAX_PATH-1] of Char;
  LSize : Cardinal;
begin
  Edit1.Text := '';

  FillChar(LBuff, SizeOf(LBuff), #0);
  LSize := Windows.GetSystemDirectory(@LBuff, SizeOf(LBuff));
  if LSize > 0 then begin
    Edit1.Text := LBuff;
  end;
end;

//=============================================================================
//  GetSystemDirectory関数
//  String 型で取得する場合
//  Windows API の関数の中には必要なバッファサイズを取得できるものもある
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LPathName : string;
  LSize     : Cardinal;
begin
  Edit1.Text := '';

  // 必要なバッファサイズを取得
  LSize := GetSystemDirectory(PChar(LPathName), 0);
  if LSize > 0 then begin
    // 受取るバッファサイズを設定
    SetLength(LPathName, LSize);

    Windows.GetSystemDirectory(PChar(LPathName), LSize);
    Edit1.Text := LPathName;
  end;
end;

//=============================================================================
//  GetWindowsDirectory 関数
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LBuff  : array[0..MAX_PATH-1] of Char;
  LSize  : Cardinal;
begin
  Edit1.Text := '';

  FillChar(LBuff, SizeOf(LBuff), #0);
  LSize := Windows.GetWindowsDirectory(@LBuff, SizeOf(LBuff));
  if LSize > 0 then begin
    Edit1.Text := LBuff;
  end;
end;

//=============================================================================
//  GetCurrentDirectory 関数
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LBuff : array[0..MAX_PATH-1] of Char;
  LSize : Cardinal;
begin
  Edit1.Text := '';

  FillChar(LBuff, SizeOf(LBuff), #0);
  LSize := Windows.GetCurrentDirectory(SizeOf(LBuff), @LBuff);
  if LSize > 0 then begin
    Edit1.Text := LBuff;
  end;
end;

//=============================================================================
//  GetHomePath 関数
//=============================================================================
procedure TForm1.Button5Click(Sender: TObject);
begin
  Edit1.Text := SysUtils.GetHomePath;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils;

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//  環境変数のリストを作成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LEnvList   : TStringList;
  LpEnvVars  : PChar;
  LpEnvEntry : PChar;
  LEnvString : string;
  LPos       : Integer;
  LIndex     : Integer;
begin
  ListBox1.Items.Clear;

  LEnvList := TStringList.Create;
  try
    // 環境変数の値のリストを取得
    LpEnvVars := GetEnvironmentStrings;

    if LpEnvVars <> nil then begin
      // 取得した PChar 型の文字列は #0 で区切られている．終端は #0#0
      // これを順番に取り出す
      // 先頭のポインタを退避
      LpEnvEntry := LpEnvVars;
      try
        while LpEnvEntry^ <> #0 do begin
          LEnvList.Add(LpEnvEntry);
          Inc(LpEnvEntry, StrLen(LpEnvEntry) + 1);
        end;
      finally
        // メモリブロックを破棄
        Windows.FreeEnvironmentStrings(LpEnvVars);
      end;
    end;

    // TListBox に結果を追加していく
    for LIndex := 0 to LEnvList.Count - 1 do begin
      LEnvString := Trim(LEnvList[LIndex]);
      LPos := Pos('=', LEnvString);
      LEnvString := StrUtils.AnsiLeftStr(LEnvString, LPos - 1);
      // 空だけにしないと IDE からの実行時に自分自身が含まれる
      if LEnvString <> '' then begin
        ListBox1.Items.Add(LEnvString);
      end;
    end;
  finally
    FreeAndNil(LEnvList);
  end;
end;

//=============================================================================
//  ListBox1 の OnClick イベント処理
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  LIndex      : Integer;
  LEnviroPath : string;
begin
  Edit1.Text := '';
  LIndex     := ListBox1.ItemIndex;
  if LIndex < 0 then exit;

  LEnviroPath := SysUtils.GetEnvironmentVariable(Trim(ListBox1.Items[LIndex]));
  Edit1.Text := LEnviroPath;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Panel1: TPanel;
    Splitter1: TSplitter;
    ListBox1: TListBox;
    ShellTreeView1: TShellTreeView;
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IOUtils;

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  ListBox1.Items.Clear;
  ListBox1.Items.Add('TPath.GetHomePath');
  ListBox1.Items.Add('TPath.GetTempPath');
  ListBox1.Items.Add('TPath.GetLibraryPath');
  ListBox1.Items.Add('TPath.GetDocumentsPath');
  ListBox1.Items.Add('TPath.GetSharedDocumentsPath');
  ListBox1.Items.Add('TPath.GetCachePath');
  ListBox1.Items.Add('TPath.GetPicturesPath');
  ListBox1.Items.Add('TPath.GetSharedPicturesPath');
  ListBox1.Items.Add('TPath.GetPublicPath');
  ListBox1.Items.Add('TPath.GetCameraPath');
  ListBox1.Items.Add('TPath.GetSharedCameraPath');
  ListBox1.Items.Add('TPath.GetMusicPath');
  ListBox1.Items.Add('TPath.GetSharedMusicPath');
  ListBox1.Items.Add('TPath.GetMoviesPath');
  ListBox1.Items.Add('TPath.GetSharedMoviesPath');
  ListBox1.Items.Add('TPath.GetAlarmsPath');
  ListBox1.Items.Add('TPath.GetSharedAlarmsPath');
  ListBox1.Items.Add('TPath.GetRingtonesPath ');
  ListBox1.Items.Add('TPath.GetSharedRingTonesPath');
  ListBox1.Items.Add('TPath.GetDownloadsPath');
  ListBox1.Items.Add('TPath.GetSharedDownloadsPath');
end;

//=============================================================================
//  ListBox1 の OnClick イベント処理
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  LIndex      : Integer;
  LFolderPath : string;
begin
  Edit1.Text := '';
  LIndex     := ListBox1.ItemIndex;
  if LIndex < 0 then exit;

  if LIndex =  0 then LFolderPath := TPath.GetHomePath;
  if LIndex =  1 then LFolderPath := TPath.GetTempPath;
  if LIndex =  2 then LFolderPath := TPath.GetLibraryPath;
  if LIndex =  3 then LFolderPath := TPath.GetDocumentsPath;
  if LIndex =  4 then LFolderPath := TPath.GetSharedDocumentsPath;
  if LIndex =  5 then LFolderPath := TPath.GetCachePath;
  if LIndex =  6 then LFolderPath := TPath.GetPicturesPath;
  if LIndex =  7 then LFolderPath := TPath.GetSharedPicturesPath;
  if LIndex =  8 then LFolderPath := TPath.GetPublicPath;
  if LIndex =  9 then LFolderPath := TPath.GetCameraPath;
  if LIndex = 10 then LFolderPath := TPath.GetSharedCameraPath;
  if LIndex = 11 then LFolderPath := TPath.GetMusicPath;
  if LIndex = 12 then LFolderPath := TPath.GetSharedMusicPath;
  if LIndex = 13 then LFolderPath := TPath.GetMoviesPath;
  if LIndex = 14 then LFolderPath := TPath.GetSharedMoviesPath;
  if LIndex = 15 then LFolderPath := TPath.GetAlarmsPath;
  if LIndex = 16 then LFolderPath := TPath.GetSharedAlarmsPath;
  if LIndex = 17 then LFolderPath := TPath.GetRingtonesPath;
  if LIndex = 18 then LFolderPath := TPath.GetSharedRingTonesPath;
  if LIndex = 19 then LFolderPath := TPath.GetDownloadsPath;
  if LIndex = 20 then LFolderPath := TPath.GetSharedDownloadsPath;

  Edit1.Text := LFolderPath;
  ShellTreeView1.Root := LFolderPath;
end;

end.