Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/DIRECTRY.ZIP/DIRECTRY.PAS

Pascal/Delphi Source File | 1986-03-28 | 25.4 KB | 801 lines

{                 *****     Directories From Turbo     *****
Source: PConnecticut BBS 4/13/85
   Written By:  Drew Letcher                                3/23/85
                Iowa Software Associates
                104 Hawkeye Ct.
                Iowa City, IA  52240
                [phone]

modifications by Scott Daniels
 07/02/85 - set up as INClude file vice complete program
            make CheckCommandLine more general - now only gets Tail;
 07/05    - Search spec is now set in another procedure;
 07/19    - quits with msg ('no files found') if Find First yields AX<>0;
           corrected time calculation (was off by 32 mins);
           reversed use of 'Archive' bit to conform with MSDOS use. If set
           (=1), means file has changed and should be saved or 'Archived'.
 10/01    - GetSearchName changes default drive if passed just drive letter
           (eg Directry B:)


   This program gives example routines for accessing the DOS 2.1  directories,
   and  examples  for switching drives and directories in Turbo programs,  for
   reading and setting a files attribute byte,  for  getting  a  disk's  space
   information,  and  for  accessing  the  command  line  when  running  Turbo
   programs.  The file itself is a ready to  compile/run  Turbo  program  that
   gives a directory listing and some disk status information.

   All  these  routines  use the Turbo MSDOS() function which accesses the DOS
   software interrupt  21h,  see  section  B.2.2  in  the  Turbo  manual.  The
   functions used inside this interrupt are as follows:

         get first directory entry               4Eh
         get next directory entry                4Fh
         get the Disk Transfer Address           2Fh
          ( where DOS returns info to you )
         get drive total/free space              36h

         default drive designator                19h
         change default drive                    0Eh

         get current directory                   47h
         make a directory                        39h
         remove a directory                      3Ah
         change directory                        3Bh

         get/set a files attributes              43h


   This  program  has  redundant  declarations  and  does things in a straight
   forward manner so as to  make  these  routines  easily  understandable  and
   transportable  to  your  own  programs.  For  other information see the DOS
   Technical Reference Manual,  or any of the good books availble on  the  DOS
   programmers' level.
}

{.pa}

{PROGRAM  DirectoriesFromTurbo;}
{  ***  set compiler directives  ***  }
{  Appendix E of the TurboPascal manual  }

{$B+}  {  set con/term as standard I/O device  }
{$C+}  {  use of ^C and ^S during standard I/O  }
{$I+}  {  disk I/O error checking  }
{$R-}  {  array index range checking  }
{$V+}  {  type checking of string parameters }
{$U+}  {  user interrupt with ^C  }
{$K+}  {  check stack space for variables during procedure calls }


TYPE
   path           =  string[ 64 ];
   name           =  string[ 13 ];     {eg 12345678.xxx + chr(0)}
   directoryinfo  =  RECORD
                     filename    :  name;
                     size        :  real;
                     time        :  string[ 8 ];
                     date        :  string[ 8 ];
                     attribute   :  string[ 7 ];
                     END;

   memoryaddress  =  ( segment, offset );
   address        =  ARRAY[ memoryaddress ] OF integer;
   directorytype  =  string[ 64 ];
   drivedesignator     =  string[ 2 ];

   tailtype       = string[30];      {# chars for command line}
   string12       = string[12];


const
   Default_SearchName     :  name= '????????.???';

var
   CmdTail        : name;
   DirEntry       :  directoryinfo;
   DirFlag        :  boolean;
   Directory      :  directorytype;
   DirSize,
   TotalSpace,
   FreeSpace      :  real;
   Drive          :  integer;
   SearchName     : name;

{ end Main routine declarations  }
{.pa}


function CheckCommandLine: name;

{  The  commandline is located at CSeg:$0080 and contains everything after the
   program name that you type to invoke a Turbo program,  including the  space
   right  after the program name.  If you want to use the command line save it
   right away.  The maximum length of the command line is 127 characters.  The
   length of the command line is at CSeg:$0080,  and the actual string  starts
   at  CSeg:$0081.  So  a  string  variable  will  automatically be set to the
   length of the line typed in by a user. }

{ search for files matching the filename in the command line, on current drive;
   this routine doesn't check for a path name or expand asteriks.  }

   VAR
      I          :  integer;
      TempLine   :  Tailtype;
      ComLine    :  Tailtype ABSOLUTE CSeg:$0080;
      TempName   :  tailtype;

   BEGIN

      TempLine := ComLine;
{      writeln('1. TAIL >',TempLine,'<');}
      TempName := '';
      WHILE TempLine[1] = ' ' DO        {locate first non-blank}
         Delete(TempLine,1,1);

{      write('2. TAIL >');
      for i:= 1 to length(TempLine) do write(TempLine[i],'=',ord(TempLine[i]),'/');
      writeln('<'); }

      I := 0;
      WHILE (I < length(TempLine)) AND (TempLine[I] <> chr(0))
      { and (TempLine[I] in ['!'..'z'])}   DO
         BEGIN
         I := I + 1;
         TempName := TempName + UpCase(TempLine[I]);
                             {  does grab chr(0) as the last character  }
         END;
{      writeln('TAIL >',TempName,'<');}
      CheckCommandLine := TempName;

   END;  {  **  Procedure CheckCommandLine  **  }
{.pa}


FUNCTION  DefaultDrive  :  drivedesignator;
{ returns the default drive designator.   e.g.  A:  }

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;

   VAR
      Registers  :  registertype;

   BEGIN
   WITH  Registers  DO
      BEGIN
      AX := $19 shl 8;
      MSDOS( Registers );                  { return AX = 0 is drive A, etc. }
      DefaultDrive := Chr( 65 + Lo( AX ) ) + ':';
      END;
   END;  {  **  Function DefaultDrive  **  }


PROCEDURE  ChangeDefaultDrive(  DriveLetter  :  drivedesignator  );
{  parameter can be:  a, A, a:, or A:   where "a" can be any valid
   drive letter.  }

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;

   VAR
      Registers  :  registertype;

   BEGIN
   WITH Registers DO
      BEGIN
      AX := $0E shl 8;
      DX := Ord( UpCase( DriveLetter[ 1 ] ) ) - 65;     {  A: is 0, etc.  }
      MSDOS( Registers );
      IF DX < 0 THEN  writeln( 'Invalid Drive Designator', DriveLetter );
      END;
   END;  {  **  Procedure  ChangeDefaultDrive  **  }
{.pa}


PROCEDURE  GetCurrentDirectory( VAR CurrentDirectory  :  directorytype );
{ gets the path name of the  current  directory,  doesn't  include  the  drive
   designator.  The routine gives DOS a 64 byte location in memory in which to
   store the path. }

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;

   VAR
      Registers  :  registertype;
      I,
      Value,
      CurDirSeg,
      CurDirOfs  :  integer;

   BEGIN

   CurDirSeg := Seg( CurrentDirectory );
   CurDirOfs := Ofs( CurrentDirectory );
   WITH Registers DO
      BEGIN
      AX := $47 shl 8;
      DX := 0;
      DS := CurDirSeg;
      SI := CurDirOfs + 1;
      MSDOS( Registers );
      END;  {  With  }

   CurrentDirectory := '';
   I := 1;
   Value := Mem[ CurDirSeg : CurDirOfs + I ];
   WHILE ( I <= 64 ) AND ( Value > 33 ) AND ( Value < 128 ) DO
      BEGIN
      Mem[ CurDirSeg : CurDirOfs ] := Mem[ CurDirSeg : CurDirOfs ] + 1;
      I := I + 1;
      Value := Mem[ CurDirSeg : CurDirOfs + I ];
      END;
   CurrentDirectory := '\' + CurrentDirectory;
   END;  {  **  Procedure GetCurrentDirectory  **  }
{.pa}


FUNCTION  ChangeDirectory( VAR NewDirectory : directorytype ) : boolean;
{ The directory path can contain the drive on which to change the directory. }

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;

   VAR
      Registers  :  registertype;

   BEGIN
   WITH Registers DO
      BEGIN
      AX := $3B shl 8;
      DS := Seg( NewDirectory );
      DX := Ofs( NewDirectory ) +1;
      MSDOS( Registers );
      IF AX = 5 THEN
         BEGIN
         ChangeDirectory := false;
         writeln( 'Change Directory Failed - Bad Directory Path' );
         END
      ELSE
         ChangeDirectory := true;
      END;  {  With  }
   END;  {  **  Function ChangeDirectory  **  }


{.pa}
FUNCTION  MakeDirectory( VAR NewDirectory : directorytype ) : boolean;
   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;
   VAR
      Registers  :  registertype;

   BEGIN
   WITH Registers DO
      BEGIN
      AX := $39 shl 8;
      DS := Seg( NewDirectory );
      DX := Ofs( NewDirectory ) +1;
      MSDOS( Registers );
      IF AX = 5 THEN
         BEGIN
         MakeDirectory := false;
         writeln( 'Make Directory Failed - Bad or Existing Directory Path' );
         END
      ELSE
         MakeDirectory := true;
      END;  {  With  }
   END;  {  **  Function MakeDirectory **  }


FUNCTION  RemoveDirectory( VAR Directory : directorytype ) : boolean;
   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;
   VAR
      Registers  :  registertype;

   BEGIN
   WITH Registers DO
      BEGIN
      AX := $3A shl 8;
      DS := Seg( Directory );
      DX := Ofs( Directory ) +1;
      MSDOS( Registers );
      IF AX = 5 THEN
         BEGIN
         RemoveDirectory := false;
         writeln( 'Remove Directory Failed - Bad or Non-empty Directory Path' );
         END
      ELSE
         RemoveDirectory := true;
      END;  {  With  }
   END;  {  **  Function RemoveDirectory **  }
{.pa}


PROCEDURE  GetAttrib(      PathName   :  path;      {  full path name  }
                       VAR Attribute  :  integer );

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;

   VAR
      Registers  :  registertype;

   BEGIN
   WITH Registers DO
      BEGIN
      AX := $43 shl 8 + 0;
      DS := Seg( PathName );
      DX := Ofs( PathName ) + 1;
      MSDOS( Registers );
      Attribute := CX;
      END;  {  With  }
   END;  {  **  Procedure GetAttrib  **  }

{  Attribute byte values:
                           0  -  normal read/write
                           1  -  read only
                           2  -  hidden
                           4  -  system file
                           8  -  volume label entry
                          16  -  directory entry
                          32  -  bit = 0 - file has not been changed,
                                     = 1 - file changed, needs to be archived}


PROCEDURE  SetAttrib(  PathName   :  path;      {  full path name  }
                       Attribute  :  integer );

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;

   VAR
      Registers  :  registertype;

   BEGIN
   WITH Registers DO
      BEGIN
      AX := $43 shl 8 + 1;
      DS := Seg( PathName );
      DX := Ofs( PathName ) + 1;
      CX := Attribute;
      MSDOS( Registers );
      IF AX = 3 THEN
         writeln( AX, ' Path Not Found or Attribute Already Set' );
      IF AX = 5 THEN
         writeln( AX, ' Access Denied for File Type' );
      END;  {  With  }
   END;  {  **  Procedure SetAttrib  **  }
{.pa}


FUNCTION   GetDriveSpace(     Drive       : integer;
                          VAR TotalSpace,
                              FreeSpace   : real      ) : boolean;

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;

   VAR
      Registers          :  registertype;
      TotalClusters,
      FreeClusters,
      SectorsPerCluster,
      BytesPerSector     :  real;

   BEGIN
   WITH Registers DO
      BEGIN
      AX := $36 shl 8;
      DX := Drive;
      MSDOS( Registers );
      IF AX = $FFFF THEN
         BEGIN
         GetDriveSpace := false;
         writeln( 'Invalid Drive Designator' );
         END
      ELSE
         BEGIN
         GetDriveSpace := true;
         TotalClusters := DX;
         FreeClusters := BX;
         SectorsPerCluster := AX;
         BytesPerSector := CX;
         TotalSpace := TotalClusters * SectorsPerCluster * BytesPerSector;
         FreeSpace := FreeClusters * SectorsPerCluster * BytesPerSector;
         END;
      END;  {  With  }
   END;  {  **  Function GetDriveSpace  **  }
{.pa}


PROCEDURE  GetDirEntry( VAR SearchName  :  name;
                        VAR DirEntry    :  directoryinfo;
                        VAR DirFlag     :  boolean        );


{  Passes the next directory entry back to the calling routine.  IF DirFlag is
   false Directory will get the first directory entry, if it is true Directory
   will get the next directory entry.  If there are no more directory entries,
   Directory will set the value of DirFlag to false.  Thus,  DirFlag  must  be
   set when calling Directory, and you must check DirFlag upon returning. }

   TYPE
      registertype  =  RECORD
                       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                       END;
      memoryaddress  =  ( segment, offset );
      address        =  ARRAY[ memoryaddress ] OF integer;


   VAR
     registers  :  registertype;


   PROCEDURE  GetDTA( VAR DTA : address );
   {  get  the  Disk  Transfer  Address  where  DOS  will return the directory
      information. }

      TYPE
         registertype  =  RECORD
                          AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                          END;

      VAR
         Registers  :  registertype;

      BEGIN
      WITH Registers DO
         BEGIN
         AX := $2F shl 8;          {Get DTA Address}
         MSDOS( Registers );
         DTA[ segment ] := ES;
         DTA[ offset ] := BX;
         END;
(* no work!      for i:= 0 to 42 do MemW[DTAseg:DTAofs+i]:=0;   {clear out DTA}*)
      END;  {  **  Procedure GetDTA  **  }
{.pa}


   PROCEDURE  GetEntryFromDTA( VAR DirEntry : directoryinfo );

   { GetEntry gets the directory info from the Disk Transfer Area in memory as
      follows:

          DTA address +        Contents
              21                 attribute
              22-23              creation time
              24-25              creation date
              26-27              low bytes file size
              28-29              high bytes file size
              30-42              filename, upto 13 bytes terminated by chr(0)

   }

      VAR
         registers       :  registertype;
         DTA             :  address;
         DTAseg,
         DTAofs,
         I,
         Temp,
         Temp1, Temp2,
         Temp3           :  integer;
         Hour, Min, Sec,
         Month, Day      :  string[ 2 ];
         Year            :  string[ 4 ];

      BEGIN
         GetDTA( DTA );
         DTAseg := DTA[ segment ];
         DTAofs := DTA[ offset ];

         WITH DirEntry DO
            BEGIN
                                                   {  get the attribute byte  }
            attribute := '.......';
            Temp := Mem[ DTAseg : DTAofs + 21 ];
            IF ( Temp AND 223 ) = 0 THEN
            attribute := 'RW.....';                { regular Read/Write }
            IF ( Temp AND 1 ) = 1 THEN
               Insert( 'R', attribute, 1 );           { Read only file }
            IF ( Temp AND 2 ) = 2 THEN
               Insert( 'H', attribute, 3 );           { Hidden file }
            IF ( Temp AND 4 ) = 4 THEN
               Insert( 'S', attribute, 4 );           { System file }
            IF ( Temp AND 8 ) = 8 THEN
               Insert( 'V', attribute, 5 );           { root Volume label }
            IF ( Temp AND 16 ) = 16 THEN
               Insert( 'D', attribute, 6 );           { subDirectory }
            IF ( Temp AND 32 ) = 32 THEN              {was '=0'}
               Insert( 'A', attribute, 7 );           { Archived }
{.pa}
{revised time calcn by SD 7/19/85}               {  get the creation time  }
{NOTE: ref Norton Prog. Guide, pg 118 -
  Time = Hour*2048 + Min*32 + Sec*2 }
            Temp := Mem[ DTAseg : DTAofs + 22 ];   {LSB}
            Temp1 := Mem[DTAseg:DTAofs + 23];      {MSB}
{            writeln('TIME 1st byte=',Temp,'/2nd byte=',Temp1);}
{Min}       Temp2:= Temp shr 5 + 8*(Temp1 AND 7);  {lsb/32 + lower 3 bits of msb}
            str(Temp2,Min);
{Hr}        Temp3:= Temp1 shr 3;    {msb/8 vice *256/2048}
{            writeln('TIME: Temp=',Temp,'/Temp1=',Temp1,'/Temp2=',Temp2,'/Temp3=',Temp3);}
            Str(Temp3,Hour);

          (*original version-incorrect; off by 32 mins
            str( ( Temp shr 3 ):2, Hour );
            Temp := 8 * ( Temp AND 3 );
            Temp := Temp + ( Mem[ DTAseg : DTAofs + 22 ] shr 5 );
            str( Temp, Min );
            Temp := Mem[ DTAseg : DTAofs + 22 ];
            str( ( ( Temp AND 31 ) * 2 ):2, Sec ); *)

            IF Length( Min ) < 2 THEN
               Min := '0' + Min;
            time := Hour + ':' + Min;           { who cares about seconds? }

            {  get the creation date }
            Temp := Mem[ DTAseg : DTAofs + 25 ];    {was 25}
            str( ( 80 + ( Temp shr 1 ) ):2, Year );
            Temp := 8 * ( Temp AND 1 );
            Temp := Temp + ( Mem[ DTAseg : DTAofs + 24 ] shr 5 );
            str( Temp:2, Month );
            Temp := Mem[ DTAseg : DTAofs + 24 ];
            str( ( Temp AND 31 ), Day );
            IF Length( Day ) < 2 THEN
               Day := '0' + Day;
            date := Month + '-' + Day + '-' + Year;

            {  get the filesize }
            size := 0;
            size := Mem[ DTAseg : DTAofs + 26 ];
            size := size + Mem[ DTAseg : DTAofs + 27 ] * 256.0;
            size := size + Mem[ DTAseg : DTAofs + 28 ] * 256.0 * 256.0;
            size := size + Mem[ DTAseg : DTAofs + 29 ] * 256.0 * 256.0 *256.0;

            {  get the filename and store in DirEntry  }
            filename := '';
            I := 30;
            Temp := Mem[ DTAseg : DTAofs + I ];
            WHILE ( I <= 41 ) AND ( Temp <> 0 ) DO
               BEGIN
               filename := filename + chr( Temp );
               I := I + 1;
               Temp := Mem[ DTAseg : DTAofs + I ];
               END;  {  While  }
           END;  {  With  }
      END;   {  ***  Procedure GetEntry  ***  }
{.pa}

   BEGIN   {  *****  Directory Routine  *****  }

      WITH Registers DO
         BEGIN
         IF DirFlag = false THEN      {  get the first directory entry  }
            BEGIN
            DirFlag := true;
            DS := Seg( SearchName );
            DX := Ofs( SearchName ) + 1;
            CX := 31;
            AX := $4E shl 8;
            MSDOS( Registers );       {Find First dir entry --> DTA}
            {writeln('Find First: AX =',AX);}
            IF AX = 0 THEN             {  AX returns 0 as long as there are }
               GetEntryFromDTA( DirEntry )       {  more directory entries. }
            ELSE
               DirFlag := false;       {eg AX=18 if no files found this first time}
            END
         ELSE                          {  else Get the Next directory entry  }
            BEGIN                      {  DOS remembers the last file        }
            AX := $4F shl 8;           {  searched for.                      }
            MSDOS( Registers );
            {writeln('Find Next: AX =',AX);}
            IF AX = 0 THEN             {  AX returns 0 as long as there are }
               GetEntryFromDTA( DirEntry )       {  more directory entries. }
            ELSE
               DirFlag := false;       {AX=18 if no more files are found}
            END;  {  Outer If  }

         END;  {  With Registers  }
   END;  {  ***  Procedure  Directory  ***  }


PROCEDURE  FormatFilename(  VAR  Filename  :  name  );

VAR
   LengthName,
   TrailingBlanks,
   I, J             :  integer;

BEGIN
   LengthName := Length( Filename );
   TrailingBlanks := 12 - LengthName;
   I := 1;
   WHILE ( I < 9 ) AND ( I < LengthName ) DO
      BEGIN
      IF ( FileName[ I ] = '.' ) THEN
         BEGIN
         FOR J := I TO 8 DO
            Insert( ' ', Filename, J );
         I := 9;
         END;
      I := I + 1;
      END;  {  While  }

   FOR I := Length( Filename ) TO 12 DO
      Filename := Filename + ' ';
END;  {  **  Procedure FormatFilename  **  }
{.pa}


{* SD; 10/01/85}
{ note: now does support drive name; does NOT support path}
function GetSearchName(InStrng:name):name;
var
   TempName : name;
   i1,i2,i3,           {counters}
   imax,            {highest posn to replace with '??..'}
   dotpos1,         {position of dot in filename}
   dotpos2          {dot posn in default search string}
   : integer;
   ch : char;
begin
   TempName := ''; {null string}

{*TEST}
(*   write('TEST input filespec: '); readln(InStrng);
   i1:=length(InStrng);
   {writeln('Length = ',i1);}
   for i2 :=1 to i1 do InStrng[i2]:=UpCase(InStrng[i2]); *)

   if (Length(InStrng) = 0) Then
   TempName := Default_SearchName     {default searches for all files}

   else      {eg 'B:'}
   if (Length(InStrng)=2) and (Pos(':',InStrng) >0)  THEN
   begin
     TempName := Default_SearchName;
     if InStrng<>DefaultDrive then ChangeDefaultDrive(InStrng);
   end {if pos}

   else
   begin    { want to replace 'AB?C*.?P*' with 'AB?C????.?P?'+ chr(0) }
      dotpos1 := pos('.',InStrng);
      dotpos2 := pos('.',Default_SearchName);
{      writeln('DOT1=',dotpos1:4,'/DOT2=',dotpos2:4);}

      if dotpos1 = 0 then dotpos1 := length(InStrng) +1;
      i1 := 1; i3 := 1;
      repeat
          {if filename prefix had no wildcards, eg abc.*}
          if (i1 > dotpos1) and (i3<=dotpos2) then i3 := dotpos2 + 1;
          ch := InStrng[i1];
{          write('CH>',ch,'<');}
          if ch <> '*' then TempName := TempName + ch  {eg 'A'}
          else
          begin                   {replace wild cards with ???}
            i2 := i3;
            if i1<=dotpos1 then imax:= dotpos2-1 else
            imax:=length(Default_SearchName);
{            writeln('i2=',i2:4,'/i3=',i3:4);}
            while (i2 <= imax) do
            begin                    {replace * with ??..}
              TempName := TempName + '?';
{              writeln('i2=',i2:4,'>',TempName,'<');}
              i2 := i2 +1;
            end; {while}
            if i1<= dotpos1 then
            begin
              i1 := dotpos1-1;  {skip to char before the dot}
              i3 := dotpos2-1;
            end
            else
            i1 := length(InStrng);   {skip to last char}
          end; {if ch}
          i1 := i1 + 1;
          i3 := i3 + 1;
      until (i1>length(InStrng));
   end; {if len instrng}

   TempName := TempName + chr(0);
   GetSearchName := TempName;
   writeln('Search name >',TempName,'<');
end; {GetSearchName}




{  **  Main routine declarations  **  }

VAR
  NumberFiles    :  integer;
  Attribute      :  integer;
  PathName       :  path;
  DriveLetter   :  drivedesignator;

{  **  end Main routine declarations  **  }

{============ delete following line to run this as a program, vice .INC file}
(*
var driveno: char;
    OldDrive: Drivedesignator;

BEGIN  {  **  Main Routine  **  }
CmdTail := CheckCommandLine;

if cmdTail='' then
begin
  write('Which drive (A-B-C-D) ? ');
  readln(driveno);
  CmdTail:= UpCase(driveno) + ':';
end;

OldDrive := DefaultDrive;    {the drive the program was called from}

writeln('Command tail >',CmdTail,'<');
writeln('Called from drive:',OldDrive);

SearchName := GetSearchName(CmdTail);

DriveLetter := DefaultDrive;
GetCurrentDirectory( Directory );
writeln('Current Directory: ', DriveLetter, Directory );
writeln;

NumberFiles := 0;
DirSize := 0;
DirFlag := false;                  {  get the first directory entry  }

GetDirEntry( SearchName, DirEntry, DirFlag );
{writeln('DIRFLAG=',DirFlag);}

if DirFlag=False then writeln('NO matching files found')

else

begin
  WHILE  DirFlag = true DO
     BEGIN
     WITH DirEntry DO
        BEGIN
          FormatFilename( filename );
          writeln( filename:12, size:10:0, attribute:10, date:12, time:10 );
          IF attribute[ 1 ] = 'R' THEN  NumberFiles := NumberFiles + 1;
          DirSize := DirSize + size;
          GetDirEntry( SearchName, DirEntry, DirFlag );
        END;  {  With  }
  END;  {  While  }
end; {if DirFlag}

{  get drive total / free space   }
Drive := 0;  {  current drive  }
IF GetDriveSpace( Drive, TotalSpace, FreeSpace ) THEN
   BEGIN
   writeln;
   writeln( TotalSpace:8:0, '  Bytes Total Disk Space' );
   writeln( FreeSpace:8:0,  '  Bytes Free' );
   writeln( DirSize:8:0,    '  Bytes This Listing in ',
            NumberFiles:3,  ' Files'                      );
   END;
   ChangeDefaultDrive(OldDrive);
END.
(**)