Может у кого нибудь есть программа поиска файла по шаблону?бросьте пжл

[andreww]

program vm6;
{$M 4096}
uses
sysutils;

procedure find(cat: string);
var
 inf: TSearchRec;  {возвр инф о след файле удов усл поиска}
begin
 if FindFirst(IncludeTrailingPathDelimiter(cat)+'*', not faDirectory, inf)<>0 then
  writeln(IncludeTrailingPathDelimiter(cat));
 FindClose(inf);

 if FindFirst(IncludeTrailingPathDelimiter(cat)+'*', faDirectory, inf)=0 then
  begin
   if inf.name='.' then FindNext(inf); if inf.name='..' then FindNext(inf);
   if inf.name='.' then FindNext(inf);

   if (inf.attr=16) and (inf.name<>'.') and (inf.name<>'..') then
   find(IncludeTrailingPathDelimiter(cat)+inf.name);
   while FindNext(inf)=0 do
    begin
     if (inf.attr=16) and (inf.name<>'.') and (inf.name<>'..') then
     find(IncludeTrailingPathDelimiter(cat)+inf.name);   { ищет \}
    end;
  end;
 FindClose(inf); {закрывает поиск и освобож опер память}
end;

begin
 if paramstr(1)='/?' then {если считывает /? то выдает инфор}
  begin
   writeln;
   writeln('Программа осуществляет поиск пустых каталогов.');
   writeln;
   writeln('Введите после пробела местоположение каталога, в котором необходимо');
   writeln('осуществить поиск. Если требуется поиск в корневом каталоге, введите /r');
   exit;
  end;
 if paramstr(1)='' then {если ниче не набр}
  begin
   writeln('Не указано место поиска');
   exit;
  end;
 if (paramstr(1)[length(paramstr(1))]<>'\') and (paramstr(1)<>'/r') then  { если путь введен неверно}
  begin
   writeln('Имя каталога задано неверно');
   exit;
  end;
 if not DirectoryExists(paramstr(1)) and (paramstr(1)<>'/r') then {если не найден каталог }
  begin
   writeln('Данного каталога не существует');
   exit;
  end;
 if paramstr(1)='/r' then {если введен ключ}
  begin
   find(copy(paramstr(0),0,3));
   writeln('Работа программы окончена ');
   exit;
  end;
 find(ExtractFilePath(paramstr(1)));{извлечение части полного имени файла}
 writeln('Работа программы окончена ');
 readln;
end.

и не могли бы объяснить как работает в этой программе функция sort

Заранее благодарен

[Dj_smart]

Ну дык замените '*' на нужный вам шаблон и вуаля!
Например '*.rar'

[Serge_Bliznykov]

Ну дык замените '*' на нужный вам шаблон и вуаля!

нет, так не получится. Если Вы внимательно посмотрите на функцию FIND() то увидите, что она вызывает сама себя рекурсивно (для поиска по подкаталогам).
Если сделать предложенную Вами доработку, то она будет заходить только в каталоги, которые соответствуют шаблону (в Вашем случае с *.rar, если каталог будет называться, например, ПАПКА.RAR)

andreww, на мой взгляд, у Вас два альтернативных пути решения - либо искать папки отдельным циклом, а файлы в папках по шаблону (я бы предложил именно такой вариант)

либо задействовать использование регулярных выражений и все найденные имена проверять на шаблон через регулярные выражения.

[Stilet]

А что за проблема пройтись поиском по форуму и поднять простейший пример по рекурсии?

[FaTaL]

Вот пример и всё нормально работает и по маске:

procedure TForm1.FindFile(Dir: string);
var
  SR: TSearchRec;
  FindRes: Integer;
  Kol:integer;
begin
  FindRes := FindFirst(Dir + '*.rar', faAnyFile, SR);
  while FindRes = 0 do
  begin
    if ((SR.Attr and faDirectory) = faDirectory) and
      ((SR.Name = '.') or (SR.Name = '..')) then
    begin
      FindRes := FindNext(SR);
      Continue;
    end;

    // если найден каталог, то
    if ((SR.Attr and faDirectory) = faDirectory) then
    begin
      // входим в процедуру поиска с параметрами текущего каталога +
      // каталог, что мы нашли
      FindFile(Dir + SR.Name + '\\');
      FindRes := FindNext(SR);
      // после осмотра вложенного каталога мы продолжаем поиск
      // в этом каталоге
      Continue; // продолжить цикл
    end;

    ListBox1.Items.Add(SR.Name);
    FindRes := FindNext(SR);
  end;
  FindClose(SR);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
listbox1.Clear;
FindFile(edit1.Text);
end;

[Serge_Bliznykov]

FaTaL, Вы, наверное, моё сообщение выше не читали... ;( Вы сами свой код проверяли?

в папке на которую ссылается edit1.Text создайте подпапку КУКУ, в ней положите файлик TEST.RAR
и проверьте, найдётся он!!