PROGRAM PDIR;
{$R+  $V+  $K+ }
TYPE
   byte4 = ARRAY [1..4] OF BYTE;
   txt   = STRING[255];

   ENTRY = RECORD
           filename   :   ARRAY[1..8] OF BYTE;
           ext        :   ARRAY[1..3] OF BYTE;
           attr       :   BYTE;
           reserve    :   ARRAY[1..10] OF BYTE;
           cr_time    :   INTEGER;
           cr_date    :   INTEGER;
           fat_start  :   INTEGER;
           file_size  :   byte4;
           END;

   dir_type = ARRAY [1..16] OF entry;

TYPE standardarray = ARRAY[1..512] OF STRING[8];
TYPE pointarray    = ARRAY[1..512] OF INTEGER;


VAR
   fat_fill           :  ARRAY[0..4095] OF BYTE;
   dir                :  dir_type;
   pointer            :  pointarray;
   cluster            :  ARRAY [1..50] OF INTEGER;
   father,son         :  ARRAY [0..50] OF BYTE;
   i,j,k              :  INTEGER;
   hour,min,sec,
   month,day,date     :  BYTE;
   year               :  INTEGER;
   side,track,sector  :  BYTE;
   no_dir             :  INTEGER;
   no_words           :  INTEGER;
   no_entry           :  INTEGER;
   no_lines,no_max    :  INTEGER;
   dir_name           :  ARRAY[1..50] OF STRING[50];
   dir_root           :  STRING[20];
   dir_num,dir_point  :  INTEGER;
   parent             :  INTEGER;
   size               :  REAL;
   drive,cl_size,
   no_sect,
   first_clust,
   no_side            :  BYTE;
   first_dir          :  BYTE;
   no_root            :  REAL;

   file_name          :  standardarray;
   ext_name           :  ARRAY [1..512] OF STRING[3];
   fn_time            :  ARRAY [1..512] OF INTEGER;
   fn_date            :  ARRAY [1..512] OF INTEGER;
   fn_size            :  ARRAY [1..512] OF byte4;

   vol_id             :  STRING[11];
   one_on,want_border : BOOLEAN;
   want_hidden        : BOOLEAN;
   want_dir           : BOOLEAN;
   want_deleted       : BOOLEAN;
   compressed         : BOOLEAN;
   response           : INTEGER;
   alpha              : STRING[1];
   drive_no           : INTEGER;
   border             : STRING[80];
   top_border         : STRING[80];
   left_border        : STRING[5];
   right_border       : STRING[5];
   side_border        : STRING[1];
   outfil_name        : STRING[20];
   outfil             : TEXT;
   ff,comp,EXP,
   LL8,cancel         : STRING[2];
   short              : STRING[3];
   free_clusters      : INTEGER;
   total_clusters     : INTEGER;
   free_space         : REAL;
   total_size         : REAL;

{$i biosread.inc}
{$i getfree.inc}
{$i getdate.inc}


PROCEDURE getfntime(VAR hour,min,sec :BYTE ; cr_time:INTEGER);
VAR
  scratch  : INTEGER;

BEGIN
               scratch := cr_time SHR 5;
               min     := scratch MOD 64;
               hour    := scratch DIV 64;
               sec     := abs(cr_time) MOD 32;
               sec     := sec * 2;
END;

PROCEDURE getfndate(VAR year: INTEGER;
                    VAR month,day :BYTE;
                    cr_date:INTEGER);

BEGIN
               year := 80 + (cr_date DIV 512);
               month:= (cr_date MOD 512) DIV 32;
               day  := cr_date MOD 32;
END;

PROCEDURE getfnsize(VAR size:REAL; file_size:byte4);

BEGIN
               size := file_size[1];
               size := size + 256.*file_size[2];
               size := size + 65536.*file_size[3];
               size := size + 256.*65536.*file_size[4];
END;

FUNCTION fill_string(char_fill: txt ; no_char:BYTE): txt;

VAR
   i         : INTEGER;
   newstring : txt;

BEGIN

   newstring := '';

   FOR i := 1 TO no_char DO
      newstring := CONCAT(newstring,char_fill);

   fill_string := newstring;

END;

FUNCTION concatc(VAR chars; no_char:BYTE): txt;

TYPE
   ch_array = ARRAY[1..255] OF BYTE;

VAR
   i         : INTEGER;
   newchars  : ch_array ABSOLUTE chars;
   newstring : txt;

BEGIN

   newstring := '';

   FOR i := 1 TO no_char DO
      newstring := CONCAT(newstring,CHR(newchars[i]));

   concatc := newstring;

END;

PROCEDURE read_dir (VAR dir:dir_type;
                    clust1 :INTEGER ; no_cluster:REAL);
VAR
   lend   : BOOLEAN;
   clust : INTEGER;
   fat_cluster,fat_offset   :   INTEGER;

BEGIN


   no_words:= 0;
   clust := clust1;

   lend := FALSE;

   i := 0;
   WHILE NOT lend DO
   BEGIN

      i  :=  i + 1;


      sector  :=  clust MOD no_sect + 1;
      side    :=  (clust DIV no_sect) MOD no_side;
      track   :=  clust DIV (no_side*no_sect);

      biosread(dir[1],drive,side,track,sector,1);


      FOR j := 1 TO 16  DO
      BEGIN

         WITH dir[j] DO
         BEGIN

            IF filename[1] = $00 THEN
               lend := TRUE;
            IF (filename[1] <> $00) AND
             ( (filename[1] <> $e5) OR want_deleted ) THEN
            BEGIN


               IF ( ( (attr AND 2) <> 2) OR want_hidden ) AND
                  ( ( (attr AND 16) <> 16) OR want_dir)   AND
                  ( ( (attr AND 8) <> 8) OR want_dir)
                     THEN
               BEGIN

                  no_words  := no_words+1;
                  file_name[no_words] :=concatc(filename,8);
                  ext_name[no_words]  :=concatc(ext,3);
                  fn_time[no_words]   := cr_time;
                  fn_date[no_words]   := cr_date;
                  fn_size[no_words]   := file_size;

               END;

               IF ( (attr AND 8) = 08) THEN
               BEGIN
                  vol_id := CONCAT( concatc(filename,8) ,
                                    concatc(ext,3)  );
                  WRITE(outfil,left_border,EXP,
                          '  VOLUME NAME IS: ',VOL_ID);
                  IF LENGTH(cancel) <> 0 THEN
                      WRITELN(outfil,cancel,right_border:18)
                  ELSE
                      WRITELN(outfil,right_border:43);

                  no_lines  :=  no_lines + 1;
               END;

               IF ( (attr AND 16) = 16) AND (CHR(filename[1]) <> '.')
                    AND  ( filename[1] <> $e5 )     THEN
               BEGIN

                  dir_num           := dir_num + 1;
                  dir_name[dir_num] := dir_name[parent] +
                                           concatc(filename,8) + '\' ;
                  father[dir_num]   := parent;

                  IF son[parent]  = 0 THEN
                     son[parent]    := dir_num;

                  cluster[dir_num]  := fat_start*cl_size + first_clust;

               END;
            END;   { good entries}



         END;   {all entries}
      END;  {directory loop}
      clust  :=  clust + 1;
      IF  ( i >= (no_cluster*cl_size) ) AND (no_cluster = 1.0) THEN
      BEGIN
           clust1 := (clust1 - first_clust) DIV  cl_size;
           fat_offset := (clust1*3)  DIV 2;
           IF clust1 MOD 2 = 0 THEN

              fat_cluster := fat_fill[fat_offset] +
                    ( (fat_fill[fat_offset+1] MOD 16 ) * 256)

           ELSE
              fat_cluster := (fat_fill[fat_offset] SHR 4 ) +
                       (fat_fill[fat_offset+1] * 16);

           IF fat_cluster > $ff0 THEN
              lend := TRUE

           ELSE
           BEGIN
              clust1  := fat_cluster*cl_size + first_clust;
              clust   := clust1;
              i := 0;
           END;
      END;
   END;  {lend}
END; {read_dir}



PROCEDURE SWAP( VAR a,b: INTEGER );
VAR t: INTEGER;
BEGIN
    t := a;
    a := b;
    b := t
END;


PROCEDURE bsort( start, top: INTEGER;
                 VAR arry: standardarray;
                 VAR pointer: pointarray );
{bubble sort procedure. sorts array from start to top inclusive}
VAR index:    INTEGER;
    switched: BOOLEAN;
BEGIN {bsort}
    REPEAT
         switched := FALSE;
         FOR index := start TO top-1 DO
             BEGIN
                 IF arry[pointer[index]] > arry[pointer[index+1]] THEN
                    BEGIN
                        SWAP( pointer[index] , pointer[index+1] );
                        switched := TRUE;
                    END
             END;
    UNTIL switched = FALSE;
END; {bsort}

PROCEDURE findmedian( start, top: INTEGER;
                       VAR arry: standardarray;
                       VAR pointer : pointarray );
{procedure to find a good median value in array and place it}
VAR middle: INTEGER;
    sorted: ARRAY [1..3] OF STRING[8];
BEGIN {findmedian}
    middle    := (start + top) DIV 2;
    sorted[1] := arry[pointer[start]];
    sorted[2] := arry[pointer[top]];
    sorted[3] := arry[pointer[middle]];

    IF (sorted[2] > sorted[1]) AND (sorted[2] < sorted[3]) THEN
       SWAP( pointer[start], pointer[middle] )
    ELSE IF (sorted[3] > sorted[1]) AND (sorted[3] < sorted[2])  THEN
       SWAP( pointer[start], pointer[top] );
END; {findmedian}

PROCEDURE sortsection( start, top: INTEGER;
                       VAR arry: standardarray;
                       VAR pointer : pointarray);
{procedure to sort a section of the main array, and }
{then divide it into two partitions to be sorted    }
VAR swapup: BOOLEAN;
    s,e,m:  INTEGER;
BEGIN {sortsection}
    IF top - start < 6 THEN {sort small sections with bsort}
       bsort( start, top, arry , pointer )
    ELSE
       BEGIN
           findmedian( start, top, arry , pointer );
           swapup := TRUE;
           {start scanning from array top}
           s := start;  {lower comparison limit}
           e := top;    {upper comparison limit}
           m := start;  {location of comparison value}
           WHILE e > s DO
               BEGIN
                   IF swapup = TRUE THEN
                      {scan downward from partition top}
                      {and exchange if smaller than median}
                      BEGIN
                          WHILE( arry[pointer[e]] >= arry[pointer[m]] )
                                     AND (e > m)  DO
                              e := e - 1;
                          IF e > m THEN
                             BEGIN
                                 SWAP( pointer[e], pointer[m] );
                                 m := e;
                             END;
                          swapup := FALSE;
                      END
                   ELSE
                      {scan upward from a partition start}
                      {and exchange if larger than median}
                      BEGIN
                          WHILE( arry[pointer[s]] <= arry[pointer[m]] )
                                  AND (s < m) DO
                              s := s + 1;
                          IF s < m THEN
                             BEGIN
                                 SWAP( pointer[s], pointer[m] );
                                 m := s;
                             END;
                          swapup := TRUE;
                      END
               END;
                {sort lower half of partition}
           sortsection( start, m-1, arry , pointer );
                {sort upper half of partition}
           sortsection( m+1, top, arry , pointer);
           END
END; {sortsection}

PROCEDURE sort_dir (VAR file_name:standardarray; no_words:INTEGER);

BEGIN {qsort - main program}

    FOR i := 1 TO no_words DO
          pointer[i]  := i;


    sortsection( 1, no_words , file_name , pointer );

    no_entry :=  (no_words+1) DIV 2;

    IF no_lines + no_entry + 6  >  no_max   THEN
    BEGIN

       FOR  i  :=  no_lines TO no_max-1  DO
           IF want_border THEN
              WRITELN(outfil,border);

       no_lines  := 0;
       IF want_border  THEN
          WRITELN(outfil,top_border);
       CLRSCR;
       WRITE(outfil,ff);
       IF want_border  THEN
          WRITELN(outfil,top_border);
       END;


    WRITE(outfil,left_border,' ',EXP);
    WRITE(outfil,'Directory:',dir_name[dir_point],
                 fill_string(' ',26-LENGTH(dir_name[dir_point]) ));
    IF LENGTH(cancel) <> 0 THEN
       WRITELN(outfil,cancel,right_border)
    ELSE
       WRITELN(outfil,right_border:45);

    WRITELN(outfil,border);
    WRITELN(outfil,border);
    total_size := 0;

       FOR j := 1 TO no_entry  DO
       BEGIN

          WRITE(outfil,left_border);

          FOR i := 0 TO 1 DO
          BEGIN

            IF j+i*no_entry <= no_words THEN
            BEGIN

               k := pointer[j+i*no_entry];

               getfntime(hour,min,sec,fn_time[k]);
               getfndate(year,month,day,fn_date[k]);
               getfnsize(size,fn_size[k]);

               total_size := total_size +
                    (cl_size*512) * INT(  size/(cl_size*512) + 0.99 );

               IF (size = 0) AND ( POS('.',file_name[k]) <> 1 ) THEN
                    total_size := total_size + cl_size*512;


                  WRITE(outfil,file_name[k],'.',
                               ext_name[k]);

                  WRITE(outfil,' ',month:2,'/',day:2,'/',year:2,
                       '  ',hour:2,':',(min DIV 10):1,(min MOD 10):1,
                       size:7:0);

               IF i = 0 THEN
                  WRITE(outfil,'   ');

               END
               ELSE
                  WRITE(outfil,' ':35);
            END;
         WRITELN(outfil,right_border);
         END;

   WRITELN(outfil,left_border,' ':38,'TOTAL SIZE: ',' ':15,
                  total_size:8:0,right_border);

   WRITELN(outfil,border);
   WRITELN(outfil,border);
   no_lines  := no_lines + no_entry + 6;

END; {qsort}


PROCEDURE setup(drive_no:INTEGER);
BEGIN
comp := CHR(15);
EXP  := CHR(14);
cancel := CHR(20);
ff   := CHR(12);
LL8  := CHR(27)+CHR(48);
short:= CHR(27)+'C'+CHR(44);

IF NOT compressed THEN comp := '';
IF (outfil_name  <> 'LPT1:') AND (outfil_name <> 'lpt1:') THEN
BEGIN
   comp := '';
   EXP  := '';
   cancel := '';
{   ff := '';    GO AHEAD AND DO A FORM FEED }
   LL8 := '';
   short := '';
   END;


IF (cl_size  = 8) AND (drive_no = 3)  THEN
BEGIN

       {DOS 2.0/2 SIDE     HARD DISK}
   drive   := $80;          { 80H }
   biosread(fat_fill,drive,0,0,3,8);
   no_sect := 17;           { 17}
   no_root := 4;            {  4}
   no_side := 4;            {  4}
   cl_size := 8;            {  8}
   first_clust := 34;        { 34}
   first_dir   := 18;        { 18}
   END

ELSE
BEGIN
   drive   := drive_no-1;

{read FAT ...side 0, track 0, sector 2}

   biosread(fat_fill,drive,0,0,2,2);

   CASE  fat_fill[0] OF

   {DOS 2.0/2 SIDE }
   $FD :  BEGIN
      no_sect := 9;
      no_root := 3.5;
      no_side := 2;
      cl_size := 2;
      first_clust := 8;
      first_dir   := 5;
   END;

   {DOS 1.1/2 SIDE }
   $FF :  BEGIN
      no_sect := 8;
      no_root := 3.5;
      no_side := 2;
      cl_size := 2;
      first_clust := 7;
      first_dir   := 3;
   END;

   {DOS 2.0/1 SIDE }
   $FC :  BEGIN
      no_sect := 9;
      no_root := 2;
      no_side := 1;
      cl_size := 1;
      first_clust := 8;
      first_dir   := 5;
   END;

   {DOS 1.1/1 SIDE }
   $FE :  BEGIN
      no_sect := 8;
      no_root := 2;
      no_side := 1;
      cl_size := 1;
      first_clust := 7;
      first_dir   := 3;
   END;

   ELSE
   END;
END;


   one_on  := FALSE;

   IF compressed THEN
      WRITE(outfil,comp,LL8,short);

   cluster[1]  := first_dir;

   dir_name[1] := '\';
   dir_num     := 1;
   parent      := 1;
   dir_point   := 1;
   FOR i := 1 TO 50 DO
      BEGIN
      son[i]      := 0;
      father[i]   := 0;
      END;

   no_lines      := 0;
   no_max        := 60;
   IF compressed THEN
      no_max  :=  38;
   side_border   := ' ';
   IF want_border THEN
      BEGIN
      no_max     := no_max-2;
      side_border:= '|';
      END;

   border        :=  side_border + fill_string(' ',77) + side_border ;
   left_border   :=  side_border + fill_string(' ',2) ;
   right_border  :=   fill_string(' ',2) + side_border ;
   top_border    :=   fill_string('-',79) ;

   IF want_border   THEN
      WRITELN(outfil,top_border);

   free_space := free_clusters*(cl_size*512.0);

   WRITELN(outfil,left_border,' ':30,'Free: ',free_space:7:0,' ':19,
            month:2,'/',date:2,'/',year:2,'   ',right_border);

   no_lines := no_lines + 1;

END;

PROCEDURE menu(VAR response:INTEGER);
BEGIN
   CLRSCR;
   GOTOXY(10,3);WRITELN('1)  Go');
   GOTOXY(10,7);WRITELN('2)  Change output defaults');
   GOTOXY(10,11);WRITELN('3)  Change file defaults');
   GOTOXY(10,15);WRITELN('4)  Stop');

   GOTOXY(1,20);WRITELN('Output defaults:  output to ',outfil_name,
      '  border ',want_border,'   compressed ',compressed);

   GOTOXY(1,22);WRITELN('File defaults:  Drive ',drive_no,
      '  show hidden ',want_hidden,'  show deleted ',want_deleted,
      '  show dir ',want_dir);

   GOTOXY(15,24);WRITE('Enter option ');READLN(response);
   CLRSCR;

END;

PROCEDURE display_menu;
BEGIN
CLRSCR;

   GOTOXY(1,1);WRITELN('Output defaults:  output to ',outfil_name,
      '  border ',want_border,'   compressed ',compressed);

   GOTOXY(5,5)  ; WRITE(' Output to:     ');READLN(outfil_name);
   GOTOXY(5,8)  ; WRITE(' Want border:   ');READLN(alpha);
      IF LENGTH(alpha) <> 0 THEN
            want_border := (alpha = 'y') OR (alpha = 'Y');
   GOTOXY(5,11) ; WRITE(' Compressed:    ');READLN(alpha);
      IF LENGTH(alpha) <> 0 THEN
            compressed := (alpha = 'y') OR (alpha = 'Y');

   CLRSCR;

END;

PROCEDURE file_menu;
BEGIN
CLRSCR;

   GOTOXY(1,1);WRITELN('File defaults:  Drive ',drive_no,
      '  show hidden ',want_hidden,'  show deleted ',want_deleted,
      '  show dir ',want_dir);


   GOTOXY(5,5)  ; WRITE(' Drive:             ');READLN(drive_no);
   GOTOXY(5,8)  ; WRITE(' Show hidden files: ');READLN(alpha);
      IF LENGTH(alpha) <> 0 THEN
            want_hidden := (alpha = 'y') OR (alpha = 'Y');
   GOTOXY(5,11) ; WRITE(' Show deleted files:');READLN(alpha);
      IF LENGTH(alpha) <> 0 THEN
            want_deleted:= (alpha = 'y') OR (alpha = 'Y');
   GOTOXY(5,14) ; WRITE(' Show directories:  ');READLN(alpha);
      IF LENGTH(alpha) <> 0 THEN
            want_dir    := (alpha = 'y') OR (alpha = 'Y');

   CLRSCR;

END;




BEGIN

drive_no := 1;
want_border := TRUE;
compressed := TRUE;
want_hidden := TRUE;
want_deleted := FALSE;
want_dir     := FALSE;
outfil_name  := 'LPT1:';



response := 1;
WHILE response <> 4 DO
BEGIN
   menu(response);
   IF response = 2 THEN
      display_menu;
   IF response = 3 THEN
      file_menu;

   IF response = 1 THEN
   BEGIN
   ASSIGN(outfil,outfil_name);
   REWRITE(outfil);
   get_free_space(free_clusters,total_clusters,cl_size,drive_no);
   getdate(year,month,date,hour,min) ;
   year := year - 1900;
   setup(drive_no);

   read_dir (dir,cluster[1],no_root);
   sort_dir (file_name,no_words);

   WHILE parent  <> 0   DO
   BEGIN

      IF son[parent] <> 0 THEN
      BEGIN   { step down to son }

         dir_point  :=  son[parent];
         parent     :=  dir_point;


         read_dir (dir,cluster[parent],1.0);
         sort_dir (file_name,no_words);

      END   { then begin }

      ELSE
      BEGIN

         WHILE  (son[parent] = 0) AND (parent <> 0) DO
         BEGIN  { move to next son; or pop to parent }

            parent   :=  father[dir_point];

            IF  father[dir_point+1]  =  parent  THEN
                son[parent]   := dir_point + 1

            ELSE

                IF parent <> 0 THEN
                     son[parent]  := 0;

            dir_point  :=  parent;

         END;   { move to next son; or pop to parent }
      END;   { else begin }
   END;   { while parent <> 0 }

       FOR  i  :=  no_lines TO no_max-1  DO
           IF want_border THEN
              WRITELN(outfil,border);

       no_lines  := 0;
       IF want_border THEN
          WRITELN(outfil,top_border);
{       CLRSCR; }
       WRITE(outfil,ff);
       CLOSE(outfil);

   END;
END;

end.