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

Pascal/Delphi Source File | 1986-04-10 | 30.6 KB | 1,119 lines

{$V-}
program FileLister;

type

       string12 = string[12];
       string64 = string[64];
       string80 = string[80];

       SizeArray = array[1..2] of integer;

       Fname = array[1..80] of char;

       filename_type = string64;

       CommandString = string[127];

       RegisterSet = record
                       ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
                     end;

       FileArrayType = record
                         FileName  : string[12];
                         Attribute : byte;
                         Time      : integer;
                         Date      : integer;
                         FileSize  : SizeArray;
                       end;

       BinaryTreeType = ^node;

       node = record
                FileName     : string[12];
                Temp         : string[20];
                Attribute    : byte;
                Time         : integer;
                Date         : integer;
                FileSize     : SizeArray;
                LeftSubTree,
                RightSubTree : BinaryTreeType;
              end;

       BinaryDirType = ^node2;

       node2 = record
                 DirectoryName : string[80];
                 LeftDirTree,
                 RightDirTree  : BinaryDirType;
               end;

       DirectoryEntryType = record
                              filler    : array[1..21] of byte;
                              Attribute : byte;
                              FileTime  : integer;
                              FileDate  : integer;
                              FileSize  : SizeArray;
                              FileName  : Fname;
                            end;


var

       P : text;

       todaymonth, todayday, todayyear : string[2];
       printout                        : boolean;

       CompleteListing                 : boolean;
       SortByExtension                 : boolean;
       SortByDate                      : boolean;
       SortBySize                      : boolean;
       SortBackwards                   : boolean;
       NeedPause                       : boolean;
       NeedAll                         : boolean;

       error                           : integer;
       WhatColor                       : integer;

       TreeOfStrings                   : BinaryTreeType;

       FileArray                       : array[1..512] of FileArrayType;

       Buffer                          : CommandString;
       CL                              : CommandString absolute cseg:$80;

       NumberFiles                     : integer;
       DirectorySize                   : real;
       CurrentDrive                    : char;
       CurrentDirectory                : filename_type;
       StartDrive                      : char;
       StartDirectory                  : filename_type;
       CurrentFileSpec                 : string[12];
       CurrentVolumeLabel              : string[12];

       ChangeDrive                     : boolean;
       ChangeDirectory                 : boolean;

       NeedTwoWide                     : boolean;
       NeedFourWide                    : boolean;
       NeedSixWide                     : boolean;



procedure GetToday;
 type regpack = record
                  ax,bx,cx,dx,bp,si,ds,es,flags : integer;
                end;
 var i, j       : integer;
     recpack    : regpack;
     mm, dd, yy : integer;
     month, day : string[2];
     year       : string[4];
begin
  with recpack do
   begin
     ax := $2a shl 8;
   end;

  MsDos(recpack);

  with recpack do
   begin
     str(cx, year);
     str(dx mod 256, day);
     str(dx shr 8, month);
   end;

  todaymonth := month;
  while (length(todaymonth) < 2) do todaymonth := concat('0', todaymonth);

  todayday := day;
  while (length(todayday) < 2) do todayday := concat('0', todayday);

  todayyear := year;
  while (length(todayyear) < 2) do todayyear := concat('0', todayyear);
end;



procedure UpperCase(var temp_str : string80);
 var i : integer;
 begin
   for i := 1 to length(temp_str) do
       temp_str[i] := UpCase(temp_str[i]);
 end;



function StripFileName(FileName : string12) : string12;
 var i : integer;
     s : string12;
 begin
   s := '';
   for i := 1 to length(FileName) do
       if (FileName[i] <> ' ') then
           s := s + FileName[i];
   StripFileName := s;
 end;



function StripFileSize(FileSize : SizeArray) : real;
 var r1, r2 : real;
 begin
   r1 := FileSize[1];
   if (r1 < 0) then r1 := r1 + 65536.0;

   r2 := FileSize[2];
   if (r2 < 0) then r2 := r2 + 65536.0;

   StripFileSize := r2 * 65536.0 + r1;
 end;



procedure PrintDOSDate(Date : integer;
                   WhichWay : integer);
 var month, day : byte;
     year       : integer;
     mm, dd, yy : string[2];
 begin
   year  := 80 + (Date div 512);
   month := (Date mod 512) div 32;
   day   := Date mod 32;

   str(month, mm);    if (month < 10) then mm := '0' + mm;
   str(day, dd);      if (day   < 10) then dd := '0' + dd;
   str(year, yy);

   if (WhichWay = 1) then write(mm,'-',dd,'-',yy)
   else write(P,mm,'-',dd,'-',yy);
 end;



procedure PrintDOSTime(Time : integer;
                   WhichWay : integer);
 var hour, min, sec : byte;
     hh,   mm,  ss  : string[2];
     scratch        : integer;
     AM             : boolean;
 begin
   scratch := (Time shr 5);

   min  := scratch mod 64;
   hour := scratch div 64;
   sec  := (abs(Time) mod 32) * 2;

   str(min, mm);    if (min  < 10) then mm := '0' + mm;
   str(hour, hh);   if (hour < 10) then hh := ' ' + hh;
   str(sec, ss);    if (sec < 10) then ss := '0' + ss;

   if (WhichWay = 1) then write(hh,':',mm,':',ss)
   else write(P,hh,':',mm,':',ss);
 end;



function Disk_Space(drive : char) : real;
 type result = record
                 al,ah,bl,bh,cl,ch,dl,dh : byte;
                 bp,si,di,ds,es,flags    : integer;
               end;
 var  registers : result;
      wholereg : RegisterSet absolute registers;
      clusters,
      sectors,
      bytes    : real;
      nothing  : file;
 begin
   with registers do
    begin
      case drive of
           'a','A' : dl := 1;
           'b','B' : dl := 2;
           'c','C' : dl := 3;
           'd','D' : dl := 4;
           'e','E' : dl := 5;
           'f','F' : dl := 6;
           'g','G' : dl := 7;
           'h','H' : dl := 8;
      end;
      ah := $36;

      MsDos(registers);
    end;

   with wholereg do
    begin
      clusters := bx * 1.0;
      bytes    := cx * 1.0;
      sectors  := ax * 1.0;

      if (ax = $FFFF) then Disk_Space := -1
      else Disk_Space := clusters * bytes * sectors;
    end;
 end;



procedure GetSetDrive(Activity : char;
                     var Drive : char);
 var DriveNum  : byte;
     registers : RegisterSet;
 begin
   Activity := UpCase(Activity);

   case Activity of
        'G' : registers.ax := $19 shl 8;
        'S' : begin
                registers.ax := $E shl 8;
                Drive        := UpCase(Drive);
                registers.dx := ord(Drive) - 65;
              end;
   end;

   MsDos(registers);

   if (Activity = 'G') then
    begin
      DriveNum := registers.ax and $00FF;
      Drive    := chr(DriveNum + 65);
    end;
 end;



procedure GetSetDirectory(Activity : char;
                         var Drive : char;
                     var Directory : filename_type;
                         var error : integer);
 var done      : boolean;
     i         : integer;
     temp      : string80;
     registers : RegisterSet;
 begin
   Activity := UpCase(Activity);

   with registers do
    begin
      case Activity of
           'G' : begin
                   dx := ord(UpCase(Drive)) - 64;
                   ds := seg(Directory);
                   si := ofs(Directory) + 1;
                   ax := $47 shl 8;
                 end;
           'S' : begin
                   Directory[length(Directory) + 1] := #0;

                   ds := seg(Directory);
                   dx := ofs(Directory) + 1;
                   ax := $3B shl 8;
                 end;
      end;

      MsDos(registers);

      if (flags and 1 = 1) then error := ax and $00FF
      else
       begin
         error := 0;

         if (Activity = 'G') then
          begin
            done := FALSE;
            temp := '';
            i    := 1;

            while not done do
             begin
               if (Directory[i] <> #0) then
                begin
                  temp := temp + UpCase(Directory[i]);
                  i    := succ(i);
                end
               else done := TRUE;
             end;

            Directory := '\' + temp;
          end;
       end;
    end;
 end;



procedure InsertTree(var Tree : BinaryTreeType;
                         Name : string12;
                         Attr : byte;
                         Time : integer;
                         Date : integer;
                         Size : SizeArray);
 var NewItem : BinaryTreeType;
     Temp_Name : string12;
 begin
   if SortByExtension then
    begin
      if (pos('.',Name) = 0) then Temp_Name := ''
      else Temp_Name := copy(Name, pos('.', Name) + 1, length(Name) - pos('.', Name));

      while (length(Temp_Name) < 3) do
       begin
         if (Attr = 16) then Temp_Name := Temp_Name + chr(1)
         else Temp_Name := Temp_Name + ' ';
       end;

      if (pos('.', Name) = 0) then Temp_Name := Temp_Name + Name
      else Temp_Name := Temp_Name + '.' + copy(Name, 1, pos('.', Name) - 1);
    end
   else if SortByDate then
    begin
      str(Date:4, Temp_Name);
      Temp_Name := Temp_Name + Name;
    end
   else if SortBySize then
    begin
      str(StripFileSize(Size):7:0, Temp_Name);
      Temp_Name := Temp_Name + Name;
    end
   else Temp_Name := Name;

   if (Tree = nil) then
    begin
      New(NewItem);

      NewItem^.FileName     := Name;
      NewItem^.Temp         := Temp_Name;
      NewItem^.Attribute    := Attr;
      NewItem^.Time         := Time;
      NewItem^.Date         := Date;
      NewItem^.FileSize[1]  := Size[1];
      NewItem^.FileSize[2]  := Size[2];
      NewItem^.LeftSubtree  := nil;
      NewItem^.RightSubtree := nil;

      Tree := NewItem;
    end
   else if SortBackwards then
    begin
      if (Temp_Name > Tree^.Temp) then
           InsertTree(Tree^.LeftSubTree,  Name, Attr, Time, Date, Size)
      else InsertTree(Tree^.RightSubtree, Name, Attr, Time, Date, Size);
    end
   else
    begin
      if (Temp_Name < Tree^.Temp) then
           InsertTree(Tree^.LeftSubTree,  Name, Attr, Time, Date, Size)
      else InsertTree(Tree^.RightSubtree, Name, Attr, Time, Date, Size);
    end;
 end;



procedure ReadDirectory(pattern : string12);
 const Directory = $10;
       carry     = 1;
 var dta      : DirectoryEntryType;
     param    : RegisterSet;
     s_string : string[70];
     Size     : real;
     dta_save : array[1..2] of integer;

 function pack_name(var a1; size : integer) : string80;
  var i : integer;
      b : string80;
      a : array[1..1000] of char absolute a1;
 begin
   i := 1;
   b := '';

   while (a[i] <> chr(0)) and (i <= 12) do
    begin
      b := b + a[i];
      i := succ(i);
    end;

   pack_name := b;
 end;

 begin
   with param, dta do
    begin
      TreeOfStrings := nil;
      NumberFiles   := 0;
      DirectorySize := 0;

      pattern := pattern + chr(0);

      ax := $2F00;

      MsDos(param);

      dta_save[1] := es;
      dta_save[2] := bx;

      ax := $1A00;
      ds := seg(dta);
      dx := ofs(dta);

      MsDos(param);

      ds := seg(pattern[1]);
      dx := ofs(pattern[1]);
      ax := $4E00;
      cx := $FF;

      MsDos(param);

      while ((flags and carry) = 0) do
       begin
         s_string := pack_name(FileName, SizeOf(FileName));

         if (s_string <> '.') and
            (s_string <> '..') and
            (s_string <> '') and
            (Attribute <> 8) then
             begin
               if (pos('.', s_string) in [1..9]) then
                begin
                  while (pos('.', s_string) < 9) do
                         insert(' ', s_string, pos('.',s_string));
                end;

               if (Attribute <> 40) then
                   if NeedAll or (Attribute <> 16) then
                    begin
                      InsertTree(TreeOfStrings, s_string, Attribute,
                                 FileTime, FileDate, FileSize);

                      NumberFiles := succ(NumberFiles);

                      DirectorySize := DirectorySize + StripFileSize(FileSize);
                    end;

             end;

         ax := $4F00;

         MsDos(param);
       end;
    end;
 end;



procedure MakeDirectory;
 var i, kntr : integer;
     Size    : real;
     r1, r2  : real;
     temp    : string80;
     temp1   : string80;

 procedure MakeTreeArray(Tree : BinaryTreeType);
  begin
    if (Tree <> nil) then
     begin
       MakeTreeArray(Tree^.LeftSubTree);

       kntr := succ(kntr);

       FileArray[kntr].FileName  := Tree^.FileName;
       FileArray[kntr].Attribute := Tree^.Attribute;
       FileArray[kntr].Time      := Tree^.Time;
       FileArray[kntr].Date      := Tree^.Date;
       FileArray[kntr].FileSize  := Tree^.FileSize;

       MakeTreeArray(Tree^.RightSubTree);
     end;
  end;

 procedure DisposeAll(var Tree : BinaryTreeType);
  begin
    if (Tree <> nil) then
     begin
       DisposeAll(Tree^.LeftSubTree);
       Dispose(Tree);
       DisposeAll(Tree^.RightSubTree);
     end;
  end;

 begin
   kntr := 0;

   MakeTreeArray(TreeOfStrings);
   DisposeAll(TreeOfStrings);
 end;



procedure DoDirectoryPrint;
 var i, MidPoint  : integer;
     line_num     : integer;
     scr_line_num : integer;
     inchar       : char;

 procedure TopOfPage(FirstTime : boolean);
  begin
    if FirstTime then
     begin
       ClrScr;

       writeln('Directory of:  ',CurrentDrive,':',CurrentDirectory,
                '':(54 - length(CurrentDirectory)),
                todaymonth,'/',todayday,'/',todayyear);

       writeln;

       writeln('     OPTIONS:  /All /Pause /Write             SORT:  /Size /Date /eXt /Back');

       Window(1,6,80,23);

       writeln;

       if NeedTwoWide then
            writeln('FileSpec.Ext   Bytes     Time     Date   ',
                    'FileSpec.Ext   Bytes     Time     Date')
       else if NeedFourWide then
            writeln('FileSpec.Ext  Bytes FileSpec.Ext  Bytes ',
                    'FileSpec.Ext  Bytes FileSpec.Ext  Bytes')
       else writeln('FileSpec.Ext FileSpec.Ext FileSpec.Ext ',
                    'FileSpec.Ext FileSpec.Ext FileSpec.Ext');
     end;

    if printout then
     begin
       writeln(P,'Directory of:  ',CurrentDrive,':',CurrentDirectory,
                  '':(54 - length(CurrentDirectory)),
                  todaymonth,'/',todayday,'/',todayyear);

       writeln(P);

       writeln(P,'        /All /Complete /Pause /Write    /4 /6    /Size /Date /eXt /Back');

       writeln(P);

       if NeedTwoWide then
            writeln(P,'FileSpec.Ext   Bytes     Time     Date   ',
                      'FileSpec.Ext   Bytes     Time     Date')
       else if NeedFourWide then
            writeln(P,'FileSpec.Ext  Bytes FileSpec.Ext  Bytes ',
                      'FileSpec.Ext  Bytes FileSpec.Ext  Bytes')
       else writeln(P,'FileSpec.Ext FileSpec.Ext FileSpec.Ext ',
                      'FileSpec.Ext FileSpec.Ext FileSpec.Ext');
     end;

    line_num := 0;
  end;

 procedure TwoWide;
  begin
    write(FileArray[i].FileName,'':(13-length(FileArray[i].FileName)));

    if printout then
       write(P,FileArray[i].FileName,'':(13-length(FileArray[i].FileName)));

    if (FileArray[i].Attribute = 16) then
     begin
       write('  <DIR> ');
       if printout then write(P,'  <DIR> ');
     end
    else
     begin
       write(StripFileSize(FileArray[i].FileSize):7:0,' ');
       if printout then
          write(P,StripFileSize(FileArray[i].FileSize):7:0,' ');
     end;

    PrintDOSTime(FileArray[i].Time, 1);
    write(' ');
    PrintDOSDate(FileArray[i].Date, 1);

    if printout then
     begin
       PrintDOSTime(FileArray[i].Time, 2);
       write(P,' ');
       PrintDOSDate(FileArray[i].Date, 2);
     end;

    if ((i + MidPoint) <= NumberFiles) then
     begin
       write('   ');
       write(FileArray[i+MidPoint].FileName,
             '':(13-length(FileArray[i+MidPoint].FileName)));
       if (FileArray[i+MidPoint].Attribute = 16) then
            write('  <DIR> ')
       else write(StripFileSize(FileArray[i+MidPoint].FileSize):7:0,' ');

       PrintDOSTime(FileArray[i+MidPoint].Time, 1);
       write(' ');
       PrintDOSDate(FileArray[i].Date, 1);

       if printout then
        begin
          write(P,'   ');
          write(P,FileArray[i+MidPoint].FileName,
                  '':(13-length(FileArray[i+MidPoint].FileName)));
          if (FileArray[i+MidPoint].Attribute = 16) then
               write(P,'  <DIR> ')
          else write(P,StripFileSize(FileArray[i+MidPoint].FileSize):7:0,' ');

          PrintDOSTime(FileArray[i+MidPoint].Time, 2);
          write(P,' ');
          PrintDOSDate(FileArray[i].Date, 2);
        end;
     end;

  end;

 procedure FourWide;
  begin
    write(FileArray[i].FileName,'':(12-length(FIleArray[i].FileName)));

    if printout then
       write(P,FileArray[i].FileName,'':(12-length(FIleArray[i].FileName)));

    if (FileArray[i].Attribute = 16) then
     begin
       write('  <DIR> ');
       if printout then write(P,'  <DIR> ');
     end
    else
     begin
       write(StripFileSize(FileArray[i].FileSize):7:0,' ');
       if printout then
          write(P,StripFileSize(FileArray[i].FileSize):7:0,' ');
     end;

    if ((i + MidPoint) <= NumberFiles) then
     begin
       write(FileArray[i+MidPoint].FileName,
             '':(12-length(FileArray[i+MidPoint].FileName)));
       if (FileArray[i+MidPoint].Attribute = 16) then
           write('  <DIR> ')
       else write(StripFileSize(FileArray[i+MidPoint].FileSize):7:0,' ');

       if printout then
        begin
          write(P,FileArray[i+MidPoint].FileName,
                  '':(12-length(FileArray[i+MidPoint].FileName)));
          if (FileArray[i+MidPoint].Attribute = 16) then
               write(P,'  <DIR> ')
          else write(P,StripFileSize(FileArray[i+MidPoint].FileSize):7:0,' ');
        end;
     end;

    if ((i + (2*MidPoint)) <= NumberFiles) then
     begin
       write(FileArray[i+(2*MidPoint)].FileName,
             '':(12-length(FileArray[i+(2*MidPoint)].FileName)));
       if (FileArray[i+(2*MidPoint)].Attribute = 16) then
           write('  <DIR> ')
       else write(StripFileSize(FileArray[i+(2*MidPoint)].FileSize):7:0,' ');

       if printout then
        begin
          write(P,FileArray[i+(2*MidPoint)].FileName,
                  '':(12-length(FileArray[i+(2*MidPoint)].FileName)));
          if (FileArray[i+(2*MidPoint)].Attribute = 16) then
               write(P,'  <DIR> ')
          else write(P,StripFileSize(FileArray[i+(2*MidPoint)].FileSize):7:0,' ');
        end;
     end;

    if ((i + (3*MidPoint)) <= NumberFiles) then
     begin
       write(FileArray[i+(3*MidPoint)].FileName,
             '':(12-length(FileArray[i+(3*MidPoint)].FileName)));
       if (FileArray[i+(3*MidPoint)].Attribute = 16) then
           write('  <DIR>')
       else write(StripFileSize(FileArray[i+(3*MidPoint)].FileSize):7:0);

       if printout then
        begin
          write(P,FileArray[i+(3*MidPoint)].FileName,
                  '':(12-length(FileArray[i+(3*MidPoint)].FileName)));
          if (FileArray[i+(3*MidPoint)].Attribute = 16) then
               write(P,'  <DIR>')
          else write(P,StripFileSize(FileArray[i+(3*MidPoint)].FileSize):7:0);
        end;
     end;
  end;

 procedure SixWide;
  begin
    write(FileArray[i].FileName,'':(12 - length(FileArray[i].FileName)));

    if printout then
       write(P,FileArray[i].FileName,'':(12 - length(FileArray[i].FileName)));

    if ((i + MidPoint) <= NumberFiles) then
     begin
       write(' ',FileArray[i + MidPoint].FileName,
              '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 1))].FileName)));

       if printout then
          write(P,' ',FileArray[i + MidPoint].FileName,
                  '':(12-length(FileArray[i + MidPoint].FileName)));
     end;


    if ((i + (2*MidPoint)) <= NumberFiles) then
     begin
       write(' ',FileArray[i + (2*MidPoint)].FileName,
              '':(12-length(FileArray[i + (2*MidPoint)].FileName)));

       if printout then
          write(P,' ',FileArray[i + (2*MidPoint)].FileName,
                  '':(12-length(FileArray[i + (2*MidPoint)].FileName)));
     end;


    if ((i + (3*MidPoint)) <= NumberFiles) then
     begin
       write(' ',FileArray[i + (3*MidPoint)].FileName,
              '':(12-length(FileArray[i + (3*MidPoint)].FileName)));

       if printout then
          write(P,' ',FileArray[i + (3*MidPoint)].FileName,
                  '':(12-length(FileArray[i + (3*MidPoint)].FileName)));
     end;


    if ((i + (4*MidPoint)) <= NumberFiles) then
     begin
       write(' ',FileArray[i + (4*MidPoint)].FileName,
              '':(12-length(FileArray[i + (4*MidPoint)].FileName)));

       if printout then
          write(P,' ',FileArray[i + (4*MidPoint)].FileName,
                  '':(12-length(FileArray[i + (4*MidPoint)].FileName)));
     end;


    if ((i + (5*MidPoint)) <= NumberFiles) then
     begin
       write(' ',FileArray[i + (5*MidPoint)].FileName,
              '':(12-length(FileArray[i + (5*MidPoint)].FileName)));

       if printout then
          write(P,' ',FileArray[i + (5*MidPoint)].FileName,
                  '':(12-length(FileArray[i + (5*MidPoint)].FileName)));
     end;

(*
    if ((i + (NumberFiles mod 6) + ((NumberFiles div 6) * 1)) <= NumberFiles) then
     begin
       write(' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 1))].FileName,
              '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 1))].FileName)));

       if printout then
          write(P,' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 1))].FileName,
                  '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 1))].FileName)));
     end;


    if ((i + (NumberFiles mod 6) + ((NumberFiles div 6) * 2)) <= NumberFiles) then
     begin
       write(' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 2))].FileName,
              '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 2))].FileName)));

       if printout then
          write(P,' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 2))].FileName,
                  '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 2))].FileName)));
     end;


    if ((i + (NumberFiles mod 6) + ((NumberFiles div 6) * 3)) <= NumberFiles) then
     begin
       write(' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 3))].FileName,
              '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 3))].FileName)));

       if printout then
          write(P,' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 3))].FileName,
                  '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 3))].FileName)));
     end;


    if ((i + (NumberFiles mod 6) + ((NumberFiles div 6) * 4)) <= NumberFiles) then
     begin
       write(' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 4))].FileName,
              '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 4))].FileName)));

       if printout then
          write(P,' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 4))].FileName,
                  '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 4))].FileName)));
     end;


    if ((i + (NumberFiles mod 6) + ((NumberFiles div 6) * 5)) <= NumberFiles) then
     begin
       write(' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 5))].FileName,
              '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 5))].FileName)));

       if printout then
          write(P,' ',FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 5))].FileName,
                  '':(12-length(FileArray[(i + (NumberFiles mod 6) + ((NumberFiles div 6) * 5))].FileName)));
     end;
*)
  end;


 begin
   if      NeedTwoWide  then MidPoint := NumberFiles div 2
   else if NeedFourWide then MidPoint := NumberFiles div 4
   else                      MidPoint := NumberFiles div 6;

   scr_line_num := 0;

   if NeedTwoWide and odd(NumberFiles) then
        MidPoint := succ(MidPoint)
   else if NeedFourWide and (NumberFiles mod 4 > 0) then
        MidPoint := succ(MidPoint)
   else if NeedSixWide and (NumberFiles mod 6 > 0) then
        MidPoint := succ(MidPoint);

   TopOfPage(TRUE);

   for i := 1 to MidPoint do
    begin

      if NeedPause then
       begin
         scr_line_num := succ(scr_line_num);
         if (scr_line_num = 18) then
          begin
            write('Press any key to continue ... ');
            read(kbd, inchar);
            writeln;
            scr_line_num := 1;
          end;
       end;

      if printout then
       begin
         line_num := succ(line_num);
         if (line_num > 50) then
          begin
            writeln(P,chr(12));
            TopOfPage(FALSE);
          end;
       end;

      if      NeedTwoWide  then TwoWide
      else if NeedFourWide then FourWide
      else if NeedSixWide  then SixWide;

      writeln;
      if printout then writeln(P);
    end;

   writeln;
   if printout then writeln(P);

   writeln(DirectorySize:8:0,' Bytes in ',NumberFiles,' File(s);  ',
           Disk_Space(CurrentDrive):0:0,' bytes free...');

   if printout then
      writeln(P,DirectorySize:8:0,' Bytes in ',NumberFiles,' File(s);  ',
                Disk_Space(CurrentDrive):0:0,' bytes free...');
 end;



procedure StripBuffer;
 begin
   UpperCase(Buffer);

   if (pos('/', Buffer) <> 0) then
    begin
      if (pos('/A', Buffer) <> 0) then
       begin
         NeedAll := TRUE;
         Delete(Buffer, pos('/A', Buffer), 2);
       end;

      if (pos('/4', Buffer) <> 0) then
       begin
         NeedTwoWide := FALSE;
         NeedFourWide := TRUE;
         Delete(Buffer, pos('/4', Buffer), 2);
       end;

      if (pos('/6', Buffer) <> 0) then
       begin
         NeedTwoWide := FALSE;
         NeedSixWide := TRUE;
         Delete(Buffer, pos('/6', Buffer), 2);
       end;

      if (pos('B', Buffer) <> 0) then
       begin
         SortBackwards := TRUE;
         Delete(Buffer, pos('/B', Buffer), 2);
       end;

      if (pos('/C', Buffer) <> 0) then
       begin
         ClrScr;
         CompleteListing := TRUE;
         Delete(Buffer, pos('/C', Buffer), 2);
       end;

      if (pos('/W', Buffer) <> 0) then
       begin
         printout := TRUE;
         Delete(Buffer, pos('/W', Buffer), 2);
       end;

      if (pos('/P', Buffer) <> 0) then
       begin
         NeedPause := FALSE;
         Delete(Buffer, pos('/P', Buffer), 2);
       end;

      if (pos('/D', Buffer) <> 0) then
       begin
         SortByDate := TRUE;
         Delete(Buffer, pos('/D', Buffer), 2);
       end;

      if (pos('/X', Buffer) <> 0) then
       begin
         SortByExtension := TRUE;
         Delete(Buffer, pos('/X', Buffer), 2);
       end;

      if (pos('/S', Buffer) <> 0) then
       begin
         SortBySize := TRUE;
         Delete(Buffer, pos('/S', Buffer), 2);
       end;
    end;

   if (pos(':', Buffer) <> 0) then
    begin
      ChangeDrive := TRUE;

      CurrentDrive := copy(Buffer, pos(':', Buffer) - 1, 1);
      GetSetDrive('S', CurrentDrive);

      Delete(Buffer, pos(':', Buffer) - 1, 2);

      GetSetDirectory('G', CurrentDrive, CurrentDirectory, error);
    end;

   if (pos('\', Buffer) <> 0) then
    begin
      ChangeDirectory := TRUE;

      while (pos(' ', Buffer) <> 0) do
             Delete(Buffer, pos(' ', Buffer), 1);

      CurrentDirectory := copy(Buffer, 1, pos('\', Buffer));
      Delete(Buffer, 1, pos('\', Buffer));

      while (pos('\', Buffer) <> 0) do
       begin
         CurrentDirectory := CurrentDirectory +
                             copy(Buffer, 1, pos('\', Buffer));
         Delete(Buffer, 1, pos('\', Buffer));
       end;

      if (CurrentDirectory[length(CurrentDirectory)] = '\') then
          Delete(CurrentDirectory, length(CurrentDirectory), 1);

      GetSetDirectory('S', CurrentDrive, CurrentDirectory, error);
    end;

   if (Buffer <> '') then
    begin
      while (pos(' ', Buffer) <> 0) do
             Delete(Buffer, pos(' ', Buffer), 1);

      if (Buffer <> '') then CurrentFileSpec := Buffer;
    end;
 end;



function GetScrAttribute : byte;
 type result = record
                 AL,AH,BL,BH,CL,CH,DL,DH : Byte;
                 BP,SI,DI,DS,ES,Flags    : Integer;
               end;
 var registers : result;
 begin
   with registers do
    begin
      BH := 0;
      AH := 8;
      Intr($10, registers);
      GetScrAttribute := AH;
    end;
 end;



begin
  WhatColor := GetScrAttribute;

  TextBackground(WhatColor div 16);
  TextColor(WhatColor mod 16);

  GetToday;

  CurrentFileSpec := '*.*';

  SortByDate      := FALSE;
  SortByExtension := FALSE;
  SortBySize      := FALSE;
  SortBackwards   := FALSE;
  CompleteListing := FALSE;
  NeedPause       := TRUE;
  NeedAll         := FALSE;

  ChangeDrive     := FALSE;
  ChangeDirectory := FALSE;

  NeedTwoWide     := TRUE;
  NeedFourWide    := FALSE;
  NeedSixWide     := FALSE;

  GetSetDrive('G', CurrentDrive);
  GetSetDirectory('G', CurrentDrive, CurrentDirectory, error);

  StartDrive      := CurrentDrive;
  StartDirectory  := CurrentDirectory;

  printout := FALSE;

  Buffer := CL;

  if (Buffer <> '') then StripBuffer;

  if printout then
   begin
     Assign(P,'prn');
     rewrite(P);
   end;

  ReadDirectory(CurrentFileSpec);
  MakeDirectory;
  DoDirectoryPrint;

  if printout then
   begin
     writeln(P,chr(12));
     close(P);
   end;

  if ChangeDrive or ChangeDirectory then
   begin
     GetSetDrive('S', StartDrive);
     GetSetDirectory('S', StartDrive, StartDirectory, error);
   end;

end.