Последние записи

made in programmersforum 4

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

17th
Апр

Как программно узнать размер папки

Posted by maloy under Delphi, Архив

VIR1435

Скажите как программно можно узнать размер папки?

quit

Код:


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

Процедура и функция для определения суммарноо размера файлов в папке 
с учётом вложенных папок.

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

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

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

Зависимости: SysUtils
***************************************************** }

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;

тема на форуме от 2009 года