На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Найти все файлы (директории) по маске
      Чтобы найти файл(файлы), директорию(ии) мы можем воспользоваться структурой TSearchRec:

      ExpandedWrap disabled
        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:

      ExpandedWrap disabled
        Constant      Value      Description
        faReadOnly      $00000001      Read-only files
        faHidden      $00000002      Hidden files
        faSysFile      $00000004      System files
        faVolumeID      $00000008      Volume ID files
        faDirectory      $00000010      Directory files
        faArchive      $00000020      Archive files
        faAnyFile      $0000003F      Any file


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

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

      ExpandedWrap disabled
        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, чтобы перебрать все файлы на диске. Для примера показан способ получения всех файлов и директорий на диске:

      ExpandedWrap disabled
        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;


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

      ExpandedWrap disabled
        procedure TForm1.Button1Click(Sender: TObject);
        { Пример вызова
        Источник delphi.mastak.ru }
        begin
          ListBox1.Items.Clear;
          ScanDir('c:','',ListBox1.Items);
          Label1.Caption := IntToStr(ListBox1.Items.Count);
        end;
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


      Рейтинг@Mail.ru
      [ Script execution time: 0,0272 ]   [ 17 queries used ]   [ Generated: 28.03.24, 09:41 GMT ]