Автор: 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;