::Главная страница ::Delphi/Паскаль :: Статьи

Удалении каталогов.

Для удаления каталога существует процедура RmDir, но эта функция может удалить лишь пустой каталог. Поэтому нужно создать свою процедуру, которая бы удаляла все подкаталоги файлы в заданном каталоге, а затем удаляла и сам каталог. Для удаления подкаталогов нужно использовать эту же функцию.

Чтобы было, что удалять, эта программа также умеет создавать каталоги с произвольными файлами и подкаталогами. Для этого создана рекуррентная процедура CreateRandom. MaxFolderCount ограничивает количество созданных каталогов, а MaxLen ограничивает максимальную длину пути.

Button1 создает систему каталогов с файлами, начиная с введенного в Edit1 каталога. Если имя каталога не полное (без начала пути) - путь восстанавливается. Button2 удаляет каталог с подкаталогами. Каталог берется из Edit1 по такому же принципу.

Скачать необходимые для компиляции файлы проекта можно на program.dax.ru. Доступны проекты для версий Delphi 3-6.

uses FileCtrl;

const
  MaxFolderCount = 500;

var
  FileCount, FolderCount, ErrorCount: integer;
  MaxLen: integer;

// Удаление каталога:
procedure DeleteDir(DirName: string);
var
  sr: TSearchRec;
  FullName: string;
begin
  try
    if FindFirst(DirName + '\*.*', faAnyFile, sr) = 0 then repeat
      if (sr.Name = '.') or (sr.Name = '..') then continue;
      FullName := DirName + '\' + sr.Name;
      { Если это файл - удаляется файл, если каталог -
        вызывается DeleteDir: }
      if sr.Attr and faDirectory = 0 then begin
        DeleteFile(FullName);
        inc(FileCount); // Изменение счетика
      end else DeleteDir(FullName);
    until FindNext(sr) <> 0;
    FindClose(sr);
    RmDir(DirName); // Удаление каталога
    inc(FolderCount); // Изменение счетика
  except inc(ErrorCount) end;
end;

// Создание каталога со случайными файлами и подкаталогами:
procedure CreateRandom(const root: string);
  // Создание случайной строки длиной len:
  function RndStr(len: integer): string;
  var i: integer;
  begin
    SetLength(result, len);
    for i := 1 to len do
      result[i] := chr(ord('a') + random(26));
  end;

var F: File;
begin
  try
    ForceDirectories(root); // Создание каталога
    inc(FolderCount); // Изменение счетика
    while random(5) <> 1 do begin
      // Создание файла:
      AssignFile(F, root + '\' + RndStr(random(5) + 5) + '.' + RndStr(3));
      Rewrite(F);
      CloseFile(F);
      inc(FileCount); // Изменение счетика
    end;
    if length(root) < maxlen then while (FolderCount < MaxFolderCount) and
      (random(10) <> 1) do
      // Создание каталога с подкаталогами:
      CreateRandom(root + '\' + RndStr(random(5) + 5));
  except inc(ErrorCount) end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.Caption := 'Wait please...';
  // Восстановление полного имени каталога:
  Edit1.Text := ExpandFileName(Edit1.Text);
  { Утсановка максимальной длины пути
    (для ограничения числа подкаталогов): }
  MaxLen := Length(Edit1.Text) + 20;
  randomize;
  // Обнуление счетчиков:
  FileCount := 0;
  FolderCount := 0;
  ErrorCount := 0;
  // Создание каталога со случайными файлами и подкаталогами:
  CreateRandom(Edit1.Text);
  Form1.Caption := Format('Created: Folders - %d, files - %d, errors - %d',
    [FolderCount, FileCount, ErrorCount]);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  // Восстановление полного имени каталога:
  Edit1.Text := ExpandFileName(Edit1.Text);
  // Проверка существования каталога:
  if DirectoryExists(Edit1.Text) then begin
    Form1.Caption := 'Wait please...';
    // Обнуление счетчиков:
    FileCount := 0;
    FolderCount := 0;
    ErrorCount := 0;
    // Удаление каталога с файлами и подкаталогами:
    DeleteDir(Edit1.Text);
    Form1.Caption := Format('Deleted: Folders - %d, files - %d, errors - %d',
      [FolderCount, FileCount, ErrorCount]);
  end else ShowMessage('Каталог "' + Edit1.Text + '" Не существует');
end;
Даниил Карапетян
Тематические ссылки
Ваша ссылка Ваша ссылка

Обмен кнопками, ведение статистики, реклама.

 
{Банерная реклама}