private
{ Private declarations }
FScanAborted: Boolean;
function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
var
Form1: TForm1;
count : integer;
//
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 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;
Beispiel 1:
procedure TForm1.Button1Click(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.Button2Click(Sender: TObject);
begin
FScanAborted := True;
end;
Beispiel 2:
procedure TForm1.Button3Click(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;
Keine Kommentare:
Kommentar veröffentlichen