unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ShellAPI, ComObj, ActiveX, ExtCtrls, ShlObj,
  CommCtrl;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Panel3: TPanel;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Edit1: TEdit;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure ListView1Deletion(Sender: TObject; Item: TListItem);
    procedure ListView1Edited(Sender: TObject; Item: TListItem; var S: string);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    { Private 宣言 }
    FImageHandle     : THandle;
    FshFolderDesktop : IShellFolder;
    FshFolderExpand  : IShellFolder;
    FpidlDesktop     : PItemIDList;
    FpidlExpand      : PItemIDList;
    FBaseFolder      : String;
    function SetFilesListFromPItemIDList(ItemID: PItemIDList): Boolean;
    procedure ResetListViewColumn(pShellFolder: IShellFolder);
    function SetListViewItemSubItem(pShellFolder: IShellFolder;
      pidlChild: PItemIDList): Boolean;
  public
    { Public 宣言 }
    procedure ChangeViewStyle(iView: Integer);
    function GetFullPathFromListItem(Item: TListItem): String;
    function GetFullPathFromListItemEx(Item: TListItem): String;
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl, CSIDL_ListFormUnit;

{$R *.dfm}

const
  PID_STG_CLASSID        = 3;
  PID_STG_STORAGETYPE    = 4;
  PID_STG_VOLUME_ID      = 5;
  PID_STG_PARENT_WORKID  = 6;
  PID_STG_SECONDARYSTORE = 7;
  PID_STG_FILEINDEX      = 8;
  PID_STG_LASTCHANGEUSN  = 9;
  PID_STG_NAME           = $0A;
  PID_STG_PATH           = $0B;
  PID_STG_SIZE           = $0C;
  PID_STG_ATTRIBUTES     = $0D;
  PID_STG_WRITETIME      = $0E;
  PID_STG_CREATETIME     = $0F;
  PID_STG_ACCESSTIME     = $10;
  PID_STG_CHANGETIME     = $11;
  PID_STG_ALLOCSIZE      = $12;
  PID_STG_CONTENTS       = $13;
  PID_STG_SHORTNAME      = $14;

var
  g_shFolderExpand  : IShellFolder;            //展開中のフォルダオブジェクト
  g_SortColum       : array[0..3] of Integer;  //ソートのカラム番号用配列
  g_SortColumnIndex : Integer;                 //ソートカラム番号

//-----------------------------------------------------------------------------
//  フルパス相当の項目識別子(完全PIDL)からフルパス名を取得する関数
//  仮想フォルダは空文字出力
//-----------------------------------------------------------------------------
function GetFullPathFromABSPItemID(pidl: PItemIDList): String;
var
  Buff : array[0..MAX_PATH - 1] of Char;
begin
  FillChar(Buff, SizeOf(Buff), 0);
  SHGetPathFromIDList(pidl, Buff);
  Result := Buff;
end;

//-----------------------------------------------------------------------------
//  ソートのコールバック関数
//  項目識別子でソートする
//  実ファイル名でソートしたのですエクスプローラと同じ表示順とならない
//-----------------------------------------------------------------------------
function SortListViewData(Item1, Item2: TListItem;
  ParamSort: integer): Integer; stdcall;
begin
  Result := g_SortColum[g_SortColumnIndex] *
            SHORT($FFFF and g_shFolderExpand.CompareIDs(
                                             g_SortColumnIndex,
                                             Item1.Data,
                                             Item2.Data));
end;

//=============================================================================
//  テスト用ボタン
//  [デスクトップ]のファイルをリスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetFilesListFromPItemIDList(FpidlDesktop);
end;

//=============================================================================
//  テスト用ボタン
//  [特殊フォルダ]のファイルをリスト
//  CSIDLの一覧フォームを表示して，そこから選択する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  AIndex      : Integer;
  CSIDL_Value : Integer;
  pidl        : PItemIDList;
begin
  pidl := nil;
  //CSIDL値リストを表示するフォームを作成
  CSIDL_ListForm := TCSIDL_ListForm.Create(Self);

  try
    if CSIDL_ListForm.ShowModal = mrOk then begin
      Update;
      AIndex      := CSIDL_ListForm.ListBox1.ItemIndex;
      CSIDL_Value := Integer(CSIDL_ListForm.ListBox1.Items.Objects[AIndex]);

      //CSIDL_XXXの値から項目識別子を取得
      SHGetSpecialFolderLocation(0, CSIDL_Value, pidl);
      if pidl <> nil then begin
        SetFilesListFromPItemIDList(pidl);
        CoTaskMemFree(pidl);
      end else begin
        MessageBox(0, '取得できませんでした．', '結果', MB_OK);
      end;
    end;
  finally
    FreeAndNil(CSIDL_ListForm);
  end;
end;

//=============================================================================
//  テスト用ボタン
//  [一般フォルダ]のファイルリスト
//  フォルダの選択ダイアログを表示して選択する
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  pidl : PItemIDList;
begin
  pidl := nil;
  if FBaseFolder = '' then FBaseFolder := ExtractFileDir(ParamStr(0));

  if SelectDirectory('フォルダ指定', '', FBaseFolder) then begin
    Update;

    //ファイル名を項目識別子に変換
    pidl := ILCreateFromPath(PChar(FBaseFolder));
    if (pidl = nil) or (FBaseFolder = '') then begin
      MessageBox(0, '取得できませんでした．', '結果', MB_OK);
    end else begin
      SetFilesListFromPItemIDList(pidl);
    end;
  end;
  if pidl <> nil then CoTaskMemFree(pidl);
end;

//=============================================================================
//  テスト用ボタン
//  [アイコン]表示
//=============================================================================
procedure TForm1.Button10Click(Sender: TObject);
begin
  ChangeViewStyle(LV_VIEW_ICON);
end;

//=============================================================================
//  テスト用ボタン
//  [リスト]表示 [並べて表示]に相当
//=============================================================================
procedure TForm1.Button11Click(Sender: TObject);
begin
  ChangeViewStyle(LV_VIEW_LIST);
end;

//=============================================================================
//  テスト用ボタン
//  [タイル] [一覧]表示に相当
//=============================================================================
procedure TForm1.Button12Click(Sender: TObject);
begin
  ChangeViewStyle(LV_VIEW_TILE);
end;

//=============================================================================
//  テスト用ボタン
//  [詳細表示]
//=============================================================================
procedure TForm1.Button13Click(Sender: TObject);
begin
  ChangeViewStyle(LV_VIEW_DETAILS);
end;

//=============================================================================
//  テスト用ボタン
//  [戻る]
//  FpidlExpandが新しいフォルダの項目識別子となる
//  最後はデスクトップになる
//  必要であれば，そこから上の階層には移動できないように，特定のフォルダを指定
//  することができる．
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
  ILRemoveLastID(FpidlExpand);
  SetFilesListFromPItemIDList(FpidlExpand);
end;



//-------------------- 以下，シェルによるファイルリスト本体 ------------------


//=============================================================================
//  フォーム生成時の処理
//  各種初期化
//  項目識別子にはnilを代入しておくと，後処理がしやすい
//  nilを代入しないと，不定値となっている
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  i        : Integer;
  FileInfo : TSHFileInfo;
begin
  FpidlDesktop := nil;
  FpidlExpand  := nil;

  //ソートで使用する配列値に代入
  //ソート対象カラムの初期値は0(名前のカラム)
  g_SortColumnIndex := 0;
  for i := 0 to Length(g_SortColum) - 1 do g_SortColum[i] := 1;

  ListView1.ViewStyle               := vsReport;
  ListView1.IconOptions.Arrangement := iaTop;
  ListView1.IconOptions.AutoArrange := True;
  ListView1.IconOptions.WrapText    := True;
  ListView1.DoubleBuffered          := True;

  //[デスクトップ]のシェルフォルダオブジェクトを取得
  SHGetDesktopFolder(FshFolderDesktop);
  //デスクトップの項目識別子を取得
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, FpidlDesktop);

  //イメージリストの取得と設定
  FImageHandle := SHGetFileInfo(Pointer(FpidlDesktop),
                               0,
                               FileInfo,
                               SizeOf(FileInfo),
                               SHGFI_PIDL or
                               SHGFI_SYSICONINDEX or
                               SHGFI_SMALLICON);
  ListView_SetImageList(ListView1.Handle, FImageHandle, LVSIL_SMALL);
end;

//=============================================================================
//  フォーム破棄時の処理
//  後処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FpidlDesktop <> nil then CoTaskMemFree(FpidlDesktop);
  if FpidlExpand  <> nil then CoTaskMemFree(FpidlExpand);
  FshFolderDesktop := nil;
  FshFolderExpand  := nil;
end;

//=============================================================================
//  引数のフルパス相当の項目識別子のフォルダ以下のファイルリストを作成
//
//  BindToObjectは対象がデスクトップの場合は失敗するので注意
//  フォルダオブジェクトと対象の項目識別子(このコードではItemID)が同じフォルダ
//  でも失敗する
//
//  FshFolderDesktop デスクトップのシェル・フォルダオブジェクト
//  FpidlDesktop     デスクトップのフルパス相当項目識別子(完全PIDL)
//  FshFolderExpand  展開フォルダのシェル・フォルダオブジェクト
//  FpidlExpand      展開フォルダのフルパス相当項目識別子(完全PIDL)
//  ListViewの各ItemのDataプロパティに，ファイルの相対項目識別子を代入
//=============================================================================
function TForm1.SetFilesListFromPItemIDList(ItemID: PItemIDList): Boolean;
var
  Flags       : Cardinal;
  pidlChild   : PItemIDList;
  pEnumIdList : IEnumIDList;
  Fetched     : Cardinal;
begin
  Result := False;
  pidlChild := nil;

  //対象となるフォルダの項目識別子とデスクトップの項目識別子を比較
  //同じなら対象フォルダは[デスクトップ]フォルダ
  if FshFolderDesktop.CompareIDs(0, ItemID, FpidlDesktop) = 0 then begin
    FshFolderExpand := FshFolderDesktop;
    FpidlExpand     := ILClone(FpidlDesktop);
  end else begin
    //対象の項目識別子を[デスクトップ]のシェルフォルダオブジェクトにバインド
    //対象のシェルフォルダオブジェクトが求まる
    FshFolderDesktop.BindToObject(ItemID, nil, IShellFolder, Pointer(FshFolderExpand));
    FpidlExpand := ILClone(ItemID);
  end;
  //ソートで使用するフォルダオブジェクトに代入しておく
  g_shFolderExpand := FshFolderExpand;

  //このFlagsで検索フォルダの属性を指定できる
  //pEnumIDListに情報が格納される
  Flags := SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS;

  Screen.Cursor := crHourGlass;
  if (FshFolderExpand.EnumObjects(Handle, Flags, pEnumIDList)) <> S_OK then begin
    Screen.Cursor := crDefault;
    exit;
  end;

  //ListViewのItemにファイル情報を追加していく
  LockWindowUpdate(ListView1.Handle);
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  ResetListViewColumn(FshFolderExpand);

  //取得したpEnumIDListから1つづつファイル情報を取り出す
  //ここで取得したpidlChildは解放しないこと
  while (pEnumIDList.Next(1, pidlChild, Fetched) = S_OK) do begin
    SetListViewItemSubItem(FshFolderExpand, pidlChild);
  end;
  if ListView1.Items.count > 1 then ListView1.CustomSort(@SortListViewData, 0);
  ListView1.Items.EndUpdate;
  LockWindowUpdate(0);
  Screen.Cursor := crDefault;

  Edit1.Text := GetFullPathFromABSPItemID(FpidlExpand);
  Result := True;
end;

//=============================================================================
//  表示するカラムの作成と設定
//  シェルのファイルリストは，表示フォルダによって表示項目(カラム)が異なるため，
//  表示フォルダが変わる度に，一度カラムを全て削除して，新規作成する
//
//  PKEY_Size(TPropertyKey型-PropKey.pas)等でもカラムの形式の判定ができる
//=============================================================================
procedure TForm1.ResetListViewColumn(pShellFolder: IShellFolder);
var
  pShellFolder2 : IShellFolder2;
  ColumnID      : SHCOLUMNID;
  StrRet        : TStrRet;
  i             : Integer;
  Column        : TListColumn;
  details       : SHELLDETAILS;
begin
  for i := ListView1.Columns.Count - 1 downto 0 do begin
    ListView1.Columns.Delete(i);
  end;

  if (pShellFolder.QueryInterface(IID_IShellFolder2, pShellFolder2)) <> S_OK then
    exit;

  for i := 0 to 3 do begin
    if (pShellFolder2.GetDetailsOf(nil, i, details)) <> S_OK then break;

    //特定のカラムを非表示にするのであれば，先にカラムの種類を調べてからAddする
    Column := ListView1.Columns.Add;

    StrRet := details.str;
    //カラムの情報をColumnIDに取得
    pShellFolder2.MapColumnToSCID(i, ColumnID);
    if ColumnID.pid = PID_STG_NAME then begin
      Column.Width := 200;
    end else
    if ColumnID.pid = PID_STG_SIZE then begin
      Column.Width := 100;
    end else
    if ColumnID.pid = PID_STG_STORAGETYPE then begin
      Column.Width := 120;
    end else
    if ColumnID.pid = PID_STG_WRITETIME then begin
      Column.Width := 120;
    end else begin
      Column.Width := -1;
    end;

    if details.fmt = LVCFMT_RIGHT then begin
      Column.Alignment := taRightJustify;
    end;
    Column.Caption := StrRet.pOleStr;
  end;
end;

//=============================================================================
//  ListViewにItemを追加して，各カラムに表示する値をSubItemに追加していく
//  各ファイルの項目識別子をItemのDateプロパティに代入しておく
//  このメソッドではアイコンはセットしない
//  ここでセットすると非常に時間がかかる(アイコンの取得操作に時間がかかる)
//
//  ここでは最初にItemを追加しているが，最初にファイルの種類や拡張子，日付等を
//  調査して，必要がなければ追加しないようにする
//
//  このコードでItemを追加していく方式は，展開に時間がかかる．特に[ゴミ箱]は時
//  間がかかる．仮想リストビュー等を使用する等の工夫が必要
//  各Itemのデータの型はTPropVariantで取得しているが，TVarDataでも取得可能
//=============================================================================
function TForm1.SetListViewItemSubItem(pShellFolder: IShellFolder;
  pidlChild: PItemIDList): Boolean;

  //---------------------------------------------------------------------------
  //  UTC(世界協定時刻)とローカルとの時刻差を求める関数
  //
  //  GetTimeZoneInformationでシステムから現在のタイムゾーンパラメータを取得
  //  Bias値は世界協定時刻(UTC)時間とローカル時間との分差，つまり分なので，これ
  //  をTDateTime型に変換して返す．日本国内の場合は常に9:00:00
  //---------------------------------------------------------------------------
  function UTCTimeDateTimeOffset: TDateTime;
  var
      TZ   : TTimeZoneInformation;
      Hour : Integer;
      Min  : Integer;
  begin
      GetTimeZoneInformation(TZ);
      Hour   := ABS(TZ.Bias) div 60;
      Min    := ABS(TZ.Bias) mod 60;
      Result := EncodeTime(Hour,Min,0,0);
  end;
  //---------------------------------------------------------------------------

var
  pShellFolder2 : IShellFolder2;
  i             : Integer;
  details       : SHELLDETAILS;
  ColumnID      : SHCOLUMNID;
  varResult     : TPropVariant;
  AItem         : TListItem;
  StrText       : string;
  StrFormat     : String;
  ASystemTime   : SYSTEMTIME;
  ADateTime     : TDateTime;
begin
  Result := False;
  //IShellFolder2インターフェイスのフォルダオブジェクトを取得
  if (pShellFolder.QueryInterface(IID_IShellFolder2, pShellFolder2)) <> S_OK then
    exit;

  AItem := nil;
  //このテストプログラムでは，カラムは最初の4つのみ取得して表示
  for i := 0 to 3 do begin
    //初期化
    VariantInit(OleVariant(varResult));
    details.str.pOleStr := nil;

    //カラム構造体を取得(日付型の処理用)
    pShellFolder2.MapColumnToSCID(i, ColumnID);
    VariantInit(OleVariant(varResult));

    //カラム構造体から値をvarResultに取得
    //情報がなければ終了
    if (pShellFolder2.GetDetailsEx(pidlChild, ColumnID, @varResult) <> S_OK) then
      break;

    //SHELLDETAILS構造体にカラムの情報を取得
    if (pShellFolder2.GetDetailsOf(pidlChild, i, details)) <> S_OK then
      break;

    StrText := details.str.pOleStr;
    if i = 0 then begin
      AItem := ListView1.Items.Add;
      AItem.Caption := StrText;
      AItem.ImageIndex := -1;
    end else begin
      //ロケールの違いによって変換できない場合があるのでシステム時間から変換
      //もし更新日時以外の日付も表示するのであれば，例えば
      //if TPropVariant(varResult).vt = VT_DATE then begin
      //のように，日付型であるかを調査して処理することも可能
      if ColumnID.pid = PID_STG_WRITETIME then begin
        VariantTimeToSystemTime(TPropVariant(varResult).date, ASystemTime);
        ADateTime := SystemTimeToDateTime(ASystemTime) + UTCTimeDateTimeOffset;
        StrFormat := FormatDateTime('yyyy/mm/dd hh:mm', ADateTime);
        AItem.SubItems.Add(StrFormat);
      end else begin
        //更新日時以外は文字列で取得
        //ゴミ箱等はこの処理に時間がかかる(文字数が多いのが原因か?)
        AItem.SubItems.Add(StrText);
      end;
    end;
  end;

  if AItem <> nil then begin
    AItem.Data := pidlChild;
  end;
  Result := True;
end;

//=============================================================================
//  TListViewのOnAdvancedCustomDrawItemイベント
//  ここで各Itemにアイコンを取得してセットする
//  各ファイルの情報(名前等)を取得する際にアイコンも取得すると非常に時間がかか
//  る．そのためここで行っている．仮想リストビューの表示速度には及ばないが，そ
//  こそこの表示速度となる
//=============================================================================
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var
  SHFileInfo : TSHFileInfo;
  pidl       : PItemIDList;
  pidlFull   : PItemIDList;
  Attrib     : Cardinal;
begin
  if FImageHandle = 0 then exit;

  if (Stage = cdPrePaint) and (Item.ImageIndex = -1) then begin
    pidl := ILClone(Item.Data);
    if pidl = nil then exit;

    //アイコンの取得と設定
    //SHGetFileInfoの引数にはフルパス相当の項目識別子(完全PIDL)が必要
    //リンク切れファイルやネットワークの検出には非常に時間がかかる．工夫が必要
    pidlFull := ILCombine(FpidlExpand, pidl);
    SHGetFileInfo(Pointer(pidlFull),
                          0,
                          SHFileInfo,
                          SizeOf(TSHFileInfo),
                          SHGFI_PIDL or SHGFI_SYSICONINDEX);
    Item.ImageIndex := SHFileInfo.iIcon;


    //リンクのオーバレイアイコン
    Attrib := SFGAO_LINK;
    FshFolderExpand.GetAttributesOf(1, pidl, Attrib);
    if (SFGAO_LINK and Attrib) <> 0 then Item.OverlayIndex := 1;

    //共有フォルダのオーバレイアイコン
    Attrib := SFGAO_SHARE;
    FshFolderExpand.GetAttributesOf(1, pidl, Attrib);
    if (SFGAO_SHARE and Attrib) <> 0 then
      Item.OverlayIndex := INDEXTOOVERLAYMASK(3);

    //隠し属性のアイコン
    Attrib := SFGAO_GHOSTED;
    FshFolderExpand.GetAttributesOf(1, pidl, Attrib);
    if (SFGAO_GHOSTED and Attrib) <> 0 then Item.Cut := True;

    if pidl     <> nil then CoTaskMemFree(pidl);
    if pidlFull <> nil then CoTaskMemFree(pidlFull);
  end;
end;

//=============================================================================
//  TListViewのOnDeletionイベント
//  ファイルを削除したらListViewのItemも削除することになるが，そのItemを削除し
//  たら，Dataプロパティのメモリも開放
//=============================================================================
procedure TForm1.ListView1Deletion(Sender: TObject; Item: TListItem);
begin
  if Item.Data <> nil then CoTaskMemFree(Item.Data);
  Item.Data := nil;
end;

//=============================================================================
//  TListViewのOnEditedイベント
//  名前を変更したら，実際のファイルも項目識別子を使用して更新する
//  更新に失敗したら，ListViewのItemのCaptionを元に戻す
//  DlgHandleを0にすると，エラー発生時のダイアログを表示しない
//
//  拡張子を非表示にしている場合には，拡張子関係の処理コードを追加する必要あり
//=============================================================================
procedure TForm1.ListView1Edited(Sender: TObject; Item: TListItem;
  var S: string);
var
  pidlOrigin : PItemIDList;
  pidlDest   : PItemIDList;
  DlgHandle  : HWND;
  hr         : HRESULT;
  StrDest    : String;
begin
  if Item.Data = nil then exit;
  PIDLDest   := nil;

  pidlOrigin := ILClone(Item.Data);
  DlgHandle  := Application.Handle;
  StrDest    := S;
  hr := FshFolderExpand.SetNameOf(DlgHandle,
                                  pidlOrigin,
                                  PChar(StrDest),
                                  SHGDN_NORMAL,
                                  pidlDest);
  if Succeeded(hr) then begin
    Item.Data := ILClone(pidlDest);
  end else begin
    S := Item.Caption;
  end;

  if pidlOrigin <> nil then CoTaskMemFree(pidlOrigin);
  if pidlDest   <> nil then CoTaskMemFree(pidlDest);
end;

//=============================================================================
//  TListViewのOnDblClickイベント
//  選択項目のダブルクリック動作
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  AItem     : TListItem;
  Attrib    : Cardinal;
  pidl      : PItemIDList;
  pidlFull  : PItemIDList;
  ShExeInfo : TShellExecuteInfo;
begin
  if ListView1.Selected = nil then exit;
  AItem := ListView1.Selected;
  if AItem.Data = nil then exit;

  //ファイルの属性を調査
  pidl     := ILClone(AItem.Data);
  pidlFull := ILCombine(FpidlExpand, pidl);
  Attrib   := SFGAO_FOLDER or SFGAO_FILESYSANCESTOR;

  //属性がファイルシステムのフォルダの場合は，このプログラムで表示
  //それ以外は，デフォルトの動作とする
  FshFolderExpand.GetAttributesOf(1, pidl, Attrib);
  if (Attrib and (SFGAO_FOLDER)) <> 0 then begin
    SetFilesListFromPItemIDList(pidlFull);
  end else begin
    //必要があれば，lpParametersやlpDirectory等も設定する
    try
      ShExeInfo.cbSize       := sizeof(TShellExecuteInfo);
      ShExeInfo.fMask        := SEE_MASK_INVOKEIDLIST;
      ShExeInfo.wnd          := Handle;
      ShExeInfo.lpVerb       := '';
      ShExeInfo.lpFile       := nil;
      ShExeInfo.lpParameters := '';
      ShExeInfo.lpDirectory  := '';
      ShExeInfo.nShow        := SW_SHOWNORMAL;
      ShExeInfo.hInstApp     := 0;
      ShExeInfo.lpIDList     := pidlFull;
      ShExeInfo.lpClass      := nil;
      ShExeInfo.hkeyClass    := 0;
      ShExeInfo.dwHotKey     := 0;
      ShExeInfo.hIcon        := 0;

      ShellExecuteEx(@ShExeInfo);
    finally
    end;
  end;

  if pidl     <> nil then CoTaskMemFree(pidl);
  if pidlFull <> nil then CoTaskMemFree(pidlFull);
end;

//=============================================================================
//  TListViewのOnKeDownイベント
//  選択項目での[Enter]キー操作もダブルクリックと同じ動作とする
//  実用的には[F2]等の操作も追加した方がいいだろう
//=============================================================================
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //名前の編集中は実行しない
  if not ListView1.IsEditing then begin
    if Key = VK_RETURN then begin
      if ListView1.Selected <> nil then begin
        ListView1DblClick(nil);
        Key:=0;
      end;
    end;
  end;
end;

//=============================================================================
//  TListViewのOnColumnClickイベント
//  カラムをクリックしたらソート
//=============================================================================
procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  if ListView1.Items.count > 1 then begin
    //カラムをクリックする度にソート順を逆にする(トグル操作)
    g_SortColum[g_SortColumnIndex] := -g_SortColum[g_SortColumnIndex];
    g_SortColumnIndex := Column.Index;

    ListView1.CustomSort(@SortListViewData, 0);
  end;
end;

//=============================================================================
//  TListViewのOnSelectItemイベント
//  Itemを選択したらフルパスを表示
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Item = nil then exit;
  Edit1.Text := GetFullPathFromListItemEx(Item);
end;

//=============================================================================
//  表示スタイルの変更
//
//  iViewe : 表示のスタイルで，以下のいづれかの値(CommCtrl.pas内の定数値)
//  LV_VIEW_DETAILS    詳細
//  LV_VIEW_ICON       アイコン
//  LV_VIEW_LIST       リスト
//  LV_VIEW_TILE       タイル
//  ランタイムテーマを有効しないと効果なし
//=============================================================================
procedure TForm1.ChangeViewStyle(iView: Integer);
var
  FileInfo   : TSHFileInfo;
  OldStyle   : Integer;
  NewStyle   : Integer;
  uFlags     : Cardinal;
  iImageList : Cardinal;
begin
  if FpidlDesktop = nil then exit;

  //詳細表示の時だけカラムヘッダを表示
  OldStyle := GetWindowLong(ListView1.Handle, GWL_STYLE);
  if iView = LV_VIEW_DETAILS then begin
    if (OldStyle and LVS_NOCOLUMNHEADER) > 0 then begin
      NewStyle := OldStyle and not LVS_NOCOLUMNHEADER;
      SetWindowLong(ListView1.Handle, GWL_STYLE, NewStyle);
    end;
  end else begin
    if (OldStyle and LVS_NOCOLUMNHEADER) = 0 then begin
      NewStyle := OldStyle or LVS_NOCOLUMNHEADER;
      SetWindowLong(ListView1.Handle, GWL_STYLE, NewStyle);
    end;
  end;

  if iView = LV_VIEW_DETAILS then begin
    iImageList := LVSIL_SMALL;
    uFlags     := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
  end else
  if (iView = LV_VIEW_ICON) or
     (iView = LV_VIEW_LIST) or
     (iView = LV_VIEW_TILE) then begin
    iImageList := LVSIL_NORMAL;
    uFlags     := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_LARGEICON;
  end else begin
    exit;
  end;

  //イメージリストの取得と設定を実行して，ListViewのStyleを更新
  FImageHandle := SHGetFileInfo(Pointer(FpidlDesktop),
                                0,
                                FileInfo,
                                SizeOf(FileInfo),
                                uFlags);

  ListView_SetImageList(ListView1.Handle, FImageHandle, iImageList);
  SendMessage(ListView1.Handle, LVM_SETVIEW, WPARAM(DWORD(iView)), 0);
end;

//=============================================================================
//  ListVeiwのItemからフルパスを求める関数
//  仮想フォルダ等は空文字出力
//  仮想フォルダを扱わない場合はこれで十分と思われる
//
//  ILCombine(FpidlExpand, Item.Data)はフルパス相当の項目識別子(完全PIDL)の取得
//=============================================================================
function TForm1.GetFullPathFromListItem(Item: TListItem): String;
var
  Buff : array[0..MAX_PATH - 1] of Char;
begin
  Result := '';
  if (FpidlExpand = nil) or (Item.Data = nil) then exit;

  FillChar(Buff, SizeOf(Buff), 0);
  SHGetPathFromIDList(ILCombine(FpidlExpand, Item.Data), Buff);
  Result := Buff;
end;

//=============================================================================
//  ListVeiwのItemからフルパスを求める関数
//  仮想フォルダはGUID文字列となる
//
//  FshFolderExpandは展開フォルダオブジェクト．Item.Dataは相対項目識別子
//=============================================================================
function TForm1.GetFullPathFromListItemEx(Item: TListItem): String;
var
  StrRet : TStrRet;
begin
  Result := '';
  if (FshFolderExpand = nil) or (Item.Data = nil) then exit;

  FillChar(StrRet, SizeOf(StrRet), 0);
  if FshFolderExpand.GetDisplayNameOf(Item.Data,
                                      SHGDN_FORPARSING,
                                      StrRet) = S_OK then begin
    Result := StrRet.pOleStr;
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure GetDisplayFilleProperties(pShellFolder: IShellFolder;
      pidlChild: PItemIDList);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj, ActiveX;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  (ディレクトリ名を除いた)ファイル名を相対項目識別子に変換する関数
//
//  ShFolderにディレクトリ部分に相当するフォルダオブジェクト，Pathにはディレク
//  トリ部分を除いたファイル名を指定する
//-----------------------------------------------------------------------------
function GetPItemIDFromFileName(ShFolder: IShellFolder2; Path:String): PItemIDList;
var
  Len    : Cardinal;
  Flags  : Cardinal;
begin
  Flags  := 0;
  Len    := Length(Path);
  ShFolder.ParseDisplayName(Application.Handle,
                            nil,
                            PWideChar(StringToOleStr(Path)),
                            Len,
                            Result,
                            Flags);
end;

//=============================================================================
//  [開く]ダイアログを表示して，プロパティを調べるファイルを選択
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir            : String;
  AFileName       : String;
  shFolderDesktop : IShellFolder2;
  shFolderDir     : IShellFolder2;
  pidlDesktop     : PItemIDList;
  pidlDir         : PItemIDList;
  pidlFileName    : PItemIDList;
begin
  pidlDesktop  := nil;
  pidlDir      := nil;
  pidlFileName := nil;

  //[デスクトップ]のシェルフォルダオブジェクトと項目識別子を取得
  SHGetDesktopFolder(IShellFolder(shFolderDesktop));
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, pidlDesktop);

  if OpenDialog1.Execute then begin
    //ディレクトリとファイル名に分る
    ADir      := ExtractFileDir(OpenDialog1.FileName);
    AFileName := ExtractFileName(OpenDialog1.FileName);

    //ディレクトリの項目識別子(完全PIDL)を求める
    pidlDir := ILCreateFromPath(PChar(ADir));

    //フォルダの項目識別子を[デスクトップ]のシェルフォルダオブジェクトにバインド
    //対象のシェルフォルダオブジェクトshFolderDirが求まる
    shFolderDesktop.BindToObject(pidlDir, nil, IShellFolder, shFolderDir);

    pidlFileName := GetPItemIDFromFileName(shFolderDir, AFileName);

    //プロパティ(各カラム情報)をListViewに表示
    ListView1.Items.Clear;
    ListView1.Items.BeginUpdate;

    GetDisplayFilleProperties(shFolderDir, pidlFileName);

    ListView1.Items.EndUpdate;
  end;

  CoTaskMemFree(pidlDesktop);
  CoTaskMemFree(pidlDir);
  CoTaskMemFree(pidlFileName);
end;

//=============================================================================
//  ListViewにItemを追加して，各カラムに表示する値をSubItemに追加していく
//=============================================================================
procedure TForm1.GetDisplayFilleProperties(pShellFolder: IShellFolder;
  pidlChild: PItemIDList);

  //---------------------------------------------------------------------------
  //  UTC(世界協定時刻)とローカルとの時刻差を求める関数
  //
  //  GetTimeZoneInformationでシステムから現在のタイムゾーンパラメータを取得
  //  Bias値は世界協定時刻(UTC)時間とローカル時間との分差，つまり分なので，これ
  //  をTDateTime型に変換して返す．日本国内の場合は常に9:00:00
  //---------------------------------------------------------------------------
  function UTCTimeDateTimeOffset: TDateTime;
  var
      TZ   : TTimeZoneInformation;
      Hour : Integer;
      Min  : Integer;
  begin
      GetTimeZoneInformation(TZ);
      Hour   := ABS(TZ.Bias) div 60;
      Min    := ABS(TZ.Bias) mod 60;
      Result := EncodeTime(Hour,Min,0,0);
  end;
  //---------------------------------------------------------------------------

var
  pShellFolder2 : IShellFolder2;
  i             : Integer;
  details       : SHELLDETAILS;
  ColumnID      : SHCOLUMNID;
  varResult     : TPropVariant;
  AItem         : TListItem;
  StrText       : String;
  StrFormat     : String;
  ASystemTime   : SYSTEMTIME;
  ADateTime     : TDateTime;
begin
  //IShellFolder2インターフェイルのオブジェクトを取得
  if (pShellFolder.QueryInterface(IID_IShellFolder2, pShellFolder2)) <> S_OK then
    exit;

  i := 0;
  while True do begin
    //初期化
    VariantInit(OleVariant(varResult));
    details.str.pOleStr := nil;

    //カラム構造体を取得(日付型の処理用)
    pShellFolder2.MapColumnToSCID(i, ColumnID);

    //SHELLDETAILS構造体にカラム(タイトル-プロパティ)を取得
    if (pShellFolder2.GetDetailsOf(nil, i, details)) <> S_OK then break;

    StrText := details.str.pOleStr;
    //ListViewの行追加
    AItem := ListView1.Items.Add;
    AItem.Caption := StrText;

    //初期化(これを実行しないと情報がない項目が文字化けする場合あり)
    details.str.pOleStr := nil;
    //実際に項目識別子pidlChildのファイルの，i番目のカラムの値をdetailsに取出す
    pShellFolder2.GetDetailsOf(pidlChild, i, details);
    StrText := details.str.pOleStr;

    //カラム構造体から値をvarResultに取得
    //これは日付型かどうかの判定のみに使用
    pShellFolder2.GetDetailsEx(pidlChild, ColumnID, @varResult);

    //日付はロケールの違いによって変換できない場合があるのでシステム時間から変換
    if varResult.vt = VT_DATE then begin
      VariantTimeToSystemTime(TPropVariant(varResult).date, ASystemTime);
      ADateTime := SystemTimeToDateTime(ASystemTime) + UTCTimeDateTimeOffset;
      StrFormat := FormatDateTime('yyyy/mm/dd hh:mm', ADateTime);
      AItem.SubItems.Add(StrFormat);
    end else begin
      //日付型以外は文字列で取得
      AItem.SubItems.Add(StrText);
    end;
    i := i + 1;
  end;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses ShellAPI;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;
end;

//=============================================================================
//  ゴミ箱を空にする
//  SHEmptyRecycleBinの使用には，usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //確認ダイアログを表示する
  if CheckBox1.Checked then begin
    SHEmptyRecycleBin(0, nil, 0);
  end else begin
    //確認ダイアログを表示しない
    SHEmptyRecycleBin(0, nil, SHERB_NOCONFIRMATION);
  end;
end;

end.