[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;
а как исправить ошибку, если папка много весит?Код:[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;
делал D:\Games и тоже ошибкаА х.з. Это не мой пример. А кто автор, я забыл.
И скорее всего ошибка не из-за размера папки, а из-за недоступности (та же C:\Windows).
[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);
посмотрите код выше, если можно поправитьНу, значит не может получить доступ. У меня на вынь 7 показывает 0, если я пытаюсь получить размер C:\Windows
[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;
что не так у меня? по нулям пишетКод:[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;