Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=39461&view=findpost&p=255714 Mon, 01 Dec 2003 18:22:14 +0000 Найти все файлы (директории) по маске https://forum.sources.ru/index.php?showtopic=39461&view=findpost&p=255714
    type TSearchRec = record
                Time: Integer;
                Size: Integer;
                Attr: Integer;
                Name: TFileName;
                ExcludeAttr: Integer;
                Mode: mode_t;
                FindHandle: Pointer;
                PathOnly: array [0..4096] of char;
                Pattern: array [0..256] of char;
    end;
     
    On Windows:
     
    type
    TSearchRec = record
                Time: Integer;
                Size: Integer;
                Attr: Integer;
                Name: TFileName;
                ExcludeAttr: Integer;
                FindHandle: THandle;
                FindData: TWin32FindData;
    end;


Для поиска мы можем воспользоваться процедурами FindFirst/FindNext/FindClose

FindFirst - ищет первый файл, отвечающий критериям поиска
FindNext - ищет следующий(ие) файл(ы)
FindClose - закрывает поиск и освобождает занятые ресурсы при поиске.

FindFirst/FindNext возвращают в случае успеха 0. FindClose необходимо делать, если хотя бы FindFirst вернула успешный код завершения т.е. 0
Найденный(ые) файл(ы) возвращаются в вышеупомянутой структуре TSearchRec. т.е., например, TSearchRec.Name будет содержать имя найденного файла.

Синтаксис:
function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;
Path - путь поиска
F - переменная с типом TSearchRec

В FindFirst мы можем указать маску файлов. Например искать все файлы MS Word - '*.doc'. Для поиска файлов по аттрибутам мы можем воспользоваться перемменой Attr:

    Constant      Value      Description
    faReadOnly      {text}000001      Read-only files
    faHidden      {text}000002      Hidden files
    faSysFile      {text}000004      System files
    faVolumeID      {text}000008      Volume ID files
    faDirectory      {text}000010      Directory files
    faArchive      {text}000020      Archive files
    faAnyFile      {text}00003F      Any file


Все аттрибуты могут легко комбинировать плюсом и взаимоисключаться минусом.
Например найти найти все системные и скрытые файлы: faHidden+faSysFile.

И в заключение небольшой пример.
Найдём все файлы в директории C:\Temp и добавим их в TMemo

    Procedure FindAll(Path:String; Memo:TMemo);
    Var SearchRec:TSearcRec;
    Begin
     IF FindFirst(Path,faAnyFile-faDirectory,SearchRec)=0 then
      try
       Memo.Lines.Add(SearcRec.Name);
       While FindNext(SearchRec)=0 Do Memo.Lines.Add(SearchRec.Name);
      finally
       FindClose(SearchRec);
      end;
    End;
     
    Procedure TForm1.Button1Click(Sender:TObject);
    Begin
     Memo1.Lines.Clear;
     FindAll('C:\Utils\*.*',Memo1);
    End;


Заметьте, что в аттрибутах я использовал минус, хотя мне надо было найти все файлы. Дело в том, что по спецификации файловой системы Dos и Windows в каждом каталоге кроме корневого есть элементы, которые называются "." и ".." Первый из них показывает корневую директорию, второй - наддиректорию. Они имеют аттрибут faDirectory. Поэтому, чтобы в нашем примере они не попали в TMemo, мы их взаимоисключаем.
Удачи.

Указанный пример будет работать только в пределах одной директории. Но очень часто нам надо перебрать много директорий и/или файлов, по всему жёсктому диску например. Для этого нам надо использовать рекурсию. Рекурсия (рекурсивный вызов) - это вызов процедуры/функции из неё самой. При программировании рекурсии, надо быть осторожным т.к. случайное недопонимание элементов рекурсивного алгоритма может привести к бесконечной рекурсии т.е. постоянному зацикливанию. Это приведёт к тому, что в программе очень быстро кончится стёк, выполнение парализуется и закончится фатальной ошибкой. В следующем примере показано как использовать рекурсивный вызов функций FindFirst/FindNext, чтобы перебрать все файлы на диске. Для примера показан способ получения всех файлов и директорий на диске:

    Procedure ScanDir(StartDir: String; Mask:string; List:TStrings);
    { Процедура выводит список директории в список List, начиная с директории, указанной в StartDir. Mask - маска для получения файлов
    Источник delphi.mastak.ru
    © А. Подгорецкий }
    Var SearchRec : TSearchRec;
    Begin
      IF Mask ='' then Mask:= '*.*';
      IF StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
      IF FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
        Begin
         Repeat
            { Чтобы выполнение "не подвисало" }
          Application.ProcessMessages;
          IF (SearchRec.Attr and faDirectory) <> faDirectory then 
             List.Add(StartDir + SearchRec.Name) else
              IF (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
            Begin
              List.Add(StartDir + SearchRec.Name + '\');
                { Рекурсивный вызов }
              ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
            End;
         Until FindNext(SearchRec) <> 0;
         FindClose(SearchRec);
       End; {IF}
    end;


Пример вызова:

    procedure TForm1.Button1Click(Sender: TObject);
    { Пример вызова
    Источник delphi.mastak.ru }
    begin
      ListBox1.Items.Clear;
      ScanDir('c:','',ListBox1.Items);
      Label1.Caption := IntToStr(ListBox1.Items.Count);
    end;
]]> Song Работа с файлами, форматы файлов и данных