Автор: Kingdom
WEB-сайт: http://delphibase.endimus.com

{ **** 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:\temp', 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:\temp', 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;