Mega Code Archive
Search for files recursively
<![CDATA[
Title: search for files recursively?
procedure GetAllFiles(mask: string);
var
search: TSearchRec;
directory: string;
begin
directory := ExtractFilePath(mask);
// find all files
if FindFirst(mask, $23, search) = 0 then
begin
repeat
// add the files to the listbox
Form1.ListBox1.Items.Add(directory + search.Name);
Inc(Count);
until FindNext(search) 0;
end;
// Subdirectories/ Unterverzeichnisse
if FindFirst(directory + '*.*', faDirectory, search) = 0 then
begin
repeat
if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] '.') then
GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask));
until FindNext(search) 0;
FindClose(search);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
directory: string;
mask: string;
begin
Count := 0;
Listbox1.Items.Clear;
directory := 'C:\temp\';
mask := '*.*';
Screen.Cursor := crHourGlass;
try
GetAllFiles(directory + mask);
finally
Screen.Cursor := crDefault;
end;
ShowMessage(IntToStr(Count) + ' Files found');
end;
{**************************************}
{ Code from P. Below: }
// recursively scanning all drives
{ excerpt from form declaration, form has a listbox1 for the
results, a label1 for progress, a button2 to start the scan,
an edit1 to get the search mask from, a button3 to stop
the scan. }
private
{ Private declarations }
FScanAborted: Boolean;
public
{ Public declarations }
function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
implementation
function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
function ScanDirectory(var path: string): Boolean;
var
SRec: TSearchRec;
pathlen: Integer;
res: Integer;
begin
label1.Caption := path;
pathlen := Length(path);
{ first pass, files }
res := FindFirst(path + filemask, faAnyfile, SRec);
if res = 0 then
try
while res = 0 do
begin
hitlist.Add(path + SRec.Name);
res := FindNext(SRec);
end;
finally
FindClose(SRec)
end;
Application.ProcessMessages;
Result := not (FScanAborted or Application.Terminated);
if not Result then Exit;
{second pass, directories}
res := FindFirst(path + '*.*', faDirectory, SRec);
if res = 0 then
try
while (res = 0) and Result do
begin
if ((Srec.Attr and faDirectory) = faDirectory) and
(Srec.Name '.') and
(Srec.Name '..') then
begin
path := path + SRec.Name + '\';
Result := ScanDirectory(path);
SetLength(path, pathlen);
end;
res := FindNext(SRec);
end;
finally
FindClose(SRec)
end;
end;
begin
FScanAborted := False;
Screen.Cursor := crHourglass;
try
Result := ScanDirectory(root);
finally
Screen.Cursor := crDefault
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
ch: Char;
root: string;
begin
root := 'C:\';
for ch := 'A' to 'Z' do
begin
root[1] := ch;
case GetDriveType(PChar(root)) of
DRIVE_FIXED, DRIVE_REMOTE:
if not ScanDrive(root, edit1.Text, listbox1.Items) then
Break;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin // aborts scan
FScanAborted := True;
end;
]]>