home *** CD-ROM | disk | FTP | other *** search
/ PC-Test Pro / PCTESTPRO.iso / disktool / diskwast / entp / dwaste.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-02  |  8.5 KB  |  255 lines
  1. program DisplayWaste;
  2. uses
  3.   dos;
  4.  
  5. Var
  6.   ClusterSize : word;
  7.   TotalFiles,
  8.   TotalBytes,
  9.   TotalClusters : longint;
  10.  
  11. procedure showhelp(const problem :byte);
  12. (* If any *foreseen* errors arise, we are sent here to
  13.    give a little help and exit (relatively) peacefully *)
  14. const
  15.   progdesc = 'DiskWaste v1.02 - Free DOS utility: Display disk space wasted by small files.';
  16.   author   = 'July 3, 1995.  Copyright (c) 1995 by David Daniel Anderson - Reign Ware.';
  17.   usage1   = 'Usage:  DWaste <[drive:][\]directory\[filespec]>';
  18.   usage2   = ' -OR-   DWaste <filespec>';
  19.   usage3   = ' -OR-   DWaste <drive:>';
  20.   notes1   = 'Notes:  Anything bounded by square brackets ([ & ]) is optional.';
  21.   notes2   = '        If you specify a directory, it MUST be followed by a backslash (\).';
  22.   examples = 'Examples:';
  23.   examp1   = '        DWaste c:\dos\*.com';
  24.   examp2   = '        DWaste e:\speed\';
  25.   examp3   = '        DWaste *.bat';
  26.   examp4   = '        DWaste d:';
  27. var
  28.   message : string[50];
  29. begin
  30.   writeln(progdesc);
  31.   writeln(author);    writeln;
  32.   writeln(usage1);
  33.   writeln(usage2);
  34.   writeln(usage3);    writeln;
  35.   writeln(notes1);
  36.   writeln(notes2);    writeln;
  37.   writeln(examples);  writeln;
  38.   writeln(examp1);
  39.   writeln(examp2);
  40.   writeln(examp3);
  41.   writeln(examp4);    writeln;
  42.   if problem > 0 then begin
  43.     case problem of
  44.       1 : message := 'Invalid drive.';
  45.     else  message := 'Unanticipated error of unknown type.';
  46.     end;
  47.     writeln (#7,message);
  48.   end;
  49.   halt(problem)
  50. end;
  51.  
  52. Function RPad(bstr: string; Const len: byte): string;
  53. Begin
  54.   while (length(bstr) < len) do
  55.     bstr := bstr + #32;
  56.   RPad := bstr;
  57. End;
  58.  
  59. function comma (num :longint):string; {insert commas to break up number string}
  60. var s : string[14];
  61.     l : shortint;
  62. begin
  63.   str (num, s);
  64.   l:=(length (s)-2);
  65.   while (l > 1) do begin
  66.     insert (',', s, l);
  67.     dec (l, 3);
  68.   end;
  69.   comma:=s;
  70. end;
  71.  
  72. { SWAG routine }
  73. function getclustersize (drive :byte):word;
  74. var
  75.   regs : registers;
  76. begin
  77.   regs.cx := 0;         {set for error-checking just to be sure}
  78.   regs.ax := $3600;     {get free space}
  79.   regs.dx := drive;     {0=current, 1=a:, 2=b:, etc.}
  80.   msdos (regs);
  81.   getclustersize := regs.ax * regs.cx;      {cluster size!}
  82. end;
  83.  
  84. { Author: Greg Estabrooks }
  85. { For: GetDrive, ChangeDrive, NumDrives }
  86. Function GetDrive :Byte;
  87. Var                         (* Routine to determine the default drive *)
  88.   Regs :Registers;              (* To hold register info for Intr()   *)
  89. begin
  90.   Regs.AX := $1900;             (* Function to determine drive        *)
  91.   Intr($21,Regs);               (* Call Dos Int 21h                   *)
  92.   GetDrive := Regs.AL;          (* Return proper result               *)
  93. end;                            (* Returns  0 = A, 1 = B, 2 = C, ETC  *)
  94.  
  95. Function NumDrives :Byte;
  96. Var                    (* Routine to determine number of valid drives *)
  97.   Regs :Registers;              (* To hold register info for Intr()   *)
  98.   CurDrive :Byte;               (* Temporary storage For current drive*)
  99. begin
  100.   CurDrive := GetDrive;         (* Find out the current drive         *)
  101.   Regs.AH := $0E;               (* Function to change drives          *)
  102.   Regs.DL := CurDrive;          (* Change to current drive            *)
  103.   Intr($21, Regs);              (* Call Dos Int 21h                   *)
  104.   NumDrives := Regs.AL;         (* Return proper info to user         *)
  105. end;
  106.  
  107. Procedure ChangeDrive (Drive :Byte);
  108. Var                             (* Routine to change default drive    *)
  109.   Regs :Registers;              (* To hold register info for Intr()   *)
  110. begin
  111.   Regs.AH := $0E;               (* Function to change Drives          *)
  112.   Regs.DL := Drive;             (* Drive to change to                 *)
  113.   Intr($21,Regs);               (* Call Dos Int 21h                   *)
  114. end;
  115.  
  116. Procedure CalculateWaste (var SR: SearchRec);
  117. begin
  118.   if ((SR.Attr AND Directory) <> Directory)
  119.   and ((SR.Attr AND VolumeID) <> VolumeID)
  120.     then begin
  121.       Inc(TotalFiles);
  122.       TotalBytes := TotalBytes + SR.Size;
  123.       TotalClusters := TotalClusters + (Sr.size div ClusterSize);
  124.       if ((Sr.size mod ClusterSize) <> 0) then Inc(TotalClusters,1);
  125.     end;
  126. end;
  127.  
  128. Procedure FindTheFiles(FileDir :PathStr);
  129. var
  130.   FileRec : SearchRec;
  131.   TFiles  : longint;
  132.   OnlyOne : char;
  133.   DosErr  : integer;
  134. begin
  135.   DosErr := DosError;
  136.   OnlyOne := 's';
  137.   write('Tallying ',RPad(FileDir,58));
  138.   TFiles := TotalFiles;
  139.     FindFirst(FileDir, AnyFile, FileRec);
  140.     while DosError = 0 do
  141.     begin
  142.       CalculateWaste(FileRec);
  143.       FindNext(FileRec);
  144.     end;
  145.   if ((TotalFiles-TFiles) = 1) then OnlyOne := #32;
  146.   writeln('(',(TotalFiles-TFiles):3,' file',OnlyOne,')');
  147.   DosError := DosErr;
  148. end;
  149.  
  150. procedure ScanPath (Path, FileMask : PathStr); { Scans given path for subdirectories }
  151. { Based on a procedure posted by Alexander Staubo on ILink Pascal,
  152.   January, 1994; ... in response to Eddy Thilleman's "AllDirs" procedure }
  153. var
  154.   Dta : SearchRec;
  155. begin
  156.   if Path[Length(Path)] <> '\' then
  157.     Path := Path + '\';
  158.   FindFirst(Path + '*.*', Directory, Dta);
  159.   FindTheFiles(Path+FileMask);
  160.   while DosError = 0 do
  161.     begin
  162.       if (Dta.Name[1] <> '.') and (Dta.Attr and Directory = Directory) then
  163.          ScanPath(Path + Dta.Name + '\',FileMask);  { ** RECURSION ** }
  164.       FindNext(Dta);
  165.     end;
  166. end;
  167.  
  168. var
  169.   pstr      : pathstr;
  170.   pdir      : dirstr;
  171.   pname     : namestr;
  172.   pext      : extstr;
  173.  
  174.   sDrive,             { starting Drive }
  175.   nDrive    : byte;   { Drive to examine }
  176.   WasteSpace,
  177.   TotalSpace  : longint;
  178.  
  179. begin
  180.  
  181. {===========================================================================}
  182.                         (** Initialize global vars **)
  183. {===========================================================================}
  184.  
  185.   TotalFiles := 0;  TotalBytes := 0; TotalClusters := 0;
  186.  
  187. {===========================================================================}
  188.                         (** Determine directories **)
  189. {===========================================================================}
  190.  
  191.   sDrive:=GetDrive;   { save original, so that we can return }
  192.   if (ParamCount=0)
  193.     then showhelp(0)
  194.     else pstr:=ParamStr(1);
  195.   fsplit(fexpand(pstr),pdir,pname,pext);
  196.   pstr:=pdir+pname+pext;
  197.  
  198. {===========================================================================}
  199.                        (** Change to selected drive **)
  200. {===========================================================================}
  201.  
  202.  
  203.   nDrive := Ord(UpCase(pdir[1]))-64;
  204.   if NOT (nDrive in [0..NumDrives])
  205.     then showhelp(1)
  206.     else ChangeDrive(Ord(pdir[1])-65);
  207.  
  208. {===========================================================================}
  209.                         (** Determine cluster size **)
  210. {===========================================================================}
  211.  
  212.   ClusterSize := (GetClusterSize(nDrive));
  213.   if ClusterSize=0
  214.     then showhelp(1);
  215.  
  216. {===========================================================================}
  217.                           (** Write introduction **)
  218. {===========================================================================}
  219.  
  220.   Writeln;
  221.   Writeln ('  Now analyzing - ', pstr);
  222.   Writeln;
  223.  
  224. {===========================================================================}
  225.                             (** Scan the files **)
  226. {===========================================================================}
  227.  
  228.   if pname=''
  229.     then ScanPath(pdir,'*.*')
  230.     else FindTheFiles(pstr);  {only check specified files}
  231.  
  232. {===========================================================================}
  233.                        (** Report on what we found **)
  234. {===========================================================================}
  235.  
  236.   TotalSpace := (TotalClusters * ClusterSize);
  237.   WasteSpace := (TotalSpace - TotalBytes);
  238.   writeln;
  239.   writeln (comma(ClusterSize):15, ' - bytes per cluster');
  240.   writeln (comma(TotalFiles ):15, ' - total files tallied');
  241.   writeln (comma(TotalBytes ):15, ' - total bytes in files');
  242.   writeln (comma(WasteSpace ):15, ' - total bytes wasted by slack space');
  243.   writeln (comma(TotalSpace ):15, ' - total bytes allocated by files');
  244.   if TotalBytes=0
  245.     then write ('0.00':14)
  246.     else write (100*(WasteSpace/TotalSpace):14:2);
  247.   writeln ('% - percent of disk space wasted');
  248.  
  249. {===========================================================================}
  250.                        (** Return to original drive **)
  251. {===========================================================================}
  252.  
  253.   ChangeDrive(sDrive);
  254. end.
  255.