Встречаются двое юзеров. Один говорит:
- Я тут свежий антивирус достал, не хочешь себе установить?
- Нет, мне это не нужно.
- Почему?
- Да мой комп так глючит, что на нем ни один вирус не запустится.
procedure GetAllFiles(mask: string);
var
search: TSearchRec;
directory: string;
begin
directory := ExtractFilePath(mask);
// find all files if FindFirst(mask, $23, search) = 0 thenbeginrepeat// 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 thenbeginrepeatif ((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;
implementationfunction 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 thentrywhile res = 0 dobegin
hitlist.Add(path + SRec.Name);
res := FindNext(SRec);
end;
finally
FindClose(SRec)
end;
Application.ProcessMessages;
Result := not (FScanAborted or Application.Terminated);
ifnot Result then Exit;
{second pass, directories}
res := FindFirst(path + '*.*', faDirectory, SRec);
if res = 0 thentrywhile (res = 0) and Result dobeginif ((Srec.Attr and faDirectory) = faDirectory) and
(Srec.Name <> '.') and
(Srec.Name <> '..') thenbegin
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' dobegin
root[1] := ch;
case GetDriveType(PChar(root)) of
DRIVE_FIXED, DRIVE_REMOTE:
ifnot ScanDrive(root, edit1.Text, listbox1.Items) then
Break;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin// aborts scan
FScanAborted := True;
end;
Описывается рекурсивный поиск файлов на компьютере, написанный на языке программирования Delphi, который ищет файлы на всех доступных дисках и добавляет их в список.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.