[Back to DRIVES SWAG index]  [Back to Main SWAG index]  [Original]

{$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 = #$1B) 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, $3F, 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.

[Back to DRIVES SWAG index]  [Back to Main SWAG index]  [Original]