Примеры программ
Поиск
файлов
Словесно алгоритм обработки каталога может быть представлен так:
1. Вывести список всех файлов удовлетворяющих критерию запроса.
2. Если в каталоге есть подкаталоги, то обработать каждый из этих каталогов.
Приведенный алгоритм (его блок-схема представлена на рис. 12.4) является рекурсивным: для того чтобы обработать подкаталог, процедура обработки текущего каталога должна вызвать сама себя.
Рис. 12.4. Рекурсивный
алгоритм поиска файлов
Поле Файл (Edit1) используется для ввода имени искомого файла или маски (для поиска файлов одного типа). Имя каталога, в котором нужно выполнить поиск, можно ввести непосредственно в поле Папка или выбрать из стандартного диалогового окна Обзор папок, которое появляется в результате щелчка на кнопке Папка. Окно Обзор папок (рис. 12.6) выводит на экран стандартная функция Seiectoirectory. Следует обратить внимание, что имя каталога, который используется в диалоговом окне Обзор папок в качестве корневого, должно передаваться функции SeiectDirectory как Строка WhideChar. Для Преобразования обычной строки в строку WideChar использована функция StringToWhideChar.
Рис. 12.5. Окно
программы Поиск файлов
Рис. 12.6. Диалоговое
окно Обзор папок появляется в результате щелчка на кнопке Папка
Листинг 12.3.
Программа поиск файлов
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtr; type
TForm1 = class(TForm)
Editl: TEdit; // что искать
Edit2: TEdit; // где искать
Memo1: TMemo; // результат поиска
Button1: TButton; // кнопка Поиск
Button2: TButton; // кнопка Папка
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject); private
{ Private declarations }
public
{ Public declarations } end; var
Form1: TForm1;
implementation
{$R *.dfm}
var
FileName: string; // имя или маска искомого файла
cDir: string;
n: integer; // кол-во файлов, удовлетворяющих запросу
// поиск файла в текущем каталоге
procedure Find;
var
SearchRec: TSearchRec; // информация о файле или каталоге
begin
GetDir(0,cDir); // получить имя текущего каталога if cDir [length (cDir) ] <> 'V then cDir := cDir+'\';
if FindFirst(FileName, faArchive,SearchRec) = 0 then repeat
if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then begin
Form1.Memo1.Lines.Add(cDir + 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[1] <> '.' then begin
ChDir(SearchRec.Name);// войти в каталог Find; // выполнить поиск в подкаталоге ChDir('..');// выйти из каталога 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)+1) * 2); pwRoot := StringToWideChar(Root, pwRoot, MAX_PATH*2); if SelectDirectory(mes, pwRoot, Dir) then
if length(Dir) =2 // пользователь выбрал корневой каталог then GetPath := Dir+'\' else GetPath := Dir else
GetPath := ''; end;
щелчок на кнопке Поиск
procedure TForml.ButtonlClick(Sender: TObject); begin
Memo1.Clear; // очистить поле Memol
Label4.Caption := '';
FileName := Edit1.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('Выберите папку');
if Path <> ''
then Edit2.Text := Path; end;
end.