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 г. ***************************************************** } unitTreeWalker; //Просто рекурсивный обход. Я думаю комментарии не требуются. 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
.