Delphirus - прграммирование на delphi
   Все о delphi Delphirus - прграммирование на delphi
blocks.gif
Навигация
 

Главная
Статьи
Базы данных
Графика
Защита
Интернет
Система
Тексты
Мультимедиа
Файлы
Формы и окна
Другое
Советы
Базы данных
Графика
Интернет
Мультимедиа
Система
Тексты
Файлы
Файлы
Исходники
Компоненты
Инфо
Поиск по сайту
Обратная связь
Самое популярное
Аккаунт
Карта сайта

 
 
 

Советы по delphi \ Файловая система \ Каталоги \ Класс для рекурсивного обхода дерева каталогов

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

{ **** 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.

Название: Класс для рекурсивного обхода дерева каталогов
Дата публикации: 2004-06-13 (2996 Прочтено)

 
 

 

Page generation 0.039 seconds