Вывести структуру каталогов

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls
 
  ,FileCtrl;
 
type
  TForm1 = class(TForm)
    BtnStart: TButton;
    Memo1: TMemo;
    SaveDialog1: TSaveDialog;
    BtnSave: TButton;
    BtnClearLog: TButton;
    Label1: TLabel;
    procedure BtnStartClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure BtnClearLogClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  //Путь к исходной папке.
  StrDirName : String = '';
 
implementation
 
{$R *.dfm}
 
procedure EnumFolders(aStrDirName : String; aLog : TStrings);
const
  //Атрибуты, которые должны соответствовать файлам, которые мы ищем.
  //Т. е. искать будем только файлы с атрибутом faDirectory - т. е. папки. Остальные - исключаем.
  FileAttr : Integer = faDirectory;
var
  sr: TSearchRec;
begin
 
  if FindFirst(aStrDirName + '\*', FileAttr, sr) <> 0 then begin
    //Если ни один файл не найден.
    Exit;
  end;
 
  try
    repeat
      //Обрабатываем очередную папку.
 
      if (sr.Attr and FileAttr) <> FileAttr then begin
        //Если обнаруженный объект не является папкой - пропускаем итерацию.
        Continue;
      end;
      if (sr.Name = '.') or (sr.Name = '..') then begin
        //Если папка является обозначением
        //текущей или родительской папки - пропускаем итерацию.
        Continue;
      end;
      aLog.Add(aStrDirName + '\' + sr.Name);
      //Продолжаем рекурсию.
      EnumFolders(aStrDirName + '\' + sr.Name, aLog);
    until FindNext(sr) <> 0;
  finally
    //Освобождаем ресурсы, занятые FindFirst.
    FindClose(sr);
  end;
end;
 
 
procedure TForm1.BtnStartClick(Sender: TObject);
begin
 
  if StrDirName = '' then begin
    StrDirName := ExtractFilePath(Application.ExeName);
  end;
 
  //Запускаем диалог выбора папки.
  if not SelectDirectory('Выберите папку', '', StrDirName) then begin
    //Если пользователь в диалоге нажал отмену, то выходим.
    Exit;
  end;
 
  //Проверяем существование папки.
  if not DirectoryExists(StrDirName) then begin
    //Если папка не существует, то извещаем об этом пользователя и выходим.
    ShowMessage('Выбранная вами папка не существует.');
    Exit;
  end;
 
  //Запись в журнал.
  Memo1.Lines.Add('**************************************************');
  Memo1.Lines.Add('Запущен новый поиск.');
  Memo1.Lines.Add('');
  Memo1.Lines.Add(StrDirName);
  //Запуск рекурсии.
  EnumFolders(StrDirName, Memo1.Lines);
  Memo1.Lines.Add('');
  Memo1.Lines.Add('Поиск завершён.');
  Memo1.Lines.Add('');
  Memo1.Lines.Add('**************************************************');
end;
 
procedure TForm1.BtnSaveClick(Sender: TObject);
var
  mdRes : Integer;
begin
  if not SaveDialog1.Execute then begin
    //Если пользователь отказался сохранять файл, то выходим.
    Exit;
  end;
 
  if FileExists(SaveDialog1.FileName) then begin
    //Если такой файл уже существет.
    mdRes := MessageDlg('Указанный файл уже существует. Перезаписать?', mtConfirmation, [mbYes, mbNo], 0);
    if mdRes = mrNo then begin
      Exit;
    end;
  end;
 
  //Записываем содержимое Мемо в файл.
  Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
 
procedure TForm1.BtnClearLogClick(Sender: TObject);
begin
  Memo1.Clear;
end;
 
end.