// используется рекурсивная процедура Find
unit FindFile_;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, FileCtr;
type
TForral = class(TForm)
Edltl: TEdit; // что искать
Edit2: TEdit; // где искать
Memol: TMemo; //результат поиска
Buttonl: TButton; // кнопка Поиск
Button2: TButton; // кнопка Папка
Labell: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure ButtonlClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{Public declarations}
end;
var
Forml: TForml;
implementation
!$R *.dfm}
var
FileName: string; // имя или маска искомого файла
cDir: string;
n: integer; // кол-во файлов, удовлетворяющих запросу
// поиск файла в текущем каталоге
procedure Find;
var
SearchRec: TSearchRec; // информация о файле или каталоге
begin
GetDir(O.cDir); // получить имя текущего каталога
if cDir[length(cDir)] <> ' \ ' then cDir := cDir+'S1 ;
if FindFirst(Filename, faArchive,SearchRec) = 0 then
repeat
if (SearchRec.Attr and faAnyFile] = SearchRec.Attr then
begin
Forml.Mesmol.Lines.AddfcDir + SearchReC-Name) ;
n := n + 1;
end;
until FindNext[SearchRec) <> 0;
// обработка подкаталогов текущего каталога
if FindFirst('*', faDirectory, SearchRec) = 0 then
repeat
if (SearchRec.Attr and faDirectory) = SearchRec.Attr then
begin
// каталоги . . и . тоже каталоги,
// но в них входить не надо .'.'.'
if SearchRec.Name[l] <> ' . ' than
begin
ChDir(SearchRec.Name);// войти в каталог
Find; // выполнить поиск в подкаталоге
C h D i r С . . ' ) ; / / выйти из каталога
end;
end;
until FindNext(SearchRec) <> 0;
end;
// возвращает каталог, выбранный пользователем
function GetPath(mes: string):string;
var
Root: string; // корневой каталог
pwRoot : PWideChar;
Dir: string;
begin
Root := ";
GetMem(pwRoot, (Length(Root)+l) * 2);
pwRoot : = StringToWideChar(Root, pwRoot, MAX_PATH*2];
if SelectDirectory(rnes, pwRoot, Dir)
then
if length(Dir) = 2 // пользователь выбрал корневой каталог
then GetPath := Dir+'V
else GetPath := Dir
else
GetPath := ";
end;
// щелчок на кнопке Поиск
procedure TForml.ButtonlClick(Sender: TObject);
begin
Memol.Clear; // очистить лоле Memol
Label4.Caption := '';
FileName := Editl.Text; // что искать
cDir := Edit2.Text; // где искать
n:=0; // кол-во найденных файлов
ChDir (cDir) ; // войти в каталог начала поиска
Find; // начать поиск
if n - 0 then ShowMessage ( 'Файлов, удовлетворяющих критерию поиска нет.') else Label4. Caption := 'Найдено файлов:' + IntToStr (n) ;
end;
// щелчок на кнопке Папка
procedure TForml.Button2Click(Sender: TObject) ,-
var
Path: string;
begin
Path := GetPath('Выберите папку1);
if Path <> ''
then Edit2.Text := Path;
end;
end.