Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Класс для рекурсивного обхода дерева каталогов

Автор: Святослав
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 World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.