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

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

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

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com