{$B-}unit DirScan;
interfaceuses
RegExpr, SysUtils, Classes;
type
PDirectoryScannerItem = ^TDirectoryScannerItem;
TDirectoryScannerItem = packedrecordname : string;
Size : integer;
LastWriteTime : TDateTime;
end;
TOnDirScanFileProceed = procedure (Sender : TObject; const ABaseFolder : string;
const ASearchRecord : TSearchRec; var ACancel : boolean) ofobject;
TOnDirScanStartFolderScanning = procedure (Sender : TObject; const AFolder : string) ofobject;
TOnDirScanTimeSlice = procedure (Sender : TObject; var ACancel : boolean) ofobject;
TCustomDirectoryScanner = classprivate
fRegExprMask : string;
fRecursive : boolean;
fCount : integer;
fOnFileProceed : TOnDirScanFileProceed;
fOnStartFolderScanning : TOnDirScanStartFolderScanning;
fOnTimeSlice : TOnDirScanTimeSlice;
fMaskRegExpr : TRegExpr;
function BuildFileListInt (const AFolder : string) : boolean;
publicconstructor Create;
destructor Destroy; override;
property Recursive : boolean read fRecursive write fRecursive;
property RegExprMask : stringread fRegExprMask write fRegExprMask;
// regular expresion for file names masks (like '(\.html?|\.xml)' etc)function BuildFileList (AFolder : string) : boolean;
// Build list of all files in folder AFolder.// If ASubFolder = true then recursivly scans subfolders.// Returns false if there was file error and user// decided to terminate process.property Count : integer read fCount;
// matched in last BuildFileList files count// Eventsproperty OnFileProceed : TOnDirScanFileProceed read fOnFileProceed write fOnFileProceed;
// for each file matchedproperty OnStartFolderScanning : TOnDirScanStartFolderScanning read fOnStartFolderScanning
write fOnStartFolderScanning;
// before scanning each directory (starting with root)property OnTimeSlice : TOnDirScanTimeSlice read fOnTimeSlice write fOnTimeSlice;
// for progress bur an so on (called in each internal iteration)end;
TDirectoryScanner = class (TCustomDirectoryScanner)
// simple descendant - after BuildFileList call make list of files// (You can access list thru Item property)private
fList : TList;
function GetItem (AIdx : integer) : PDirectoryScannerItem;
procedure KillItem (AIdx : integer);
procedure FileProceeding (Sender : TObject; const ABaseFolder : string;
const ASearchRecord : TSearchRec; var ACancel : boolean);
procedure TimeSlice (Sender : TObject; var ACancel : boolean);
publicconstructor Create;
destructor Destroy; override;
property Item [AIdx : integer] : PDirectoryScannerItem read GetItem;
end;
implementationuses
Windows, Controls, TFUS;
constructor TCustomDirectoryScanner.Create;
begininherited;
fRecursive := true;
fOnFileProceed := nil;
fOnStartFolderScanning := nil;
fOnTimeSlice := nil;
fMaskRegExpr := nil;
fRegExprMask := '';
end; { of constructor TDirectoryScanner.Create}destructor TCustomDirectoryScanner.Destroy;
begin
fMaskRegExpr.Free;
inherited;
end; { of destructor TCustomDirectoryScanner.Destroy}function TCustomDirectoryScanner.BuildFileList (AFolder : string) : boolean;
beginif (length (AFolder) > 0) and (AFolder [length (AFolder)] = '\')
then AFolder := copy (AFolder, 1, length (AFolder) - 1);
fMaskRegExpr := TRegExpr.Create;
fMaskRegExpr.Expression := RegExprMask;
fCount := 0;
Result := BuildFileListInt (AFolder);
end; { function BuildFileList}function TCustomDirectoryScanner.BuildFileListInt (const AFolder : string) : boolean;
var
sr : SysUtils.TSearchRec;
Canceled : boolean;
begin
Result := true;
if Assigned (OnStartFolderScanning)
then OnStartFolderScanning (Self, AFolder + '\');
if SysUtils.FindFirst (AFolder + '\' + '*.*', faAnyFile, sr) = 0 thentryrepeattryif (sr.Attr and SysUtils.faDirectory) = SysUtils.faDirectory thenbeginif Recursive and (sr.name <> '.') and (sr.name <> '..')
then Result := BuildFileListInt (AFolder + '\' + sr.name);
endelsebeginif fMaskRegExpr.Exec (sr.name) thenbegin
Canceled := false;
if Assigned (OnFileProceed)
then OnFileProceed (Self, AFolder, sr, Canceled);
if Canceled
then Result := false;
inc (fCount);
end;
end;
excepton E:Exception dobegincase MsgBox ('Replacing error',
'Can''t replace file contetn due to error:'#$d#$a#$d#$a
+ E.message + #$d#$a#$d#$a + 'Continue processing ?',
mb_YesNo or mb_IconQuestion) of
mrYes : Result := false;
>else ; // must be No
end;
end;
end;
Canceled := false;
if Assigned (OnTimeSlice)
then OnTimeSlice (Self, Canceled);
if Canceled
then Result := false;
untilnot Result or (SysUtils.FindNext (sr) <> 0);
finally SysUtils.FindClose (sr);
end;
ifnot Result
then EXIT;
end; { function BuildFileListInt}constructor TDirectoryScanner.Create;
begininherited;
fList := TList.Create;
OnFileProceed := FileProceeding;
fOnTimeSlice := TimeSlice;
end; { of constructor TDirectoryScanner.Create}destructor TDirectoryScanner.Destroy;
var
i : integer;
beginfor i := fList.Count - 1 downto 0 do
KillItem (i);
fList.Free;
inherited;
end; { of destructor TDirectoryScanner.Destroy}procedure TDirectoryScanner.KillItem (AIdx : integer);
var
p : PDirectoryScannerItem;
begin
p := PDirectoryScannerItem (fList.Items [AIdx]);
Dispose (p);
fList.Delete (AIdx);
end; { of procedure TDirectoryScanner.KillItem}function TDirectoryScanner.GetItem (AIdx : integer) : PDirectoryScannerItem;
begin
Result := PDirectoryScannerItem (fList.Items [AIdx]);
end; { of function TDirectoryScanner.GetItem}procedure TDirectoryScanner.FileProceeding (Sender : TObject; const ABaseFolder : string;
const ASearchRecord : TSearchRec; var ACancel : boolean);
var
p : PDirectoryScannerItem;
begin
p := New (PDirectoryScannerItem);
p.name := ABaseFolder + '\' + ASearchRecord.name;
fList.Add (p);
end; { of procedure TDirectoryScanner.FileProceeding}procedure TDirectoryScanner.TimeSlice (Sender : TObject; var ACancel : boolean);
beginif Count mod 100 = 0
then Sleep (0);
end; { of procedure TDirectoryScanner.TimeSlice}end.
Для получения списка файлов и подкаталогов в указанной папке можно использовать метод BuildFileList класса TDirectoryScanner.
Вот пример:
varDirScan:TDirectoryScanner;i:integer;DirScan:=TDirectoryScanner.Create;tryDirScan.Recursive:=true;// сканировать подкаталоги рекурсивноDirScan.RegExprMask:='\.txt';// фильтровать файлы с расширением .txtifDirScan.BuildFileList('C:\Путь\К\Папке')thenbeginfori:=0toDirScan.Count-1dobeginwriteln(DirScan.GetItem(i)^.name);// печатать имя файлаend;end;finallyDirScan.Free;end.
В этом коде создается объект TDirectoryScanner, устанавливаются его свойства, а затем вызывается метод BuildFileList для сканирования указанной папки. Свойство Recursive устанавливается в true для включения подкаталогов в сканер. Свойство RegExprMask устанавливается в \*.txt для фильтрации файлов с расширением .txt.
После завершения сканирования можно проходить по списку файлов с помощью свойства Count и метода GetItem. В этом примере мы печатаем имена файлов с помощью оператора writeln.
Обратите внимание, что метод BuildFileList возвращает булевое значение, указывающее, успешно ли была выполнена сканирование. Если при сканировании происходит ошибка (например, из-за недостаточных прав), метод вернет false.
Как получить список файлов и поддиректорий в указанной директории с помощью класса TCustomDirectoryScanner.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.