Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Имена, пути файлов



Вернуться к списку функций
 Итератор для поиска файлов в директории (first/next/eof)

 Прислал: Kingdom (Санкт-Петербург) ( 30 сентября 2003 г. )
©  Kingdom
 Описание:
Очень часто задают вопрос "как перебрать все файлы папки". Так же часто предлагают использовать FindFirst/FindNext. Я написал класс TEnumFolder который предоставляет более удобный интерфейс поиска за счет использованием методов First/Next/Eof.
Используйте свойства AbsPath и RelPath для получения абсолютного и относетильного пути текущего файла/папки. Свойство SR типа PSearchRec, содержит информацию о текущем файле/папке.
Так же можно указать режим перебора (IsFolderFirst = False) при котором, можно удалить всю папку(!), т.е. в начале находятся все файлы папки, а потом сама папка (т.к. можно удалять только пустую папку).

 Зависимости:
Classes, SysUtils

 Ограничения:
Проверено в D5, Win2k

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Итератор для поиска файлов в директории (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;


Вернуться к списку функций

Наверх ▲