ListBoxとButtonを置いて下さい。あと、ListBoxのフォントをMSゴシック12
p等の非プロポーショナルなフォントにしないと、綺麗に揃わないので注意。
---------------------------------
unit Unit1;

interface

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

type
  { ファイルの情報 }
  PNode = ^TNode;
  TNode = record
    Parent: PNode; //親
    Size: integer; //ファイルサイズ
    Time: integer; //ファイルタイム（DOS の日付時刻）
    Attr: integer; //属性
    Level: Word;   //ツリーの深さレベル
    Name: string;  //ファイル（ディレクトリ）名
    Last: boolean; //同一深さレベルで最後かどうか
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FList: TList;
    FStringList: TStringList;
    procedure GetFileList(ADirName: string; AParent: PNode; ALevel: integer);
    procedure MakeTree;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ ディレクトリでソート、ディレクトリどうし・ファイルどうしなら名前でソート }
function DirectorySort(Item1, Item2: Pointer):integer;
var
  Node1, Node2: PNode;
begin
  Node1 := PNode(Item1);
  Node2 := PNode(Item2);
  if (Node1^.Attr and faDirectory >0) and (Node2^.Attr and faDirectory >0) then
    Result := AnsiCompareText(Node1^.Name, Node2^.Name)  //両方ディレクトリ
  else if Node1^.Attr and faDirectory > 0 then
    Result := -1
  else if Node2^.Attr and faDirectory > 0 then
    Result := 1
  else
    Result := AnsiCompareText(Node1^.Name, Node2^.Name); //両方ファイル
end;

{ ファイル名を再帰で取得 }
procedure TForm1.GetFileList(ADirName:string; AParent:PNode; ALevel:integer);
var
  i, Found: integer;
  SearchRec: TSearchRec;
  Node: PNode;
  FileList: TList;
begin
  FileList := TList.Create;
  try
    Found := FindFirst(ADirName + '\*.*', faAnyFile, SearchRec);
    try
      while Found = 0 do
      begin
        if (SearchRec.Name[1] <> '.') then //『.』と『..』は除く
        begin
          New(Node);
          FillChar(Node^, SizeOf(Node^), #0); //初期化
          Node^.Parent := AParent;
          Node^.Size := SearchRec.Size;
          Node^.Time := SearchRec.Time;
          Node^.Attr := SearchRec.Attr;
          Node^.Level := ALevel;          //ツリーの深さレベル
          Node^.Name := SearchRec.Name;
          FileList.Add(Node);
        end;
        Found := FindNext(SearchRec);
      end;
    finally
      FindClose(SearchRec);
    end;
    if FileList.Count > 0 then
    begin
      FileList.Sort(DirectorySort); //ソート
      PNode(FileList.Last)^.Last := True; //該当ディレクトリの最下部
      for i := 0 to FileList.Count - 1 do
      begin
        Node := PNode(FileList[i]);
        FList.Add(Node); //FListに移す
        if Node^.Attr and faDirectory > 0 then  //ディレクトリの場合、再帰
          GetFileList(ADirName + '\' + Node^.Name, Node, Node^.Level + 1);
      end;
    end;
  finally
    FileList.Free; //各NodeはFListに移したので、FileListではDisposeしない
  end;
end;

{ ツリー文字列作成 }
procedure TForm1.MakeTree;
type
  TTreeChar = array[0..2] of string[4]; //ツリー構成文字
const
  TreeChar: TTreeChar = ('└─', '├─', '│  '); //ツリー構成文字
var
  i: integer;
  Node: PNode;
  Line, FileName:string;
  procedure SetTreeChar(ANode: PNode; AType: integer);
  var
    p: integer;
  begin
    p := ANode^.Level * 4 + 1;
    Delete(Line, p, 4);
    Insert(TreeChar[AType], Line, p); //ツリー構成文字に置き換え
  end;
  procedure DrawTree;
  var
    Own: PNode;
  begin
    Own := Node;
    if Own^.Last then //ファイル名の１つ左
      SetTreeChar(Own, 0)  //'└─'
    else
      SetTreeChar(Own, 1); //'├─'
    Own := Own^.Parent;
    while Own <> nil do
    begin
      if not Own^.Last then SetTreeChar(Own, 2); //'│  '
      Own := Own^.Parent;
    end;
  end;
begin
  for i := 0 to FList.Count - 1 do
  begin
    Node := PNode(FList[i]);
    if Node^.Attr and faDirectory > 0 then //ディレクトリ
      FileName := '<' + Node^.Name + '>'
    else
      FileName := Node^.Name + ' ' + FormatFloat('#,##0', Node^.Size) + ' '
                  + DateTimeToStr(FileDateToDateTime(Node^.Time));
    Line := StringOfChar(' ', (Node^.Level + 1) * 4) + FileName;
    DrawTree; //スペース部分をツリー構成文字列にする
    FStringList.Add(Line);
  end;
  for i := 0 to FList.Count - 1 do Dispose(PNode(FList[i])); //メモリ解放
  FList.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FStringList := TStringList.Create;
  FList := TList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FStringList.Free;
  FList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetFileList('c:\', nil, 0); //cドライブ全て（時間がかかるので注意）
  MakeTree;
  ListBox1.Items.Text := FStringList.Text;
end;

end.

Original document by ぶんぶん鈴木    氏 ID:(EZA00106)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。