Mega Code Archive
Folders recursive scanning class
<![CDATA[
Title: Folders recursive scanning class
Question: How to obtain file list in specified folder and all subfolders
Answer:
This is easy to use class for recursive directory scanning.
You can find some examples of using in my article about MP3/ID3
Unit contains basic class TCustomDirectoryScanner (very powefull and extesible) and TDirectoryScanner for more simple using. You can study TDirectoryScanner as example of TCustomDirectoryScanner using.
Note: for files names checking this class uses TRegExpr component (available for free, see component URL). Certainly, You can replace it with Your favorable function for template checking.
{$B-}
unit DirScan;
interface
uses
RegExpr,
SysUtils,
Classes;
type
PDirectoryScannerItem = ^TDirectoryScannerItem;
TDirectoryScannerItem = packed record
Name : string;
Size : integer;
LastWriteTime : TDateTime;
end;
TOnDirScanFileProceed = procedure (Sender : TObject; const ABaseFolder : string;
const ASearchRecord : TSearchRec; var ACancel : boolean) of object;
TOnDirScanStartFolderScanning = procedure (Sender : TObject; const AFolder : string) of object;
TOnDirScanTimeSlice = procedure (Sender : TObject; var ACancel : boolean) of object;
TCustomDirectoryScanner = class
private
fRegExprMask : string;
fRecursive : boolean;
fCount : integer;
fOnFileProceed : TOnDirScanFileProceed;
fOnStartFolderScanning : TOnDirScanStartFolderScanning;
fOnTimeSlice : TOnDirScanTimeSlice;
fMaskRegExpr : TRegExpr;
function BuildFileListInt (const AFolder : string) : boolean;
public
constructor Create;
destructor Destroy; override;
property Recursive : boolean read fRecursive write fRecursive;
property RegExprMask : string read 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
// Events
property OnFileProceed : TOnDirScanFileProceed read fOnFileProceed write fOnFileProceed;
// for each file matched
property 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);
public
constructor Create;
destructor Destroy; override;
property Item [AIdx : integer] : PDirectoryScannerItem read GetItem;
end;
implementation
uses
Windows,
Controls; // mrYes
constructor TCustomDirectoryScanner.Create;
begin
inherited;
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;
begin
if (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 then try
REPEAT
try
if (sr.Attr and SysUtils.faDirectory) = SysUtils.faDirectory then begin
if Recursive and (sr.Name '.') and (sr.Name '..')
then Result := BuildFileListInt (AFolder + '\' + sr.Name);
end
else begin
if fMaskRegExpr.Exec (sr.Name) then begin
Canceled := false;
if Assigned (OnFileProceed)
then OnFileProceed (Self, AFolder, sr, Canceled);
if Canceled
then Result := false;
inc (fCount);
end;
end;
except on E:Exception do begin
case MessageBox (0,
PChar ('Can''t replace file contetn due to error:'#$d#$a#$d#$a
+ E.Message + #$d#$a#$d#$a + 'Continue processing ?'),
'Replacing error',
mb_YesNo or mb_IconQuestion) of
IDYES : Result := false;
else ; // must be No
end;
end;
end;
Canceled := false;
if Assigned (OnTimeSlice)
then OnTimeSlice (Self, Canceled);
if Canceled
then Result := false;
UNTIL not Result or (SysUtils.FindNext (sr) 0);
finally SysUtils.FindClose (sr);
end;
if not Result
then EXIT;
end; { function BuildFileListInt
--------------------------------------------------------------}
constructor TDirectoryScanner.Create;
begin
inherited;
fList := TList.Create;
OnFileProceed := FileProceeding;
fOnTimeSlice := TimeSlice;
end; { of constructor TDirectoryScanner.Create
--------------------------------------------------------------}
destructor TDirectoryScanner.Destroy;
var
i : integer;
begin
for 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);
begin
if Count mod 100 = 0
then Sleep (0);
end; { of procedure TDirectoryScanner.TimeSlice
--------------------------------------------------------------}
end.
]]>