Разное
Последние книги
Самое популярное
Все бесплатно
Все ссылки на файлы, расположенные на страницах сайта, добавлены пользователями и доступны для бесплатного скачивания. За содержание этих файлов администрация сайта ответственности не несет.
Навигация
Вопросы
Компоненты TabControl, PageControl, TabSet, TabbedNoteBook, NoteBook
Категория: Компоненты
Категория: Компоненты
Узнать установлена ли BDE
Категория: Базы данных
Категория: Базы данных
Распознавание кодировки. Перекодировка.
Категория: Текст и строки
Категория: Текст и строки
Округление целого числа до 5
Категория: Математика
Категория: Математика
Быстрое копирование файлов
Категория: Файловая система
Категория: Файловая система
Замена подстроки в строке
Категория: Текст и строки
Категория: Текст и строки
Программно скрыть MainMenu
Категория: Компоненты
Категория: Компоненты
Как нарисовать фрактал
Категория: Математика
Категория: Математика
Найти все компьютеры в сети
Категория: Интернет и Сети
Категория: Интернет и Сети
Создать индекс для таблицы ABS (Absolute Database)
Категория: Базы данных
Категория: Базы данных
Delphi - База Знаний: Определение размера каталога
var
Form1: TForm1;
DirBytes: integer;
implementation
{$R *.dfm}
function DirSize(Dir: string): integer;
var
SearchRec: TSearchRec;
Separator: string;
begin
if Copy(Dir,Length(Dir),1)='\' then
Separator := ''
else
Separator := '\';
if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then
begin
if FileExists(Dir+Separator+SearchRec.name) then
DirBytes := DirBytes + SearchRec.Size
else
if DirectoryExists(Dir+Separator+SearchRec.name) then
begin
if (SearchRec.name<>'.') and (SearchRec.name<>'..') then
DirSize(Dir+Separator+SearchRec.name);
end;
while FindNext(SearchRec) = 0 do
begin
if FileExists(Dir+Separator+SearchRec.name) then
DirBytes := DirBytes + SearchRec.Size
else
if DirectoryExists(Dir+Separator+SearchRec.name) then
begin
if (SearchRec.name<>'.') and (SearchRec.name<>'..') then
DirSize(Dir+Separator+SearchRec.name);
end;
end;
end;
FindClose(SearchRec);
Result:=Result+DirBytes;
end;
вызов:
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
DirBytes:=0;
DirBytes := DirSize('c:\windows');
Label1.Caption := IntToStr(DirBytes);
end;
Возвращаемая размерность - байты.):
var
dirbytes : integer;
function tfilebrowser.dirsize(dir:string):integer;
var
searchrec : tsearchrec;
separator : string;
begin
if copy(dir,length(dir),1)='\' then
separator := ''
else
separator := '\';
if findfirst(dir+separator+'*.*',faanyfile,searchrec) = 0 then begin
if fileexists(dir+separator+searchrec.name) then begin
dirbytes := dirbytes + searchrec.size;
{memo1.lines.add(dir+separator+searchrec.name);}
end else if directoryexists(dir+separator+searchrec.name) then begin
if (searchrec.name<>'.') and (searchrec.name<>'..') then begin
dirsize(dir+separator+searchrec.name);
end;
end;
while findnext(searchrec) = 0 do begin
if fileexists(dir+separator+searchrec.name) then begin
dirbytes := dirbytes + searchrec.size;
{memo1.lines.add(dir+separator+searchrec.name);}
end else if directoryexists(dir+separator+searchrec.name) then
begin
if (searchrec.name<>'.') and (searchrec.name<>'..') then begin
dirsize(dir+separator+searchrec.name);
end;
end;
end;
end;
findclose(searchrec);
end;