Недавно добавленные исходники

•  TDictionary Custom Sort  535

•  Fast Watermark Sources  900

•  3D Designer  1 828

•  Sik Screen Capture  1 474

•  Patch Maker  1 482

•  Айболит (remote control)  1 406

•  ListBox Drag & Drop  1 175

•  Доска для игры Реверси  21 827

•  Графические эффекты  1 354

•  Рисование по маске  1 295

•  Перетаскивание изображений  1 096

•  Canvas Drawing  968

•  Рисование Луны  814

•  Поворот изображения  770

•  Рисование стержней  814

•  Paint on Shape  493

•  Генератор кроссвордов  762

•  Головоломка Paletto  667

•  Теорема Монжа об окружностях  855

•  Пазл Numbrix  617

•  Заборы и коммивояжеры  848

•  Игра HIP  557

•  Игра Go (Го)  527

•  Симулятор лифта  548

•  Программа укладки плитки  509

•  Генератор лабиринта  565

•  Проверка числового ввода  524

•  HEX View  600

•  Физический маятник  528

•  Задача коммивояжера  560

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



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



Автор: Kingdom

{ **** 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;




Похожие по теме исходники

Нейросеть для распознавания образов

Механизм станка качалки для нефти

Весы для взвешивания

Кувшины для воды

 

Доска для игры Реверси

Чтение PSD файлов

Шифратор файлов

Поиск файлов

 

FileMan (менеджер файлов)

Поиск открытых файлов




Copyright © 2004-2022 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter   Ссылка на Telegram