Program DirSize;

{$M 65520,0,655360}
Uses DOS;


type TNodePtr = ^TNode;
     TNode = record
          Attr : byte;
          Name : string[12];
          Time,
          Size,
          SubSize : longint;
          SubNode,
          Next : TNodePtr;
     end;

     TStrStackPtr = ^TStrStack;
     TStrStack = record
          Next : TStrStackPtr;
          Str : String[255];
     end;

VAR Root : TNodePtr;
    CurPath : PathStr;
    WasteSpace,
    TotalMem,
    Dirs,
    Files,
    ClusterSize,
    SubSize : longint;
    DirStack : TStrStackPtr;
    SizeStr : string[10];


Function HeapFunc (Size: Word): Integer; far;
begin
HeapFunc:=-1;
end;

Function GetClusterSize(path : PathStr) : Longint;
var r : registers;
begin
r.ah:=$1c;
r.dl:=pos(path[1],'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
msdos(r);
if r.al<>$ff then GetClusterSize:=r.al*r.cx
else GetClusterSize:=2048;
end;

Procedure Stack(st : string);
var temp : TStrStackPtr;
begin
GetMem(temp,Sizeof(TStrStack)-(255-length(st)));
if temp=nil then begin
     Writeln('Out of memory.');
     halt;
end;
temp^.Str:=st;
temp^.Next:=DirStack;
DirStack:=temp;
end;

Procedure PrintStack(p : TStrStackPtr);
begin
while p<>nil do begin
     Writeln(p^.Str);
     p:=p^.next;
end;
end;

Procedure TraverseTree(var root : TNodePtr; var Path : PathStr; var SubSize : longint);
var CurEntry : SearchRec;
    Current, Last : TNodePtr;
    pathlen, pathlen2 : byte;
begin
pathlen:=length(path);
SubSize:=0;
Inc(Dirs);
root:=nil;
Current:=nil;
Last:=nil;
if path[length(path)]<>'\' then path:=path+'\';
FindFirst(Path+'*.*',ReadOnly+Hidden+SysFile+Directory+Archive,CurEntry);
while DOSError=0 do begin
     if (CurEntry.name<>'.') and (CurEntry.name<>'..') then begin
          New(Current);
          if Current=nil then begin
               Writeln('Out of memory.');
               halt;
          end;
          if Last<>nil then Last^.Next:=Current;
          Last:=Current;
          if Root=nil then Root:=Current;
          Current^.Attr:=CurEntry.Attr;
          Current^.Name:=CurEntry.Name;
          Current^.Time:=CurEntry.Time;
          WasteSpace:=WasteSpace+(CurEntry.Size mod ClusterSize);
          Current^.Size:=CurEntry.Size+ClusterSize-(CurEntry.Size mod ClusterSize);
          Current^.Next:=nil;
          if (Current^.Attr and Directory)<>0 then begin
               pathlen2:=length(path);
               path:=path+Current^.Name;
               if length(path)+12>67 then begin
                    Current^.SubSize:=0;
                    Current^.SubNode:=nil;
                    Writeln('Path too long: ',path);
               end
               else TraverseTree(Current^.SubNode,path,Current^.SubSize);
               path[0]:=char(pathlen2);
               SubSize:=SubSize+Current^.SubSize;
               Current^.Size:=Current^.SubSize;
          end
          else begin
               Current^.SubNode:=nil;
               SubSize:=SubSize+Current^.Size;
               Current^.SubSize:=0;
               Inc(Files);
          end;
          {Writeln(path+current^.name+' ',Current^.Size);}
     end;
     FindNext(CurEntry);
     {Write(#8,#8,#8,#8,(MemAvail*100) div TotalMem:3,'%');}
end;
path[0]:=char(pathlen);
end;


Procedure StackTree(var root : TNodePtr; var Path : PathStr);
var
    Current : TNodePtr;
    Size : longint;
    pathlen, pathlen2 : byte;
begin
pathlen:=length(path);
if path[length(path)]<>'\' then path:=path+'\';
Current:=Root;
Size:=0;
while Current<>nil do begin
     Size:=Size+Current^.Size;
     pathlen2:=length(path);
     path:=path+Current^.Name;
     if (Current^.Attr and Directory)<>0 then StackTree(Current^.SubNode,path);
     path[0]:=char(pathlen2);
     Current:=Current^.Next;
end;
Str(Size:10,SizeStr);
if (Path[Length(path)]='\') and (length(Path)>3) then dec(path[0]);
Stack(SizeStr+' '+Path);
path[0]:=char(pathlen);
{Write(#8,#8,#8,#8,(MemAvail*100) div TotalMem:3,'%');}
end;




begin
TotalMem:=MemAvail;
Writeln('DIRSize Copyright (C)1993 Robware Software Development.  All rights reserved.');
Writeln;

HeapError:=@HeapFunc;

if Paramcount=0 then begin
     GetDir(0,CurPath);
     CurPath:=copy(CurPath,1,2)+'\';
end
else CurPath:=FExpand(ParamStr(1));

Writeln('Reading directory tree of ',CurPath);

Dirs:=0;
Files:=0;
SubSize:=0;
ClusterSize:=GetClusterSize(CurPath);
WasteSpace:=0;

{Write('Memory:    ');}

TraverseTree(Root,CurPath,SubSize);
if Paramcount=0 then begin
     GetDir(0,CurPath);
     CurPath:=copy(CurPath,1,2)+'\';
end
else CurPath:=FExpand(ParamStr(1));
StackTree(Root,CurPath);
PrintStack(DirStack);
Writeln;
WriteLn(' Directories:  ',Dirs:10);
Writeln(' Files:        ',Files:10);
Writeln(' Bytes used:   ',SubSize:10);
Writeln(' Free:         ',Diskfree(pos(Curpath[1],'ABCDEFGHIJKLMNOPQRSTUVWXYZ')):10);
Writeln(' Disk size:    ',DiskSize(pos(Curpath[1],'ABCDEFGHIJKLMNOPQRSTUVWXYZ')):10);
Writeln(' Unaccounted:  ',DiskSize(pos(Curpath[1],'ABCDEFGHIJKLMNOPQRSTUVWXYZ'))-SubSize
     -Diskfree(pos(Curpath[1],'ABCDEFGHIJKLMNOPQRSTUVWXYZ')):10);
Writeln(' Waste space:  ',WasteSpace:10);
Writeln(' Cluster size: ',ClusterSize:10);
end.