Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/HOWMUCH.ZIP/HOWMUCH.PAS

Pascal/Delphi Source File | 1985-07-29 | 7.7 KB | 198 lines

{|---------------------------------------------------------------------|
 |    Program: HowMuch.pas.                                            |
 |    Purpose: This program allows you to determine how much disk      |
 |             disk space is used by groups of files.                  |
 |    Example: -- Howmuch *.pas -- will compute how much diskspace     |
 |             all Pascal programs use in the current directory.       |
 |             Dos does not provide such a feature.  Its great         |
 |             when your backing up files from a hard disk to floppies |
 |             and you need to know if the files will fit on the disk. |
 |    Note:    all the wild-card features of dos will work. Entering   |
 |             just Howmuch will default to Howmuch *.*.               |
 |             This is a simple but very valuable utility that every   |
 |             every one should have. Im supprised IBM has overlooked  |
 |             this need.                                              |
 |    ack:     I have used the directory subroutines Staysubs.inc      |
 |             from the stayre.pas collection modified to compute      |
 |             disk space for each file. Author of these routines      |
 |             Neil J. Rubenking.                                      |
 |    Author:  Anthony Cassio of Croton Falls N.Y. [76474,231];        |
 |---------------------------------------------------------------------|  }


type
  filename_type = string[64];

  regtype = record ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
          end;
Var
  s1,s2,s3,s4,
  fsize        : real;

{-----------------------------------------------------------------------------}
{            G  E  T_  F  I  L  E                                             }
{-----------------------------------------------------------------------------}

procedure get_file;

{****************************************************************************}
{                         S T A Y S U B S  .  I N C                          }
{                                                                            }
{   Separate this file into "Staysubs.Inc" to provide Directory routines     }
{       for the Stay-Resident Demo.                                          }
{                                                                            }
{****************************************************************************}


{----------------------------------------------------------------------------}
{                  F I L E         S U B R O U T I N E S                     }
{----------------------------------------------------------------------------}
  type
    Dir_Entry   = record
                      Reserved : array[1..21] of byte;
                      Attribute: byte;
                      Time, Date, FileSizeLo, FileSizeHi : integer;
                      Name : string[13];
                    end;
  var
    RetCode   : byte;
    Filename  : filename_type;
    Buffer    : Dir_Entry;
    Attribute : byte;
{----------------------------------------------------------------------------}
{                S  E  T       Disk  Transfer  Address                       }
{----------------------------------------------------------------------------}
Procedure Disk_Trns_Addr(var Disk_Buf);
var
  Registers : regtype;
Begin
  with Registers do
    begin
      Ax := $1A shl 8;                 { Set disk transfer address to  }
      Ds := seg(Disk_Buf);             { our disk buffer               }
      Dx := ofs(Disk_Buf);
      msdos(Registers);
    end;
end;
{----------------------------------------------------------------------------}
{                  F I N D   N E X T   F I L E   E N T R Y                   }
{----------------------------------------------------------------------------}
Procedure Find_Next(var Att:byte; var Filename : Filename_type;
                                      var Next_RetCode : byte);
var
  Registers  : regtype;
  Carry_flag : integer;
  N          : byte;

Begin  {Find_Next}
  Buffer.Name := '             ';     { Clear result buffer }
  with Registers do
      begin
      Ax := $4F shl 8;                 { Dos Find next function }
      MsDos(Registers);
      Att := Buffer.Attribute;         { Set file attribute     }
      Carry_flag := 1 and Flags;       { Isolate the Error flag }
      Filename := '             ';
      if Carry_flag = 1 then
        Next_RetCode := Ax and $00FF
      else
        begin                          { Move file name         }
        Next_RetCode := 0;
        for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
        s1 := lo(buffer.filesizelo);
        s2 := hi(buffer.filesizelo);
        s3 := lo(buffer.filesizehi);
        s4 := hi(buffer.filesizehi);
        end;
    end;  {with}
end;
{----------------------------------------------------------------------------}
{              F I N D   F I R S T   F I L E   F U N C T I O N               }
{----------------------------------------------------------------------------}
Procedure Find_First (var Att: byte;
                      var Filename: Filename_type;
                      var RetCode_code : byte);

  var
      Registers        :regtype;
      Carry_flag       :integer;
      Mask, N          :byte;

  begin
    Disk_Trns_Addr(buffer);
    Filename[length(Filename) + 1] := chr(0);
    Buffer.Name := '             ';
    with Registers do
      begin
      Ax := $4E shl 8;                  { Dos Find First Function }
      Cx := Att;                        { Attribute of file to fine }
      Ds := seg(Filename);              { Ds:Dx Asciiz string to find }
      Dx := ofs(Filename) + 1;
      MsDos(Registers);
      Att := Buffer.Attribute;          { set the file attribute byte  }

        { If error occured set, Return code. }

        Carry_flag := 1 and Flags;      { If Carry flag, error occured }
                                        { and Ax will contain Return code }
        if Carry_flag = 1 then
          begin
          RetCode_code := Ax and $00FF;
          end

        else
          begin
          RetCode_code := 0;
          Filename := '             ';
          for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
        s1 := lo(buffer.filesizelo);
        s2 := hi(buffer.filesizelo);
        s3 := lo(buffer.filesizehi);
        s4 := hi(buffer.filesizehi);
          end;

      end;  {with}
end;
var
  attribyte,
  OldAttribute : byte;

{----------------------------------------------------------------------------}
begin
     if paramcount = 0 then filename := '*.*';
     if paramcount > 0 then filename := paramstr(1);

     attribyte := 255 ;
     OldAttribute := attribyte;

          Find_First(attribyte,filename,Retcode);
              If Retcode = 0 then
                 begin
                     fsize := fsize + (s1 +(s2*256))+65535.0 *(s3 +(s4*256));
                 end;
          {Now we repeat Find_Next until an error occurs }

              repeat
                Find_Next(attribyte,filename,Retcode);
                if Retcode = 0 then
                 begin
                     fsize := fsize + (s1 +(s2*256))+65535.0 *(s3 +(s4*256));
                 end;
               until Retcode <> 0;
end;

{-----------------------------------------------------------------------------}
{        D   E  M  O                                                          }
{-----------------------------------------------------------------------------}
Procedure howmuch ;                   { Give Demonstration of Code               }

begin
     fsize := 0.0;
     Get_file;
     writeln(fsize:9:0);
end; { Demo }
begin
 howmuch;
end.

Press <CR> to continue: