Класс для рекурсивного обхода дерева каталогов

Delphi , Файловая система , Директории

Автор: Святослав
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Класс (компонент) для рекурсивного обхода дерева каталогов
(всего диска или заданной папки). На каждый файл и директорию
вызывается соответствующий event.

TTreeWalker.TargetPath - путь для обхода.
TTreeWalker.OnNewDir - event вызывается при обнаружении каждой поддиректории
TTreeWalker.OnNewFile - файла.

Зависимости: Windows, Messages, SysUtils, Classes;
Автор:       Святослав, lisin@asicdesign.ru, ICQ:138752432, Saint Petersburg
Copyright:   (C) NetBreaker666[AWD]<SP666>@Svjatoslav_Lisin - т.е. я сам
Дата:        11 августа 2002 г.
***************************************************** }

unit TreeWalker;
//Просто рекурсивный обход. Я думаю комментарии не требуются.
interface

uses
  Windows, Messages, SysUtils, Classes;
type
  PNewDir = procedure(Sender: TObject; Dir: string) of object;
  PNewFile = procedure(Sender: TObject; F: TSearchRec) of object;

type
  TTreeWalker = class(TComponent)
  private
    { Private declarations }
    TargetPathV: string;
    OnNewFileV: PNewFile;
    OnNewDirV: PNewDir;
    procedure SetTargetPath(const S: string);
    function GetTargetPath: string;
    procedure SetOnFile(const ONF: PNewFile);
    function GetOnFile: PNewFile;
    procedure SetOnDir(const OND: PNewDir);
    function GetOnDir: PNewDir;
    procedure Recurs(S: string; D: Integer);
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure Process;
  published
    { Published declarations }

    property TargetPath: string read GetTargetPath write SetTargetPath;
    property OnNewFile: PNewFile read GetOnFile write SetOnFile;
    property OnNewDir: PNewDir read GetOnDir write SetOnDir;
  end;

procedure Register;

implementation

procedure TTreeWalker.SetTargetPath(const S: string);
begin
  TargetPathV := S;
  if TargetPathV[Length(TargetPathV)] <> '\' then
    TargetPathV := TargetPathV + '\';
end;

function TTreeWalker.GetTargetPath: string;
begin
  Result := TargetPathV;
end;

procedure TTreeWalker.SetOnFile(const ONF: PNewFile);
begin
  OnNewFileV := ONF;
end;

function TTreeWalker.GetOnFile: PNewFile;
begin
  Result := OnNewFileV;
end;

procedure TTreeWalker.SetOnDir(const OND: PNewDIr);
begin
  OnNewDirV := OND;
end;

function TTreeWalker.GetOnDir: PNewDir;
begin
  Result := OnNewDirV;
end;

procedure TTreeWalker.Process;
begin
  Recurs(TargetPathV, 0);
end;

procedure TTreeWalker.Recurs(S: string; D: Integer);
var
  F: TSearchRec;
  R: Integer;
begin
  if D > 512 then
    Exit;
  if @OnNewDirV <> nil then
    OnNewDirV(self, S);

  R := FindFirst(S + '*.*', faAnyFile, F);
  while R = 0 do
  begin
    if @OnNewFileV <> nil then
      OnNewFileV(self, F);
    if (F.Attr and faDirectory <> 0)
      and (F.Name <> '.') and (F.Name <> '..') then
      Recurs(S + F.Name + '\', D + 1);
    R := FindNext(F);
  end;
  FindClose(F);

end;

procedure Register;
begin
  RegisterComponents('NetBreakers', [TTreeWalker]);
end;

end.

Компонент Delphi для рекурсивного обхода деревьев каталогов и файлов, предоставляющий события при обнаружении новых каталогов или файлов.

Вот краткое описание компонента:

• Класс TTreeWalker наследуется от TComponent.
• У него есть три основные свойства: TargetPath, которое указывает корневой каталог для начала обхода; OnNewFile, процедура, которая будет вызвана при обнаружении нового файла; и OnNewDir, процедура, которая будет вызвана при обнаружении нового каталога.
• Компонент предоставляет два процесса: Process запускает обход, а Recurs - рекурсивная функция, выполняющая фактический обход.
• Функция Recurs использует функции FindFirst и FindNext, чтобы перебирать файлы в текущем каталоге. Если она находит файл, который является каталогом (т.е., имеет атрибут faDirectory), она вызывает себя рекурсивно с новым пути каталога. Если она находит файл, который не является каталогом, она вызывает процедуру события OnNewFile.
• Компонент также включает в себя некоторые основные механизмы обработки ошибок: если глубина обхода превышает 512 уровней, она выйдет из рекурсии, чтобы предотвратить переполнение стека.
• В целом, этот компонент предоставляет простой способ обходить деревья каталогов и файлов, позволяя пользователю выполнять custom-процессинг каждого файла или каталога при их обнаружении.

Класс TTreeWalker позволяет рекурсивно обходить дерево каталогов, вызывая события на каждый файл и директорию.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Директории ::