Author: Jonas Bilinkevicius
I'm looking for a way to find the size of any given directory and all the files in
that directory. I know when you look at the properties of a given directory you get
the size, date, number of sub- directories, etc. That is the information that I'm
looking for.
Answer:
Solve 1:
1 unit DirectorySize;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls;
8
9 type
10 TFrmDirectorySize = class(TForm)
11 Button1: TButton;
12 Memo1: TMemo;
13 CbxFilesToo: TCheckBox;
14 Memo2: TMemo;
15 procedure Button1Click(Sender: TObject);
16 procedure FormCreate(Sender: TObject);
17 private
18 public
19 end;
20
21 var
22 FrmDirectorySize: TFrmDirectorySize;
23
24 implementation
25
26 {$R *.DFM}
27
28 uses
29 FileCtrl;
30
31 function FormatNumber(ANumber: double): string;
32 var
33 p: integer;
34 begin
35 Result := Format('%n', [ANumber]);
36 p := Pos(DecimalSeparator, Result);
37 if p > 0 then
38 Result := Copy(Result, 1, p - 1);
39 end;
40
41 function GetDirectorySize(APath: string; AList: TStrings; AFilesToo: boolean):
42 longint;
43 const
44 indent: string = '';
45 var
46 curItem: integer;
47 dirSize: longint;
48 kb: double;
49 searchRec: SysUtils.TSearchRec;
50 tmpS: string;
51 begin
52 if AFilesToo and (indent <> EmptyStr) then
53 AList.Add(EmptyStr);
54 curItem := AList.Add(indent + APath);
55 Result := 0;
56 if APath[Length(APath)] <> '\' then
57 APath := APath + '\';
58 if FindFirst(APath + '*.*', faDirectory, searchRec) = 0 then
59 repeat
60 {Assure that it's a normal file}
61 with searchRec do
62 begin
63 if Name[1] <> '.' then
64 if (Attr and faDirectory > 0) then
65 begin
66 indent := indent + ' ';
67 dirSize := GetDirectorySize(APath + Name + '\', AList, AFilesToo);
68 Delete(indent, 1, 2);
69 Result := Result + dirSize;
70 end
71 else
72 begin
73 Result := Result + searchRec.Size;
74 if AFilesToo then
75 begin
76 {Memo2.Clear; Memo2.Lines.Add(Name);}
77 AList.Add(indent + ' ' + Name + ' [' + FormatNumber(searchRec.Size) +
78 ']');
79 end;
80 end;
81 end;
82 Application.ProcessMessages;
83 until FindNext(searchRec) <> 0;
84 SysUtils.FindClose(searchRec);
85 kb := Result / 1024.0;
86 tmpS := ' (' + Format('%nk', [kb]) + ')';
87 AList[curItem] := AList[curItem] + ' [' + FormatNumber(Result) + tmpS + ']';
88 end;
89
90 procedure TFrmDirectorySize.Button1Click(Sender: TObject);
91 var
92 directory: string;
93 begin
94 Memo1.Clear;
95 Button1.Enabled := false;
96 Cursor := crHourglass;
97 Memo1.Lines.BeginUpdate;
98 try
99 Application.ProcessMessages;
100 if SelectDirectory('Select A Directory', '', directory) then
101 begin
102 Caption := Directory;
103 GetDirectorySize(directory, Memo1.Lines, CbxFilesToo.Checked);
104 end;
105 finally
106 Cursor := crDefault;
107 Button1.Enabled := true;
108 Memo1.Lines.EndUpdate;
109 end;
110 end;
111
112 procedure TFrmDirectorySize.FormCreate(Sender: TObject);
113 begin
114 Memo2.Clear;
115 Icon.Assign(Application.Icon);
116 end;
117
118 end.
Solve 2:
119 uses
120 Windows
121
122 function CalcFolderSize(aRootPath: string): Int64;
123
124 procedure Traverse(const aFolder: string);
125 var
126 Data: TWin32FindData;
127 FileHandle: THandle;
128 begin
129 FileHandle := FindFirstFile(PCHAR(aFolder + '*'), Data);
130 if FileHandle <> INVALID_HANDLE_VALUE then
131 try
132 repeat
133 if (Data.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0)
134 and (Data.cFileName[0] <> '.') then
135 Traverse(aFolder + Data.cFilename + '\')
136 else
137 Inc(Result, (Data.nFileSizeHigh * MAXDWORD) + Data.nFileSizeLow);
138 until
139 not FindNextFile(FileHandle, Data);
140 finally
141 Windows.FindClose(FileHandle);
142 end;
143 end;
144
145 begin
146 Result := 0;
147 if aRootPath[Length(aRootPath)] <> '\' then
148 aRootPath := aRootPath + '\';
149 Traverse(aRootPath);
150 end;
Solve 3:
Most the examples of this I've seen return a 4-byte integer. That's mostly ok for
file sizes, but a sum of file size can more easily exceed the 4Gb limit. This
example uses and 8-byte (signed) integer:
151
152 function DirectorySize(const sPath: TFileName): Int64;
153 var
154 rFind: TSearchRec;
155 iSize: Int64;
156 begin
157 Result := 0;
158 if SysUtils.FindFirst(IncludeTrailingBackslash(sPath) + '*', faAnyFile, rFind) = 0
159 then
160 begin
161 try
162 repeat
163 if rFind.Name <> StringOfChar('.', Length(rFind.Name)) then
164 begin
165 if (rFind.Attr and faDirectory) = faDirectory then
166 Result := Result + DirectorySize(IncludeTrailingBackslash(sPath) +
167 rFind.Name)
168 else
169 begin
170 iSize := (Int64(rFind.FindData.nFileSizeHigh)shl32) or
171 rFind.FindData.nFileSizeLow;
172 Result := Result + iSize;
173 end;
174 end;
175 until
176 SysUtils.FindNext(rFind) <> 0;
177 finally
178 SysUtils.FindClose(rFind);
179 end;
180 end;
181 end;
|
