Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. 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
.