Вопрос Получить размер папки

nik1967

Old Men
Проверенный
Код:
[Setup]
AppName=FolderSize
AppVerName=FolderSize
DefaultDirName={pf}\FolderSize
OutputDir=.

[code]
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';

function BytesToSize(Bytes: Extended): String;
var
  pszBuf: array [0..15] of Char;
begin
  try
  Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
  except end;
end;

function GetFolderSize(path: String): Extended;  // размер папки
var
  oFS: Variant;
begin
  try
  if not DirExists(path) then Exit;
  oFS:= CreateOleObject('Scripting.FileSystemObject');
  Result:= oFS.GetFolder(path).Size;
  except
  Result:= 0;
  end;
end;

function InitializeSetup: Boolean;
begin
   MsgBox(BytesToSize(GetFolderSize('C:\Program Files (x86)\Microsoft Office')), mbInformation, MB_OK);
   Result:= false;
end;
 

Ekspoint

Новичок
Код:
[Setup]
AppName=FolderSize
AppVerName=FolderSize
DefaultDirName={pf}\FolderSize
OutputDir=.

[code]
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';

function BytesToSize(Bytes: Extended): String;
var
  pszBuf: array [0..15] of Char;
begin
  try
  Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
  except end;
end;

function GetFolderSize(path: String): Extended;  // размер папки
var
  oFS: Variant;
begin
  try
  if not DirExists(path) then Exit;
  oFS:= CreateOleObject('Scripting.FileSystemObject');
  Result:= oFS.GetFolder(path).Size;
  except
  Result:= 0;
  end;
end;

function InitializeSetup: Boolean;
begin
   MsgBox(BytesToSize(GetFolderSize('C:\Program Files (x86)\Microsoft Office')), mbInformation, MB_OK);
   Result:= false;
end;
а как исправить ошибку, если папка много весит?
 

nik1967

Old Men
Проверенный
А х.з. Это не мой пример. А кто автор, я забыл.
И скорее всего ошибка не из-за размера папки, а из-за недоступности (та же C:\Windows).
 

nik1967

Old Men
Проверенный
Вот мои D:\Games:

Если на 8-ке, то там с доступом намутили. Попробуй скомпиллить, а затем запустить от админа.
 
Последнее редактирование:

Ekspoint

Новичок
вот нашел еще код, но он считает не правильно, если поправить то будет супер
Код:
[Setup]
AppName=My Program
AppVerName=My Program ver.1.5
DefaultDirName={pf}\My Program

[Code]
  Function NumToStr(Float: Extended): String;
Begin
  Result:= Format('%.2n', [Float]); StringChange(Result, ',', ',');
  while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = ',')) and (Pos(',', Result) > 0) do
  SetLength(Result, Length(Result)-1);
End;

  Function MbOrTb(Byte: Extended): AnsiString;
begin
if Byte < 1024 then Result:= NumToStr(Byte) + ' MB' else
  if Byte/1024 < 1024 then Result:= NumToStr(round(Byte/1024*100)/100) + ' GB' else
     Result:= NumToStr(round((Byte/(1024*1024))*100)/100) + ' TB'
end;

function CalcDirSize(const fromDir, fileMask: string; SubDirsAllow: Boolean): Longword;
var
  FSR, DSR: TFindRec;
  FindResult: Boolean;
  APath: string;
begin
  APath := AddBackslash(fromDir);
  FindResult := FindFirst(APath + fileMask, FSR);
  try
    while FindResult do
    begin
      if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
        begin
            Result := Result+(FSR.SizeLow / 1000);
        end;
      FindResult := FindNext(FSR);
    end;
    FindResult := FindFirst(APath + '*.*', DSR);
    while FindResult and SubDirsAllow do
    begin
      if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and
        not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
      FindResult := FindNext(DSR);
    end;
  finally
    FindClose(FSR);
    FindClose(DSR);
  end;
end;

function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';

function BytesToSize(Bytes: Extended): String;
var
  pszBuf: array [0..15] of Char;
begin
  try
  Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
  except end;
end;

procedure InitializeWizard;
var
  res: Longword;
begin
  res:= CalcDirSize('C:\Windows', '*', False);
  MsgBox(BytesToSize(res), mbInformation, MB_OK);
end;
проблема в этом
Код:
 Result := Result+(FSR.SizeLow / 1000);
 

nik1967

Old Men
Проверенный
Ну, значит не может получить доступ. У меня на вынь 7 показывает 0, если я пытаюсь получить размер C:\Windows
 

nik1967

Old Men
Проверенный
Код:
[Setup]
AppName=Calc DirSize
AppVerName=Calc DirSize
CreateAppDir=false
OutputDir=.
[Code] 
var
Browse, SizeButton: TButton; LSize: TLabel; Folder: String; Work: Boolean;
Msg: TMsg;
function PeekMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax, wRemoveMsg: LongInt): LongInt; external 'PeekMessageW@user32.dll stdcall';
procedure ProcessMessage();
begin
  Work:= False;
end;
/////////// NEW ///////////////////////
const
oneMB= 1024*1024; VK_SHIFT = $10;
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
Function ByteOrGB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб (до 3х знаков после запятой)}
Begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= FloatToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Mb' else
Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb';
StringChange(Result, ',', '.');
End;
Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo; if Lo< 0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2; for Hi:= Hi-1 Downto 0 do Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;
function CalcDirSize(const fromDir, fileMask: string; SubDirsAllow: Boolean): Extended;
var
FSR, DSR: TFindRec; FindResult: Boolean; APath: string;
res: longint;
Begin
APath:= AddBackslash(fromDir);
FindResult:= FindFirst(APath + fileMask, FSR);
Try
while FindResult do
begin
/////////// NEW ///////////////////////
res:= PeekMessage(Msg, SizeButton.Handle, $0201, $0203, 1);
if res <> 0 then
begin
ProcessMessage();
Exit;
end;
/////////// NEW ///////////////////////
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then Result:= Result + Size64(FSR.SizeHigh, FSR.SizeLow);
//if GetKeyState(VK_SHIFT) < 0 then Work:= false; // флаг сброшен, это значит, что клавиша прерывания работы нажималась
if not Work then Exit; // прерывание подсчёта, если нажата клавиша
FindResult:= FindNext(FSR);
end;
FindResult := FindFirst(APath + '*.*', DSR);
while FindResult and SubDirsAllow do
begin
if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
// если есть хоть одна рекурсия, то подсчёт почему-то не прерывается
FindResult:= FindNext(DSR);
end;
Finally
FindClose(FSR); FindClose(DSR);
end;
End;
Procedure SizeButtonOnClick(Sender: TObject); var res: Extended;
Begin
  LSize.Caption:= 'Please wait...' #13#10 'Calculating folders'; WizardForm.Repaint
  Work:= true; // флаг нажатия клавиши прерывания работы функции CalcDirSize.
  SizeButton.Caption:= 'Stop'; // NEW
  res:= CalcDirSize(Folder, '*', True); // если подсчёт (или копирование в SHFileOperation) идёт долго, то должна быть возможность его прервать
  LSize.Caption:= 'DirSize = ' + ByteOrGB(res, true) + #13#10 + Folder
  SizeButton.Caption := 'Calc';
End;
Procedure BrowseOnClick(Sender: TObject);
Begin
if BrowseForFolder('Calc Folder', Folder, false) then SizeButtonOnClick(SizeButton);
End;
Procedure InitializeWizard;
begin
Browse:= TButton.Create(WizardForm);
Browse.SetBounds(WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width, WizardForm.CancelButton.Top, 48, WizardForm.CancelButton.Height)
Browse.Caption := 'Change';
Browse.OnClick := @BrowseOnClick;
Browse.Parent := WizardForm;
SizeButton:= TButton.Create(WizardForm);
SizeButton.SetBounds(Browse.Left + Browse.Width, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width/2, WizardForm.CancelButton.Height)
SizeButton.Caption := 'Calc';
SizeButton.OnClick := @SizeButtonOnClick;
SizeButton.Parent := WizardForm;
Folder:= ExpandConstant('{win}') // для начала берём эту папку
LSize:= TLabel.Create(WizardForm);
LSize.SetBounds(SizeButton.Left + SizeButton.Width + 8, SizeButton.Top, 12, 12)
LSize.Caption:= 'Click Calc button' #13#10 'Current dir: ' + Folder;
LSize.Parent:= WizardForm;
end;
 

Ekspoint

Новичок
Код:
[Setup]
AppName=Calc DirSize
AppVerName=Calc DirSize
CreateAppDir=false
OutputDir=.
[Code]
var
Browse, SizeButton: TButton; LSize: TLabel; Folder: String; Work: Boolean;
Msg: TMsg;
function PeekMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax, wRemoveMsg: LongInt): LongInt; external 'PeekMessageW@user32.dll stdcall';
procedure ProcessMessage();
begin
  Work:= False;
end;
/////////// NEW ///////////////////////
const
oneMB= 1024*1024; VK_SHIFT = $10;
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
Function ByteOrGB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб (до 3х знаков после запятой)}
Begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= FloatToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Mb' else
Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb';
StringChange(Result, ',', '.');
End;
Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo; if Lo< 0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2; for Hi:= Hi-1 Downto 0 do Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;
function CalcDirSize(const fromDir, fileMask: string; SubDirsAllow: Boolean): Extended;
var
FSR, DSR: TFindRec; FindResult: Boolean; APath: string;
res: longint;
Begin
APath:= AddBackslash(fromDir);
FindResult:= FindFirst(APath + fileMask, FSR);
Try
while FindResult do
begin
/////////// NEW ///////////////////////
res:= PeekMessage(Msg, SizeButton.Handle, $0201, $0203, 1);
if res <> 0 then
begin
ProcessMessage();
Exit;
end;
/////////// NEW ///////////////////////
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then Result:= Result + Size64(FSR.SizeHigh, FSR.SizeLow);
//if GetKeyState(VK_SHIFT) < 0 then Work:= false; // флаг сброшен, это значит, что клавиша прерывания работы нажималась
if not Work then Exit; // прерывание подсчёта, если нажата клавиша
FindResult:= FindNext(FSR);
end;
FindResult := FindFirst(APath + '*.*', DSR);
while FindResult and SubDirsAllow do
begin
if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
// если есть хоть одна рекурсия, то подсчёт почему-то не прерывается
FindResult:= FindNext(DSR);
end;
Finally
FindClose(FSR); FindClose(DSR);
end;
End;
Procedure SizeButtonOnClick(Sender: TObject); var res: Extended;
Begin
  LSize.Caption:= 'Please wait...' #13#10 'Calculating folders'; WizardForm.Repaint
  Work:= true; // флаг нажатия клавиши прерывания работы функции CalcDirSize.
  SizeButton.Caption:= 'Stop'; // NEW
  res:= CalcDirSize(Folder, '*', True); // если подсчёт (или копирование в SHFileOperation) идёт долго, то должна быть возможность его прервать
  LSize.Caption:= 'DirSize = ' + ByteOrGB(res, true) + #13#10 + Folder
  SizeButton.Caption := 'Calc';
End;
Procedure BrowseOnClick(Sender: TObject);
Begin
if BrowseForFolder('Calc Folder', Folder, false) then SizeButtonOnClick(SizeButton);
End;
Procedure InitializeWizard;
begin
Browse:= TButton.Create(WizardForm);
Browse.SetBounds(WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width, WizardForm.CancelButton.Top, 48, WizardForm.CancelButton.Height)
Browse.Caption := 'Change';
Browse.OnClick := @BrowseOnClick;
Browse.Parent := WizardForm;
SizeButton:= TButton.Create(WizardForm);
SizeButton.SetBounds(Browse.Left + Browse.Width, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width/2, WizardForm.CancelButton.Height)
SizeButton.Caption := 'Calc';
SizeButton.OnClick := @SizeButtonOnClick;
SizeButton.Parent := WizardForm;
Folder:= ExpandConstant('{win}') // для начала берём эту папку
LSize:= TLabel.Create(WizardForm);
LSize.SetBounds(SizeButton.Left + SizeButton.Width + 8, SizeButton.Top, 12, 12)
LSize.Caption:= 'Click Calc button' #13#10 'Current dir: ' + Folder;
LSize.Parent:= WizardForm;
end;
что не так у меня? по нулям пишет
Код:
[Code]
var
Browse, SizeButton: TButton; LSize: TLabel; Folder: String; Work: Boolean;
Msg: TMsg;
function PeekMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax, wRemoveMsg: LongInt): LongInt; external 'PeekMessageW@user32.dll stdcall';
procedure ProcessMessage();
begin
  Work:= False;
end;
/////////// NEW ///////////////////////
const
oneMB= 1024*1024; VK_SHIFT = $10;
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
Function ByteOrGB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб (до 3х знаков после запятой)}
Begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= FloatToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Mb' else
Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb';
StringChange(Result, ',', '.');
End;
Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo; if Lo< 0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2; for Hi:= Hi-1 Downto 0 do Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;
function CalcDirSize(const fromDir, fileMask: string; SubDirsAllow: Boolean): Extended;
var
FSR, DSR: TFindRec; FindResult: Boolean; APath: string;
res: longint;
Begin
APath:= AddBackslash(fromDir);
FindResult:= FindFirst(APath + fileMask, FSR);
Try
while FindResult do
begin
/////////// NEW ///////////////////////
res:= PeekMessage(Msg, WizardForm.Handle, $0201, $0203, 1);
if res <> 0 then
begin
ProcessMessage();
Exit;
end;
/////////// NEW ///////////////////////
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then Result:= Result + Size64(FSR.SizeHigh, FSR.SizeLow);
//if GetKeyState(VK_SHIFT) < 0 then Work:= false; // флаг сброшен, это значит, что клавиша прерывания работы нажималась
if not Work then Exit; // прерывание подсчёта, если нажата клавиша
FindResult:= FindNext(FSR);
end;
FindResult := FindFirst(APath + '*.*', DSR);
while FindResult and SubDirsAllow do
begin
if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
// если есть хоть одна рекурсия, то подсчёт почему-то не прерывается
FindResult:= FindNext(DSR);
end;
Finally
FindClose(FSR); FindClose(DSR);
end;
End;

Procedure InitializeWizard;
var res: Extended; Label3: TLabel;
begin
Label3 := TLabel.Create(WizardForm);
  with Label3 do
  begin
    Parent := WizardForm.ReadyPage;
    AutoSize := False;
    Left := ScaleX(56);
    Top := ScaleY(56);
    Width := ScaleX(159);
    Height := ScaleY(13);
  end;
res:= CalcDirSize('C:\Windows', '*', false);
Label3.Caption := ByteOrGB(res, false);
end;

и нули бы убрать после точки
 
Последнее редактирование:
Сверху