Contributor: MICHAEL DAY
{$I-}
{$M 65000,0,1024}
program KillDir;
uses crt,dos;
type String12 = string[12];
var TotalSize : longint;
ThisSize : longint;
procedure UpString(var S:string);
var i:word;
begin
for i := 1 to length(S) do
S[i] := upcase(S[i]);
end;
function AbortIt:boolean;
var ch : char;
begin
AbortIt := false;
if not(KeyPressed) then Exit;
ch := readkey;
if ch = #0 then ch := chr(ord(readkey) or 80ドル);
if (ch = ^C) or (ch = ^X) or (ch = ^Q) or (ch = #1ドルB) then
AbortIt := true;
end;
function GetSize(var F:file):string12;
var RawSize : longint;
Size:string;
begin
Reset(F,1);
RawSize := FileSize(F);
Close(F);
ThisSize := RawSize;
if IOresult 0 then {nop};
if RawSize < 10000 then begin str(RawSize,Size); end else if RawSize < (1024*999) then begin str(RawSize div 1024,Size); Size[length(Size)+1] := 'K'; inc(Size[0]); end else begin str(RawSize div (1000*1024),Size); Size[length(Size)+1] := 'M'; Inc(Size[0]); end; while length(Size) < 4 do begin Size := ' '+Size; end; GetSize := Size; end; function SizeIt(Which:string):byte; var DirInfo:SearchRec; f : file; Attr,Result:word; Size,Who:string12; Current:string; begin SizeIt := 1; if IOresult 0 then {nop};
GetDir(0,Current);
chdir(Which);
if IOresult 0 then Exit;
Who := '*.*';
findfirst(Who, 3ドルF, DirInfo);
while DosError = 0 do
begin
if AbortIt then
begin
SizeIt := 2;
Exit;
end;
if (DirInfo.Name '.') and (DirInfo.Name '..') then
begin
Assign(F,DirInfo.Name);
GetFAttr(F,Attr);
if (Attr and Directory) 0 then
begin
Result := SizeIt(DirInfo.Name);
SizeIt := Result;
if Result 0 then Exit;
end
else
begin
SetFAttr(F,0);
Size := GetSize(F);
Who := DirInfo.Name+' ';
writeln(Current+'\'+Which,' ',Who,' Size:',Size);
TotalSize := TotalSize+ThisSize;
end;
end;
FindNext(DirInfo);
end;
if IOresult 0 then {nop};
ChDir(Current);
SizeIt := 0;
end;
var Where:string;
Current:string;
Yorn:string;
Result:word;
begin
TotalSize := 0;
writeln;
Writeln('Directory Sizer V1.01 Written by Michael Day as of 05 Sept 94');
if ParamCount < 0 then begin writeln('Format is: FSIZE DIRNAME'); writeln('This program will find the size of all files and all directories'); writeln('in and below the directory DIRNAME.'); halt(1); end; Where := ParamStr(1); UpString(Where); if pos(Where,':') 0 then
begin
writeln('Sorry, you cannot size directories on another drive with this program.');
writeln('Please move to that drive first.');
halt(2);
end;
if IOresult 0 then {nop};
GetDir(0,Current);
chdir(Where);
if IOresult 0 then
Result := 1
else
Result := 0;
chdir(Current);
if Result = 0 then
begin
writeln('This will find the size of ALL files and ALL directories in and below:');
writeln(Current+'\'+Where);
Result := SizeIt(Where);
chdir(Current);
write('Total size of the directory');
write(Current+'\'+Where);
writeln(TotalSize);
if Result = 2 then
begin
writeln('Directory size operation terminated by the user.');
Halt(3);
end;
end;
if Result = 1 then
begin
writeln('Error finding directory: ',Where);
writeln('The directory probably does not exist.');
halt(4);
end;
end.
Here is the short version written for BP7 in DOS:
This program simply lists the names of the files, but you could change the output line do
accumulate sizes just as easily.
program search;
uses dos;
var i:integer;
d:dirstr; n:namestr; x:extstr;
procedure helpmsg;
begin
writeln('SEARCH filespec [filespec]...');
end;
procedure dosearch(const d:string);
var sr:searchrec;
procedure dofilesearch;
begin
findfirst(d+n+x,archive+readonly,sr);
while doserror=0 do begin
writeln(d+sr.name); { THE output }
findnext(sr);
end;
end;
procedure dodirsearch;
begin
findfirst(d+'*.*',directory,sr);
while doserror=0 do begin
if (sr.attr and directory = directory)
and (sr.name[1]'.') then { ignores "." and ".." }
dosearch(d+sr.name+'\');
findnext(sr);
end;
end;
begin {dosearch}
dofilesearch;
dodirsearch;
end;
begin
if paramcount<1 then helpmsg
else begin
for i:=1 to paramcount do begin
fsplit(paramstr(i),d,n,x);
dosearch(d);
end;
end;
end.