Определение суммарного размера файлов в папке, включая вложенные

Delphi , Файловая система , Директории

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

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
Процедура и функция для определения суммарноо размера файлов в папке с учётом вложенных папок.

Первая процедура вычисляет размер файлов сканируя указанную т вложенные папки.
Имеется возможность определения промежуточного результата при помощи функции
обратного вызова (callback function).

Аргументы процедуры:
Dir - папка, в которой необходимо вычислить размер файлов
IncludeSubDirs - логическая переменная, определяющая необходимость сканирования вложеныых папок
Result - переменная типа Int64, в которую записывается результат.
Перед передачей в процедуру значение переменной должно быть обнулено.
CallbackProc - адрес процедуры обратного вызова, имеющий тип TGetDirSizeCallbackProc -
процедура, принимающая два параметра: определяемое пользователем число типа Integer
и размер файлов, определённый на момент вызова процедуры.
CallbackTag - определяемое пользователм число, передаваемое в процедуру обратного вызова.
Применение последних двух примеров см. Пример использования.

Вторая функция просто возвращает размер файлов, принимая только два параметра Dir и IncludeSubDirs

Зависимости: SysUtils
Автор:       Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright:   Dimka Maslov
Дата:        13 сентября 2002 г.
***************************************************** }

type
  TGetDirSizeCallback = procedure(Tag: Integer; CurrentSize: Int64);

procedure GetDirSize(Dir: string; IncludeSubDirs: Boolean; var Result: Int64;
  CallbackProc: TGetDirSizeCallback = nil; CallbackTag: Integer = 0); overload;
var
  SearchRec: TSearchRec;
  FindResult: Integer;
begin
  Dir := IncludeTrailingBackslash(Dir);
  FindResult := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  try
    while FindResult = 0 do
      with SearchRec do
      begin
        if (Attr and faDirectory) <> 0 then
        begin
          if IncludeSubDirs and (Name <> '.') and (Name <> '..') then
            GetDirSize(Dir + Name, IncludeSubDirs, Result, CallbackProc,
              CallbackTag);
        end
        else
        begin
          Result := Result + Cardinal(Size);
          if Assigned(CallbackProc) then
            CallbackProc(CallbackTag, Result);
        end;
        FindResult := FindNext(SearchRec);
      end;
  finally
    FindClose(SearchRec);
  end;
end;

function GetDirSize(Dir: string; IncludeSubDirs: Boolean = True): Int64;
  overload;
begin
  GetDirSize(Dir, IncludeSubDirs, Result, nil, 0);
end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
  S: Int64;
begin
  S := 0;
  GetDirSize('с:\WINDOWS', True, S, @TForm1.GetDirCallback, Integer(Self));
  Label1.Caption := IntToStr(S);
end;

procedure TForm1.GetDirCallback(CurrentSize: Int64);
begin
  Label1.Caption := IntToStr(CurrentSize);
  Label1.Repaint;
end;

Перевод контента на русский язык:

Приведенный код - это реализация в Delphi для расчета общего размера файлов в директории, включая поддиректории. Процедура GetDirSize сканирует указанную директорию и ее поддиректории для расчета общего размера всех файлов.

Обзор кода:

1. Тип TGetDirSizeCallback определяет процедуру, которая принимает два параметра: Tag (целое число) и CurrentSize (Int64, представляющий текущий размер).
2. Процедура GetDirSize имеет пять параметров:
   • Dir: директория для сканирования
   • IncludeSubDirs: булев значение, указывающее, включать ли поддиректории в сканирование
   • Result: переменная для хранения общего размера файлов (инициализируется значением 0)
   • CallbackProc: необязательная процедура обратного вызова, которая может использоваться для обновления UI или выполнения других задач во время процесса сканирования
   • CallbackTag: необязательное целое значение, передаваемое в процедуру обратного вызова
3. Функция GetDirSize перегружена и предоставляет более простой способ расчета общего размера файлов в директории без использования процедуры обратного вызова.
4. Событийный обработчик Button1Click в примере демонстрирует, как использовать процедуру GetDirSize с процедурой обратного вызова. Он инициализирует переменную результат, вызывает GetDirSize, а затем обновляет метку на форме с расчетом общего размера.
5. Процедура GetDirCallback вызывается процедурой GetDirSize при необходимости обновления UI или выполнения других задач во время процесса сканирования.

Некоторые улучшения, которые можно сделать:

• Обработка ошибок: код не обрабатывает ошибки должным образом. Например, если директория, указанная в параметре Dir, не существует, программа будет вылетать с ошибкой доступа.
• Оптимизация производительности: сканирование большого количества файлов и директорий может быть ресурсоемким. Рассмотрите использование потоков или асинхронных операций для улучшения производительности.
• Организация кода: код является quite длинным и сложным. Разбивайте его на более маленькие процедуры и функции, чтобы сделать его проще в поддержке и отладке.

Альтернативное решение, использующее рекурсию вместо итерации для расчета общего размера файлов:

function GetDirSize( Dir: string; IncludeSubDirs: Boolean  = True): Int64;
var
  FileSize: Int64;
begin
  Result  := 0;
  if DirectoryExists( Dir ) then
  begin
    for File in TDirectory.GetFiles( Dir ) do
    begin
      FileSize  := FileSize  + GetFileSize( File );
    end;

    if IncludeSubDirs then
    begin
      for SubDir in TDirectory.GetDirectories( Dir ) do
      begin
        Result  := Result  + GetDirSize( SubDir, True );
      end;
    end;
  end;
end;

function GetFileSize( FileName: string): Int64;
var
  FileSize: Int64;
begin
  FileSize  := 0;
  try
    FileSize  := FileSize  + FileSize;
  except
    on E: Exception do
      Raise;
  end;
  Result  := FileSize;
end;

Это решение более простое и легко понимаемое, но может не быть так эффективным для очень больших директорий.

Определение суммарного размера файлов в папке, включая вложенные, с помощью процедуры и функции для сканирования указанной папки и ее подпапок.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Директории ::