Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Декабрь 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

13.545 подписчиков
-22 за неделю
←   Все выпуски   →

Советы по Delphi Delete Folder


Служба Рассылок Subscribe.Ru

Здравствуйте, уважаемые подписчики! Сегодня речь пойдет об удалении каталогов.

Для удаления каталога существует процедура 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;


Полезные мелочи
Чтобы по имени файла определить полное имя файла (найти путь), удобно использовать функцию SearchPath. Она ищет заданный файл в каталоге запущенной программы, текущем каталоге, каталогах Windows, System, установеленных путях. Пример:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  buf: array [0..255] of char;
  filepart: PChar;
begin
  if key = 13 then begin
    if SearchPath(nil, PChar(Edit1.Text), nil, sizeof(buf),
      buf, filepart) > 0
    then Edit1.Text := buf
    else begin
      if ExtractFileExt(Edit1.Text) = '' then begin
        if SearchPath(nil, PChar(ChangeFileExt(Edit1.Text, '.exe')),
          nil, sizeof(buf), buf, filepart) > 0
        then Edit1.Text := buf;
      end;
    end;
    key := 0;
  end;
end;

// system -> C:\WINDOWS\system
// Temp -> C:\WINDOWS\Temp
// notepad.exe -> C:\WINDOWS\notepad.exe
// notepad -> C:\WINDOWS\notepad.exe
// project1 -> D:\PROGRAM\DELPHI5\PROJECTS\project1.exe


Программа из этого выпуска была протестирована:
Стексов Сергей
Миколенко Денис
SeeGo (kasimovonline.narod.ru)
Быданцев Александр
DieHeat
Тымчий Юрий (www.yura.sity.org)

Все советы и замечания, пожалуйста, присылайте на subscribe@program.dax.ru

Всего доброго,
Даниил Карапетян.




http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное