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

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 и FreePascal.

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

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