[garik]

Добрый день, товарищи программисты!
Помогите пожалуйста!
В предыдущей теме был задан вопрос поиска файла. Мне нужно найти все файлы с расширениями .doc .xls .txt .rtf и ввести их пути в memo1.
Сложность заключается в том, что файлов множество, найти их нужно все.
Спасибо!!!

[zip000]

Код:

  procedure Find(const Path, SearchMask : String; var Memo : TMemo);
  var
    fs : TSearchRec;
    i : Integer;
  begin
    Application.ProcessMessages;
    i := FindFirst(Path + '\' + SearchMask, faAnyFile, fs);
    while i = 0 do begin
      Memo.Lines.Add(path + '\' + fs.Name);
      i := FindNext(fs);
    end;
    i := FindFirst(Path + '\*', faDirectory or faAnyFile, fs);
    while i = 0 do begin
      if (fs.Name <> '.') and (fs.Name <> '..') and
         ((fs.Attr and faDirectory) <> 0) then
        Find(Path + '\' + fs.Name, SearchMask, Memo);
      i := FindNext(fs);
    end;
    FindClose(fs);
  end;

Path - эт путь где искать, можно указать просто диск (С, D и т.д.), поиск будет осуществляться во всех вложенных папках, SearchMask - маска поиска, чтоб найти все txt файлы пишем тут *.txt, Memo - сюда будут выводится резалты поиска. Просто по очереди ищите файлы каждого разрешения.

[lmikle]

Можно съэкономить время, если:
- искать в 1 проход с рекурсией по каталогам сразу;
- искать по маске *.* и внутри проверять соответствие.

Код:

uses Masks;

procedure TForm1.SearchFiles(APath : String);
const
  SearchMasks : Array [0..3] Of String = ('*.doc','*.xls','*.txt','*.rtf');
var
  iFound : Integer;
  F : TSearchRec;

  function IsMatchMask(AFileName : String) : Boolean;
  var
    I : Integer;
  begin
    Result := False;
    For I := Low(SearchMasks) To High(SearchMasks) Do
      Begin
        Result := MatchesMask(AFileName,SearchMasks[i]);
        If Result Then Break;
      End;
  end;

begin
  APath := IncludeTrailingPathDelimiter(APath);
  iFound := FindFirst(APath + '*.*',faAnyFile,F);
  While iFound = 0 Do
    Begin
      If (F.Attr And faDirectory) <> 0
        Then
          Begin
            If (F.Name <> '.') And (F.Name <> '..')
              Then SearchFiles(APath + F.Name);
          End
        Else
          If IsMatchMask(F.Name)
            Then Memo1.Lines.Add(APath + F.Name);
      iFound := FindNext(F);
    End;
  FindClose(F);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Ишем на диске C:
  Memo1.Lines.Clear;
  SearchFiles('c:');
end;

Если надо автоматом перебрать все диски, то это уже чуть сложнее - надо получить список всех дисков и в цикле пройти по ним.

[zip000]

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

[garik]

Огромное спасибо!!!
Буду пробовать