Итератор для поиска файлов в директории

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Итератор для поиска файлов в директории (first/next/eof)

Очень часто задают вопрос "как перебрать все файлы папки".
Так же часто предлагают использовать FindFirst/FindNext.
Я написал класс TEnumFolder который предоставляет более
удобный интерфейс поиска за счет использованием методов
First/Next/Eof.

Используйте свойства AbsPath и RelPath для получения абсолютного
и относетильного пути текущего файла/папки. Свойство SR типа PSearchRec,
содержит информацию о текущем файле/папке.

Так же можно указать режим перебора (IsFolderFirst = False) при котором,
 можно удалить всю папку(!), т.е. в начале находятся все файлы папки,
 а потом сама папка (т.к. можно удалять только пустую папку).

Зависимости: Classes, SysUtils
Автор:       Kingdom, dnsk@mail.ru, Санкт-Петербург
Copyright:   Kingdom
Дата:        30 сентября 2003 г.
***************************************************** }

unit
 EnmFolder;

interface


uses

  Classes, SysUtils;

type

  PSearchRec = ^TSearchRec;
  TEnumFolder = class

  private

    FBasePath: string
;
    FList: TStrings;
    FSR: PSearchRec;
    FIsFolderFirst: Boolean;
    FBasePos: Integer;
    FNextProc: procedure
 of
 object
;
    function
 GetAbsPath: string
;
    function
 GetRelPath: string
;
    procedure
 ClearList;
    function
 GetPathType(Path: string
): Integer;
    procedure
 PushSR(Dir: string
);
    procedure
 PopSR;
    procedure
 Next1;
    procedure
 Next2;
  public

    constructor
 Create(BasePath: string
; IsFolderFirst: Boolean = True);
    destructor
 Destroy; override
;
    procedure
 First;
    procedure
 Next;
    function
 Eof: Boolean;
    property
 AbsPath: string
 read
 GetAbsPath;
    property
 RelPath: string
 read
 GetRelPath;
    property
 SR: PSearchRec read
 FSR;
  end
;

implementation


{ TEnumFolder }

constructor
 TEnumFolder.Create(BasePath: string
; IsFolderFirst: Boolean);
begin

  inherited
 Create;
  FList := TStringList.Create;
  FBasePath := ExcludeTrailingBackslash(BasePath);
  FIsFolderFirst := IsFolderFirst;
  if
 IsFolderFirst then

    FNextProc := Next1
  else

    FNextProc := Next2;
end
;

destructor
 TEnumFolder.Destroy;
begin

  ClearList;
  FList.Free;
  inherited
;
end
;

procedure
 TEnumFolder.ClearList;
begin

  while
 (FList.Count > 0) do

    PopSR;
end
;

function
 TEnumFolder.GetAbsPath: string
;
begin

  Result := FList[0] + SR.Name;
end
;

function
 TEnumFolder.GetRelPath: string
;
begin

  Result := Copy(AbsPath, FBasePos, MaxInt);
end
;

function
 TEnumFolder.GetPathType(Path: string
): Integer;
begin

  New(FSR);
  if
 (FindFirst(Path, faAnyFile, SR^) <> 0) then

    Result := -1 { Not found }
  else

  begin

    if
 (SR.Attr and
 faDirectory <> 0) then

    begin

      FBasePos := Length(Path) + 2;
      Path := ExtractFilePath(Path);
      FList.InsertObject(0, Path, TObject(SR));
      Result := 1; { Folder }
    end

    else

    begin

      Path := ExtractFilePath(Path);
      FBasePos := Length(Path) + 1;
      FList.InsertObject(0, Path, TObject(SR));
      Result := 0; { File }
    end
;
  end
;
end
;

function
 TEnumFolder.Eof: Boolean;
begin

  Result := (FList.Count = 0);
end
;

procedure
 TEnumFolder.First;
begin

  FSR := nil
;
  ClearList;
  case
 GetPathType(FBasePath) of

    { Folder }
    1:
      if
 not
 FIsFolderFirst then

      begin

        PushSR(FBasePath);
        Next;
      end
;
    { File }
    0: ;
  end
;
end
;

procedure
 TEnumFolder.Next;
begin

  FNextProc;
end
;

procedure
 TEnumFolder.Next1;
begin

  { Push folder }
  if
 (SR.Attr and
 faDirectory <> 0) then

    PushSR(FList[0] + FSR.Name);

  while
 (FList.Count > 0) and
 (FindNext(SR^) <> 0) do

    PopSR;
end
;

procedure
 TEnumFolder.Next2;
begin

  while
 (FList.Count > 0) do

    if
 (FindNext(SR^) <> 0) then

    begin

      PopSR;
      Break;
    end

    else
 if
 (SR.Attr and
 faDirectory <> 0) then

      PushSR(FList[0] + FSR.Name)
    else

      Break;
end
;

procedure
 TEnumFolder.PushSR(Dir: string
);
begin

  New(FSR);
  FindFirst(Dir + '*.*', faAnyFile, FSR^);
  FindNext(FSR^); { Skip "." and ".." }
  FList.InsertObject(0, Dir + '', TObject(FSR));
end
;

procedure
 TEnumFolder.PopSR;
begin

  FList.Delete(0);
  FindClose(SR^);
  Dispose(SR);
  if
 FList.Count > 0 then

    FSR := PSearchRec(FList.Objects[0])
  else

    FSR := nil
;
end
;

end
.

Пример использования:

procedure
 TForm1.Button1Click(Sender: TObject);
var

  fe: TEnumFolder;
begin

  { Показываем содержимое папки }
  Memo1.Lines.BeginUpdate;
  Memo1.Clear;
  fe := TEnumFolder.Create('c:	emp', True);
  fe.First;
  while
 not
 fe.Eof do

  begin

    Memo1.Lines.Add(fe.AbsPath);
    fe.Next;
  end
;
  fe.Free;
  Memo1.Lines.EndUpdate;
end
;

procedure
 TForm1.Button2Click(Sender: TObject);
var

  fe: TEnumFolder;
begin

  { Удаляем папку }
  fe := TEnumFolder.Create('c:	emp', False);
  fe.First;
  while
 not
 fe.Eof do

  begin

    if
 (fe.SR.Attr and
 faDirectory) = 0 then

      DeleteFile(fe.AbsPath)
    else

      RemoveDir(fe.AbsPath);
    fe.Next;
  end
;
  fe.Free;
end
;

Другое по теме:

• Удаление каталога со всем содержимым
• Копирование файлов вместе с каталогами
• Определение размера каталога