home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / turbopas / printdir.pas < prev    next >
Pascal/Delphi Source File  |  1994-03-05  |  19KB  |  757 lines
  1. PROGRAM PDIR;
  2. {$R+  $V+  $K+ }
  3. TYPE
  4.    byte4 = ARRAY [1..4] OF BYTE;
  5.    txt   = STRING[255];
  6.  
  7.    ENTRY = RECORD
  8.            filename   :   ARRAY[1..8] OF BYTE;
  9.            ext        :   ARRAY[1..3] OF BYTE;
  10.            attr       :   BYTE;
  11.            reserve    :   ARRAY[1..10] OF BYTE;
  12.            cr_time    :   INTEGER;
  13.            cr_date    :   INTEGER;
  14.            fat_start  :   INTEGER;
  15.            file_size  :   byte4;
  16.            END;
  17.  
  18.    dir_type = ARRAY [1..16] OF entry;
  19.  
  20. TYPE standardarray = ARRAY[1..512] OF STRING[8];
  21. TYPE pointarray    = ARRAY[1..512] OF INTEGER;
  22.  
  23.  
  24. VAR
  25.    fat_fill           :  ARRAY[0..4095] OF BYTE;
  26.    dir                :  dir_type;
  27.    pointer            :  pointarray;
  28.    cluster            :  ARRAY [1..50] OF INTEGER;
  29.    father,son         :  ARRAY [0..50] OF BYTE;
  30.    i,j,k              :  INTEGER;
  31.    hour,min,sec,
  32.    month,day,date     :  BYTE;
  33.    year               :  INTEGER;
  34.    side,track,sector  :  BYTE;
  35.    no_dir             :  INTEGER;
  36.    no_words           :  INTEGER;
  37.    no_entry           :  INTEGER;
  38.    no_lines,no_max    :  INTEGER;
  39.    dir_name           :  ARRAY[1..50] OF STRING[50];
  40.    dir_root           :  STRING[20];
  41.    dir_num,dir_point  :  INTEGER;
  42.    parent             :  INTEGER;
  43.    size               :  REAL;
  44.    drive,cl_size,
  45.    no_sect,
  46.    first_clust,
  47.    no_side            :  BYTE;
  48.    first_dir          :  BYTE;
  49.    no_root            :  REAL;
  50.  
  51.    file_name          :  standardarray;
  52.    ext_name           :  ARRAY [1..512] OF STRING[3];
  53.    fn_time            :  ARRAY [1..512] OF INTEGER;
  54.    fn_date            :  ARRAY [1..512] OF INTEGER;
  55.    fn_size            :  ARRAY [1..512] OF byte4;
  56.  
  57.    vol_id             :  STRING[11];
  58.    one_on,want_border : BOOLEAN;
  59.    want_hidden        : BOOLEAN;
  60.    want_dir           : BOOLEAN;
  61.    want_deleted       : BOOLEAN;
  62.    compressed         : BOOLEAN;
  63.    response           : INTEGER;
  64.    alpha              : STRING[1];
  65.    drive_no           : INTEGER;
  66.    border             : STRING[80];
  67.    top_border         : STRING[80];
  68.    left_border        : STRING[5];
  69.    right_border       : STRING[5];
  70.    side_border        : STRING[1];
  71.    outfil_name        : STRING[20];
  72.    outfil             : TEXT;
  73.    ff,comp,EXP,
  74.    LL8,cancel         : STRING[2];
  75.    short              : STRING[3];
  76.    free_clusters      : INTEGER;
  77.    total_clusters     : INTEGER;
  78.    free_space         : REAL;
  79.    total_size         : REAL;
  80.  
  81. {$i biosread.inc}
  82. {$i getfree.inc}
  83. {$i getdate.inc}
  84.  
  85.  
  86. PROCEDURE getfntime(VAR hour,min,sec :BYTE ; cr_time:INTEGER);
  87. VAR
  88.   scratch  : INTEGER;
  89.  
  90. BEGIN
  91.                scratch := cr_time SHR 5;
  92.                min     := scratch MOD 64;
  93.                hour    := scratch DIV 64;
  94.                sec     := abs(cr_time) MOD 32;
  95.                sec     := sec * 2;
  96. END;
  97.  
  98. PROCEDURE getfndate(VAR year: INTEGER;
  99.                     VAR month,day :BYTE;
  100.                     cr_date:INTEGER);
  101.  
  102. BEGIN
  103.                year := 80 + (cr_date DIV 512);
  104.                month:= (cr_date MOD 512) DIV 32;
  105.                day  := cr_date MOD 32;
  106. END;
  107.  
  108. PROCEDURE getfnsize(VAR size:REAL; file_size:byte4);
  109.  
  110. BEGIN
  111.                size := file_size[1];
  112.                size := size + 256.*file_size[2];
  113.                size := size + 65536.*file_size[3];
  114.                size := size + 256.*65536.*file_size[4];
  115. END;
  116.  
  117. FUNCTION fill_string(char_fill: txt ; no_char:BYTE): txt;
  118.  
  119. VAR
  120.    i         : INTEGER;
  121.    newstring : txt;
  122.  
  123. BEGIN
  124.  
  125.    newstring := '';
  126.  
  127.    FOR i := 1 TO no_char DO
  128.       newstring := CONCAT(newstring,char_fill);
  129.  
  130.    fill_string := newstring;
  131.  
  132. END;
  133.  
  134. FUNCTION concatc(VAR chars; no_char:BYTE): txt;
  135.  
  136. TYPE
  137.    ch_array = ARRAY[1..255] OF BYTE;
  138.  
  139. VAR
  140.    i         : INTEGER;
  141.    newchars  : ch_array ABSOLUTE chars;
  142.    newstring : txt;
  143.  
  144. BEGIN
  145.  
  146.    newstring := '';
  147.  
  148.    FOR i := 1 TO no_char DO
  149.       newstring := CONCAT(newstring,CHR(newchars[i]));
  150.  
  151.    concatc := newstring;
  152.  
  153. END;
  154.  
  155. PROCEDURE read_dir (VAR dir:dir_type;
  156.                     clust1 :INTEGER ; no_cluster:REAL);
  157. VAR
  158.    lend   : BOOLEAN;
  159.    clust : INTEGER;
  160.    fat_cluster,fat_offset   :   INTEGER;
  161.  
  162. BEGIN
  163.  
  164.  
  165.    no_words:= 0;
  166.    clust := clust1;
  167.  
  168.    lend := FALSE;
  169.  
  170.    i := 0;
  171.    WHILE NOT lend DO
  172.    BEGIN
  173.  
  174.       i  :=  i + 1;
  175.  
  176.  
  177.       sector  :=  clust MOD no_sect + 1;
  178.       side    :=  (clust DIV no_sect) MOD no_side;
  179.       track   :=  clust DIV (no_side*no_sect);
  180.  
  181.       biosread(dir[1],drive,side,track,sector,1);
  182.  
  183.  
  184.       FOR j := 1 TO 16  DO
  185.       BEGIN
  186.  
  187.          WITH dir[j] DO
  188.          BEGIN
  189.  
  190.             IF filename[1] = $00 THEN
  191.                lend := TRUE;
  192.             IF (filename[1] <> $00) AND
  193.              ( (filename[1] <> $e5) OR want_deleted ) THEN
  194.             BEGIN
  195.  
  196.  
  197.                IF ( ( (attr AND 2) <> 2) OR want_hidden ) AND
  198.                   ( ( (attr AND 16) <> 16) OR want_dir)   AND
  199.                   ( ( (attr AND 8) <> 8) OR want_dir)
  200.                      THEN
  201.                BEGIN
  202.  
  203.                   no_words  := no_words+1;
  204.                   file_name[no_words] :=concatc(filename,8);
  205.                   ext_name[no_words]  :=concatc(ext,3);
  206.                   fn_time[no_words]   := cr_time;
  207.                   fn_date[no_words]   := cr_date;
  208.                   fn_size[no_words]   := file_size;
  209.  
  210.                END;
  211.  
  212.                IF ( (attr AND 8) = 08) THEN
  213.                BEGIN
  214.                   vol_id := CONCAT( concatc(filename,8) ,
  215.                                     concatc(ext,3)  );
  216.                   WRITE(outfil,left_border,EXP,
  217.                           '  VOLUME NAME IS: ',VOL_ID);
  218.                   IF LENGTH(cancel) <> 0 THEN
  219.                       WRITELN(outfil,cancel,right_border:18)
  220.                   ELSE
  221.                       WRITELN(outfil,right_border:43);
  222.  
  223.                   no_lines  :=  no_lines + 1;
  224.                END;
  225.  
  226.                IF ( (attr AND 16) = 16) AND (CHR(filename[1]) <> '.')
  227.                     AND  ( filename[1] <> $e5 )     THEN
  228.                BEGIN
  229.  
  230.                   dir_num           := dir_num + 1;
  231.                   dir_name[dir_num] := dir_name[parent] +
  232.                                            concatc(filename,8) + '\' ;
  233.                   father[dir_num]   := parent;
  234.  
  235.                   IF son[parent]  = 0 THEN
  236.                      son[parent]    := dir_num;
  237.  
  238.                   cluster[dir_num]  := fat_start*cl_size + first_clust;
  239.  
  240.                END;
  241.             END;   { good entries}
  242.  
  243.  
  244.  
  245.          END;   {all entries}
  246.       END;  {directory loop}
  247.       clust  :=  clust + 1;
  248.       IF  ( i >= (no_cluster*cl_size) ) AND (no_cluster = 1.0) THEN
  249.       BEGIN
  250.            clust1 := (clust1 - first_clust) DIV  cl_size;
  251.            fat_offset := (clust1*3)  DIV 2;
  252.            IF clust1 MOD 2 = 0 THEN
  253.  
  254.               fat_cluster := fat_fill[fat_offset] +
  255.                     ( (fat_fill[fat_offset+1] MOD 16 ) * 256)
  256.  
  257.            ELSE
  258.               fat_cluster := (fat_fill[fat_offset] SHR 4 ) +
  259.                        (fat_fill[fat_offset+1] * 16);
  260.  
  261.            IF fat_cluster > $ff0 THEN
  262.               lend := TRUE
  263.  
  264.            ELSE
  265.            BEGIN
  266.               clust1  := fat_cluster*cl_size + first_clust;
  267.               clust   := clust1;
  268.               i := 0;
  269.            END;
  270.       END;
  271.    END;  {lend}
  272. END; {read_dir}
  273.  
  274.  
  275.  
  276. PROCEDURE SWAP( VAR a,b: INTEGER );
  277. VAR t: INTEGER;
  278. BEGIN
  279.     t := a;
  280.     a := b;
  281.     b := t
  282. END;
  283.  
  284.  
  285. PROCEDURE bsort( start, top: INTEGER;
  286.                  VAR arry: standardarray;
  287.                  VAR pointer: pointarray );
  288. {bubble sort procedure. sorts array from start to top inclusive}
  289. VAR index:    INTEGER;
  290.     switched: BOOLEAN;
  291. BEGIN {bsort}
  292.     REPEAT
  293.          switched := FALSE;
  294.          FOR index := start TO top-1 DO
  295.              BEGIN
  296.                  IF arry[pointer[index]] > arry[pointer[index+1]] THEN
  297.                     BEGIN
  298.                         SWAP( pointer[index] , pointer[index+1] );
  299.                         switched := TRUE;
  300.                     END
  301.              END;
  302.     UNTIL switched = FALSE;
  303. END; {bsort}
  304.  
  305. PROCEDURE findmedian( start, top: INTEGER;
  306.                        VAR arry: standardarray;
  307.                        VAR pointer : pointarray );
  308. {procedure to find a good median value in array and place it}
  309. VAR middle: INTEGER;
  310.     sorted: ARRAY [1..3] OF STRING[8];
  311. BEGIN {findmedian}
  312.     middle    := (start + top) DIV 2;
  313.     sorted[1] := arry[pointer[start]];
  314.     sorted[2] := arry[pointer[top]];
  315.     sorted[3] := arry[pointer[middle]];
  316.  
  317.     IF (sorted[2] > sorted[1]) AND (sorted[2] < sorted[3]) THEN
  318.        SWAP( pointer[start], pointer[middle] )
  319.     ELSE IF (sorted[3] > sorted[1]) AND (sorted[3] < sorted[2])  THEN
  320.        SWAP( pointer[start], pointer[top] );
  321. END; {findmedian}
  322.  
  323. PROCEDURE sortsection( start, top: INTEGER;
  324.                        VAR arry: standardarray;
  325.                        VAR pointer : pointarray);
  326. {procedure to sort a section of the main array, and }
  327. {then divide it into two partitions to be sorted    }
  328. VAR swapup: BOOLEAN;
  329.     s,e,m:  INTEGER;
  330. BEGIN {sortsection}
  331.     IF top - start < 6 THEN {sort small sections with bsort}
  332.        bsort( start, top, arry , pointer )
  333.     ELSE
  334.        BEGIN
  335.            findmedian( start, top, arry , pointer );
  336.            swapup := TRUE;
  337.            {start scanning from array top}
  338.            s := start;  {lower comparison limit}
  339.            e := top;    {upper comparison limit}
  340.            m := start;  {location of comparison value}
  341.            WHILE e > s DO
  342.                BEGIN
  343.                    IF swapup = TRUE THEN
  344.                       {scan downward from partition top}
  345.                       {and exchange if smaller than median}
  346.                       BEGIN
  347.                           WHILE( arry[pointer[e]] >= arry[pointer[m]] )
  348.                                      AND (e > m)  DO
  349.                               e := e - 1;
  350.                           IF e > m THEN
  351.                              BEGIN
  352.                                  SWAP( pointer[e], pointer[m] );
  353.                                  m := e;
  354.                              END;
  355.                           swapup := FALSE;
  356.                       END
  357.                    ELSE
  358.                       {scan upward from a partition start}
  359.                       {and exchange if larger than median}
  360.                       BEGIN
  361.                           WHILE( arry[pointer[s]] <= arry[pointer[m]] )
  362.                                   AND (s < m) DO
  363.                               s := s + 1;
  364.                           IF s < m THEN
  365.                              BEGIN
  366.                                  SWAP( pointer[s], pointer[m] );
  367.                                  m := s;
  368.                              END;
  369.                           swapup := TRUE;
  370.                       END
  371.                END;
  372.                 {sort lower half of partition}
  373.            sortsection( start, m-1, arry , pointer );
  374.                 {sort upper half of partition}
  375.            sortsection( m+1, top, arry , pointer);
  376.            END
  377. END; {sortsection}
  378.  
  379. PROCEDURE sort_dir (VAR file_name:standardarray; no_words:INTEGER);
  380.  
  381. BEGIN {qsort - main program}
  382.  
  383.     FOR i := 1 TO no_words DO
  384.           pointer[i]  := i;
  385.  
  386.  
  387.     sortsection( 1, no_words , file_name , pointer );
  388.  
  389.     no_entry :=  (no_words+1) DIV 2;
  390.  
  391.     IF no_lines + no_entry + 6  >  no_max   THEN
  392.     BEGIN
  393.  
  394.        FOR  i  :=  no_lines TO no_max-1  DO
  395.            IF want_border THEN
  396.               WRITELN(outfil,border);
  397.  
  398.        no_lines  := 0;
  399.        IF want_border  THEN
  400.           WRITELN(outfil,top_border);
  401.        CLRSCR;
  402.        WRITE(outfil,ff);
  403.        IF want_border  THEN
  404.           WRITELN(outfil,top_border);
  405.        END;
  406.  
  407.  
  408.     WRITE(outfil,left_border,' ',EXP);
  409.     WRITE(outfil,'Directory:',dir_name[dir_point],
  410.                  fill_string(' ',26-LENGTH(dir_name[dir_point]) ));
  411.     IF LENGTH(cancel) <> 0 THEN
  412.        WRITELN(outfil,cancel,right_border)
  413.     ELSE
  414.        WRITELN(outfil,right_border:45);
  415.  
  416.     WRITELN(outfil,border);
  417.     WRITELN(outfil,border);
  418.     total_size := 0;
  419.  
  420.        FOR j := 1 TO no_entry  DO
  421.        BEGIN
  422.  
  423.           WRITE(outfil,left_border);
  424.  
  425.           FOR i := 0 TO 1 DO
  426.           BEGIN
  427.  
  428.             IF j+i*no_entry <= no_words THEN
  429.             BEGIN
  430.  
  431.                k := pointer[j+i*no_entry];
  432.  
  433.                getfntime(hour,min,sec,fn_time[k]);
  434.                getfndate(year,month,day,fn_date[k]);
  435.                getfnsize(size,fn_size[k]);
  436.  
  437.                total_size := total_size +
  438.                     (cl_size*512) * INT(  size/(cl_size*512) + 0.99 );
  439.  
  440.                IF (size = 0) AND ( POS('.',file_name[k]) <> 1 ) THEN
  441.                     total_size := total_size + cl_size*512;
  442.  
  443.  
  444.                   WRITE(outfil,file_name[k],'.',
  445.                                ext_name[k]);
  446.  
  447.                   WRITE(outfil,' ',month:2,'/',day:2,'/',year:2,
  448.                        '  ',hour:2,':',(min DIV 10):1,(min MOD 10):1,
  449.                        size:7:0);
  450.  
  451.                IF i = 0 THEN
  452.                   WRITE(outfil,'   ');
  453.  
  454.                END
  455.                ELSE
  456.                   WRITE(outfil,' ':35);
  457.             END;
  458.          WRITELN(outfil,right_border);
  459.          END;
  460.  
  461.    WRITELN(outfil,left_border,' ':38,'TOTAL SIZE: ',' ':15,
  462.                   total_size:8:0,right_border);
  463.  
  464.    WRITELN(outfil,border);
  465.    WRITELN(outfil,border);
  466.    no_lines  := no_lines + no_entry + 6;
  467.  
  468. END; {qsort}
  469.  
  470.  
  471. PROCEDURE setup(drive_no:INTEGER);
  472. BEGIN
  473. comp := CHR(15);
  474. EXP  := CHR(14);
  475. cancel := CHR(20);
  476. ff   := CHR(12);
  477. LL8  := CHR(27)+CHR(48);
  478. short:= CHR(27)+'C'+CHR(44);
  479.  
  480. IF NOT compressed THEN comp := '';
  481. IF (outfil_name  <> 'LPT1:') AND (outfil_name <> 'lpt1:') THEN
  482. BEGIN
  483.    comp := '';
  484.    EXP  := '';
  485.    cancel := '';
  486. {   ff := '';    GO AHEAD AND DO A FORM FEED }
  487.    LL8 := '';
  488.    short := '';
  489.    END;
  490.  
  491.  
  492. IF (cl_size  = 8) AND (drive_no = 3)  THEN
  493. BEGIN
  494.  
  495.        {DOS 2.0/2 SIDE     HARD DISK}
  496.    drive   := $80;          { 80H }
  497.    biosread(fat_fill,drive,0,0,3,8);
  498.    no_sect := 17;           { 17}
  499.    no_root := 4;            {  4}
  500.    no_side := 4;            {  4}
  501.    cl_size := 8;            {  8}
  502.    first_clust := 34;        { 34}
  503.    first_dir   := 18;        { 18}
  504.    END
  505.  
  506. ELSE
  507. BEGIN
  508.    drive   := drive_no-1;
  509.  
  510. {read FAT ...side 0, track 0, sector 2}
  511.  
  512.    biosread(fat_fill,drive,0,0,2,2);
  513.  
  514.    CASE  fat_fill[0] OF
  515.  
  516.    {DOS 2.0/2 SIDE }
  517.    $FD :  BEGIN
  518.       no_sect := 9;
  519.       no_root := 3.5;
  520.       no_side := 2;
  521.       cl_size := 2;
  522.       first_clust := 8;
  523.       first_dir   := 5;
  524.    END;
  525.  
  526.    {DOS 1.1/2 SIDE }
  527.    $FF :  BEGIN
  528.       no_sect := 8;
  529.       no_root := 3.5;
  530.       no_side := 2;
  531.       cl_size := 2;
  532.       first_clust := 7;
  533.       first_dir   := 3;
  534.    END;
  535.  
  536.    {DOS 2.0/1 SIDE }
  537.    $FC :  BEGIN
  538.       no_sect := 9;
  539.       no_root := 2;
  540.       no_side := 1;
  541.       cl_size := 1;
  542.       first_clust := 8;
  543.       first_dir   := 5;
  544.    END;
  545.  
  546.    {DOS 1.1/1 SIDE }
  547.    $FE :  BEGIN
  548.       no_sect := 8;
  549.       no_root := 2;
  550.       no_side := 1;
  551.       cl_size := 1;
  552.       first_clust := 7;
  553.       first_dir   := 3;
  554.    END;
  555.  
  556.    ELSE
  557.    END;
  558. END;
  559.  
  560.  
  561.    one_on  := FALSE;
  562.  
  563.    IF compressed THEN
  564.       WRITE(outfil,comp,LL8,short);
  565.  
  566.    cluster[1]  := first_dir;
  567.  
  568.    dir_name[1] := '\';
  569.    dir_num     := 1;
  570.    parent      := 1;
  571.    dir_point   := 1;
  572.    FOR i := 1 TO 50 DO
  573.       BEGIN
  574.       son[i]      := 0;
  575.       father[i]   := 0;
  576.       END;
  577.  
  578.    no_lines      := 0;
  579.    no_max        := 60;
  580.    IF compressed THEN
  581.       no_max  :=  38;
  582.    side_border   := ' ';
  583.    IF want_border THEN
  584.       BEGIN
  585.       no_max     := no_max-2;
  586.       side_border:= '|';
  587.       END;
  588.  
  589.    border        :=  side_border + fill_string(' ',77) + side_border ;
  590.    left_border   :=  side_border + fill_string(' ',2) ;
  591.    right_border  :=   fill_string(' ',2) + side_border ;
  592.    top_border    :=   fill_string('-',79) ;
  593.  
  594.    IF want_border   THEN
  595.       WRITELN(outfil,top_border);
  596.  
  597.    free_space := free_clusters*(cl_size*512.0);
  598.  
  599.    WRITELN(outfil,left_border,' ':30,'Free: ',free_space:7:0,' ':19,
  600.             month:2,'/',date:2,'/',year:2,'   ',right_border);
  601.  
  602.    no_lines := no_lines + 1;
  603.  
  604. END;
  605.  
  606. PROCEDURE menu(VAR response:INTEGER);
  607. BEGIN
  608.    CLRSCR;
  609.    GOTOXY(10,3);WRITELN('1)  Go');
  610.    GOTOXY(10,7);WRITELN('2)  Change output defaults');
  611.    GOTOXY(10,11);WRITELN('3)  Change file defaults');
  612.    GOTOXY(10,15);WRITELN('4)  Stop');
  613.  
  614.    GOTOXY(1,20);WRITELN('Output defaults:  output to ',outfil_name,
  615.       '  border ',want_border,'   compressed ',compressed);
  616.  
  617.    GOTOXY(1,22);WRITELN('File defaults:  Drive ',drive_no,
  618.       '  show hidden ',want_hidden,'  show deleted ',want_deleted,
  619.       '  show dir ',want_dir);
  620.  
  621.    GOTOXY(15,24);WRITE('Enter option ');READLN(response);
  622.    CLRSCR;
  623.  
  624. END;
  625.  
  626. PROCEDURE display_menu;
  627. BEGIN
  628. CLRSCR;
  629.  
  630.    GOTOXY(1,1);WRITELN('Output defaults:  output to ',outfil_name,
  631.       '  border ',want_border,'   compressed ',compressed);
  632.  
  633.    GOTOXY(5,5)  ; WRITE(' Output to:     ');READLN(outfil_name);
  634.    GOTOXY(5,8)  ; WRITE(' Want border:   ');READLN(alpha);
  635.       IF LENGTH(alpha) <> 0 THEN
  636.             want_border := (alpha = 'y') OR (alpha = 'Y');
  637.    GOTOXY(5,11) ; WRITE(' Compressed:    ');READLN(alpha);
  638.       IF LENGTH(alpha) <> 0 THEN
  639.             compressed := (alpha = 'y') OR (alpha = 'Y');
  640.  
  641.    CLRSCR;
  642.  
  643. END;
  644.  
  645. PROCEDURE file_menu;
  646. BEGIN
  647. CLRSCR;
  648.  
  649.    GOTOXY(1,1);WRITELN('File defaults:  Drive ',drive_no,
  650.       '  show hidden ',want_hidden,'  show deleted ',want_deleted,
  651.       '  show dir ',want_dir);
  652.  
  653.  
  654.    GOTOXY(5,5)  ; WRITE(' Drive:             ');READLN(drive_no);
  655.    GOTOXY(5,8)  ; WRITE(' Show hidden files: ');READLN(alpha);
  656.       IF LENGTH(alpha) <> 0 THEN
  657.             want_hidden := (alpha = 'y') OR (alpha = 'Y');
  658.    GOTOXY(5,11) ; WRITE(' Show deleted files:');READLN(alpha);
  659.       IF LENGTH(alpha) <> 0 THEN
  660.             want_deleted:= (alpha = 'y') OR (alpha = 'Y');
  661.    GOTOXY(5,14) ; WRITE(' Show directories:  ');READLN(alpha);
  662.       IF LENGTH(alpha) <> 0 THEN
  663.             want_dir    := (alpha = 'y') OR (alpha = 'Y');
  664.  
  665.    CLRSCR;
  666.  
  667. END;
  668.  
  669.  
  670.  
  671.  
  672. BEGIN
  673.  
  674. drive_no := 1;
  675. want_border := TRUE;
  676. compressed := TRUE;
  677. want_hidden := TRUE;
  678. want_deleted := FALSE;
  679. want_dir     := FALSE;
  680. outfil_name  := 'LPT1:';
  681.  
  682.  
  683.  
  684. response := 1;
  685. WHILE response <> 4 DO
  686. BEGIN
  687.    menu(response);
  688.    IF response = 2 THEN
  689.       display_menu;
  690.    IF response = 3 THEN
  691.       file_menu;
  692.  
  693.    IF response = 1 THEN
  694.    BEGIN
  695.    ASSIGN(outfil,outfil_name);
  696.    REWRITE(outfil);
  697.    get_free_space(free_clusters,total_clusters,cl_size,drive_no);
  698.    getdate(year,month,date,hour,min) ;
  699.    year := year - 1900;
  700.    setup(drive_no);
  701.  
  702.    read_dir (dir,cluster[1],no_root);
  703.    sort_dir (file_name,no_words);
  704.  
  705.    WHILE parent  <> 0   DO
  706.    BEGIN
  707.  
  708.       IF son[parent] <> 0 THEN
  709.       BEGIN   { step down to son }
  710.  
  711.          dir_point  :=  son[parent];
  712.          parent     :=  dir_point;
  713.  
  714.  
  715.          read_dir (dir,cluster[parent],1.0);
  716.          sort_dir (file_name,no_words);
  717.  
  718.       END   { then begin }
  719.  
  720.       ELSE
  721.       BEGIN
  722.  
  723.          WHILE  (son[parent] = 0) AND (parent <> 0) DO
  724.          BEGIN  { move to next son; or pop to parent }
  725.  
  726.             parent   :=  father[dir_point];
  727.  
  728.             IF  father[dir_point+1]  =  parent  THEN
  729.                 son[parent]   := dir_point + 1
  730.  
  731.             ELSE
  732.  
  733.                 IF parent <> 0 THEN
  734.                      son[parent]  := 0;
  735.  
  736.             dir_point  :=  parent;
  737.  
  738.          END;   { move to next son; or pop to parent }
  739.       END;   { else begin }
  740.    END;   { while parent <> 0 }
  741.  
  742.        FOR  i  :=  no_lines TO no_max-1  DO
  743.            IF want_border THEN
  744.               WRITELN(outfil,border);
  745.  
  746.        no_lines  := 0;
  747.        IF want_border THEN
  748.           WRITELN(outfil,top_border);
  749. {       CLRSCR; }
  750.        WRITE(outfil,ff);
  751.        CLOSE(outfil);
  752.  
  753.    END;
  754. END;
  755.  
  756. end.
  757.