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

{ **** 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
;

Другое по теме:

• Удаление каталога со всем содержимым
• Копирование файлов вместе с каталогами
• Определение размера каталога