home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBCAT.ZIP / PIBCAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-30  |  39.8 KB  |  989 lines
  1. (*$V-,G64,P128,R-,K-,C-,U-*)
  2. PROGRAM PibCat;
  3.  
  4. (*----------------------------------------------------------------------*)
  5. (*                                                                      *)
  6. (*    Program: PIBCAT --- Catalog files on a disk.                      *)
  7. (*                                                                      *)
  8. (*    Author:  Philip R. Burns.                                         *)
  9. (*                                                                      *)
  10. (*    Version: 1.1    January 30, 1987.                                 *)
  11. (*                                                                      *)
  12. (*    Usage:                                                            *)
  13. (*           PIBCAT v /f=filespec /i=indent /m=margin /n                *)
  14. (*                    /o=filename /p=pagesize /x                        *)
  15. (*                                                                      *)
  16. (*            v               volume (drive letter) to catalog          *)
  17. (*                            (default is current drive)                *)
  18. (*                            If given as ?, this text is displayed.    *)
  19. (*            /e=filespec     DOS file spec to match when listing       *)
  20. (*                            entries in .ARC/.LBR files (default is    *)
  21. (*                            *.* -- list all entries).                 *)
  22. (*            /f=filespec     DOS file spec to match when listing files *)
  23. (*                            (default is *.* -- list all files)        *)
  24. (*            /i=indent       # columns to space for .ARC/.LBR entries  *)
  25. (*                            (default is 0)                            *)
  26. (*            /m=margin       left margin to leave (default is 0)       *)
  27. (*            /n              expand .ARC/.LBR after main catalog       *)
  28. (*                            listing rather than immediately after     *)
  29. (*                            .ARC/.LBR file name (default is expand    *)
  30. (*                            immediately following file name).         *)
  31. (*            /o=filename     write catalog listing to file "filename"  *)
  32. (*                            (default is "CATALOG.LIS")                *)
  33. (*            /p=pagesize     paginate listing using "pagesize" lines   *)
  34. (*                            (default is no pagination)                *)
  35. (*            /x              don't list .ARC/.LBR file contents        *)
  36. (*                            (default is to list .ARC/.LBR contents)   *)
  37. (*                                                                      *)
  38. (*    Aborting:  Hit ^C to abort catalog listing.                       *)
  39. (*                                                                      *)
  40. (*    Output:                                                           *)
  41. (*                                                                      *)
  42. (*       For each selected file, the file name, size in bytes, and time *)
  43. (*       and date of creation are displayed.  The same information is   *)
  44. (*       given for members of .ARC or .LBR files.                       *)
  45. (*                                                                      *)
  46. (*    Acknowledgments:                                                  *)
  47. (*                                                                      *)
  48. (*       The archive search code is based upon TPARCV.PAS written by    *)
  49. (*       Michael Quinlan and ARCV.ASM written by Vern Buerg.            *)
  50. (*                                                                      *)
  51. (*       The library search code is based upon LU.PAS written by        *)
  52. (*       Steve Freeman.                                                 *)
  53. (*                                                                      *)
  54. (*       Stephen Falatko suggested and coded the enhancement to list    *)
  55. (*       the contents of .ARC, .LBR files immediately following their   *)
  56. (*       appearance in the main catalog listing.  I've altered the      *)
  57. (*       display to make it easier to pick those entries which are .ARC *)
  58. (*       and .LBR contents.                                             *)
  59. (*                                                                      *)
  60. (*       Dave Seidman provided a mechanism for getting the volume label *)
  61. (*       under MS DOS 2.x.                                              *)
  62. (*                                                                      *)
  63. (*----------------------------------------------------------------------*)
  64.  
  65.                                    (* Global declarations *)
  66. (*$I PIBCAT.GLO   *)
  67.                                    (* General service subroutines *)
  68. (*$I PIBCATS1.PAS  *)
  69. (*$I PIBCATS2.PAS  *)
  70.  
  71. (*----------------------------------------------------------------------*)
  72. (*        Display_Help  --- Display help screen for PibCat              *)
  73. (*----------------------------------------------------------------------*)
  74.  
  75. PROCEDURE Display_Help;
  76.  
  77. VAR
  78.    Ch: CHAR;
  79.  
  80. BEGIN (* Display_Help *)
  81.  
  82.    WRITELN;
  83.    WRITELN('Program: PIBCAT --- Catalog files on a disk.');
  84.    WRITELN('Author:  Philip R. Burns.');
  85.    WRITELN('Version: 1.1    January 30, 1987.');
  86.    WRITELN('Usage:   PIBCAT v /f=filespec /i=indent /m=margin /o=filename /p=pagesize /x /n');
  87.    WRITELN('                v               volume (drive letter) to catalog');
  88.    WRITELN('                                (default is current drive)');
  89.    WRITELN('                                If given as ?, this text is displayed.');
  90.    WRITELN('                /e=filespec     DOS file spec to match when listing');
  91.    WRITELN('                                entries in .ARC/.LBR files (default');
  92.    WRITELN('                                is *.* -- list all entries).');
  93.    WRITELN('                /f=filespec     DOS file spec to match when listing files');
  94.    WRITELN('                                (default is *.* -- list all files)');
  95.    WRITELN('                /i=indent       # columns to space for .ARC/.LBR entries');
  96.    WRITELN('                                (default is 0)');
  97.    WRITELN('                /m=margin       left margin to leave (default is 0)');
  98.    WRITELN('                /n              list contents of .ARC/.LBR at end of each');
  99.    WRITELN('                                subdirectory (default is list contents');
  100.    WRITELN('                                following .ARC/.LBR file name)');
  101.    WRITELN('                /o=filename     write catalog listing to file "filename"');
  102.    WRITELN('                                (default is "CATALOG.LIS")');
  103.    WRITELN('                /p=pagesize     paginate listing using "pagesize" lines');
  104.    WRITELN('                                (default is no pagination)');
  105.    WRITELN(' ');
  106.  
  107.    WRITE  ('Hit a key to continue: ');
  108.    READ( Kbd, Ch );
  109.  
  110.    WHILE( KeyPressed ) DO
  111.       READ( Kbd, Ch );
  112.  
  113.    WRITELN;
  114.    WRITELN;
  115.    WRITELN('                /x              don''t list .ARC/.LBR files contents');
  116.    WRITELN('                                (default is to list .ARC/.LBR contents)');
  117.    WRITELN;
  118.    WRITELN('Aborting:  Hit ^C to abort catalog listing.');
  119.    WRITELN;
  120.  
  121. END   (* Display_Help *);
  122.  
  123. (*----------------------------------------------------------------------*)
  124. (*             Initialize --- Initialize PibCat program                 *)
  125. (*----------------------------------------------------------------------*)
  126.  
  127. FUNCTION Initialize : BOOLEAN;
  128.  
  129. VAR
  130.    S    : AnyStr;
  131.    S2   : AnyStr;
  132.    I    : INTEGER;
  133.    J    : INTEGER;
  134.    Ierr : INTEGER;
  135.  
  136. (* STRUCTURED *) CONST
  137.    Legit_Drives : SET OF CHAR = ['A'..'Z','?'];
  138.  
  139. BEGIN (* Initialize *)
  140.                                    (* --- Set defaults --- *)
  141.  
  142.                                    (* Drive to catalog is current drive *)
  143.  
  144.    Cat_Drive         := Dir_Get_Default_Drive;
  145.  
  146.                                    (* Default output file is CATALOG.LIS *)
  147.  
  148.    Output_File_Name  := 'CATALOG.LIS';
  149.  
  150.                                    (* Don't produce paginated listing file *)
  151.    Do_Printer_Format := FALSE;
  152.    Page_Size         := 0;
  153.                                    (* No extra spaces at left margin *)
  154.    Left_Margin       := 0;
  155.                                    (* No extra indent for .ARC/.LBR *)
  156.    ArcLbr_Indent     := 0;
  157.                                    (* List contents of .ARC/.LBR files *)
  158.    Expand_Arcs       := TRUE;
  159.                                    (* Expand .ARC/.LBR after main listing *)
  160.    Expand_Arcs_In    := TRUE;
  161.                                    (* No ^C hit yet terminating cataloguing *)
  162.    User_Break        := FALSE;
  163.                                    (* Catalog all files by default *)
  164.    Find_Spec         := '*.*';
  165.                                    (* Catalog all .ARC/.LBR entries by default *)
  166.    Entry_Spec        := '*.*';
  167.                                    (* We start on first page *)
  168.    Page_Number       := 1;
  169.                                    (* Lots of lines left on this page *)
  170.    Lines_Left        := 32767;
  171.                                    (* No files yet *)
  172.    File_Count    := 0;
  173.    Total_Files   := 0;
  174.    Total_Space   := 0;
  175.    Total_Entries := 0;
  176.    Total_ESpace  := 0;
  177.    Total_Dirs    := 0;
  178.                                    (* No titles yet *)
  179.    Volume_Title  := '';
  180.    Subdir_Title  := '';
  181.    File_Title    := '';
  182.                                    (* Not help mode only *)
  183.    Help_Only     := FALSE;
  184.                                    (* Grab command line parameters *)
  185.    FOR I := 1 TO ParamCount DO
  186.       BEGIN
  187.  
  188.          S := UpperCase( ParamStr( I ) );
  189.  
  190.          IF ( S[1] = '/' ) THEN
  191.             BEGIN
  192.  
  193.                IF ( S[3] = '=' ) THEN
  194.                   S2 := Substr( S, 4, LENGTH( S ) - 3 )
  195.                ELSE
  196.                   S2 := '';
  197.  
  198.                CASE UpCase( S[2] ) OF
  199.  
  200.                   'E':  BEGIN
  201.                            IF ( S2 <> '' ) THEN
  202.                               Entry_Spec := S2;
  203.                         END;
  204.  
  205.                   'F':  BEGIN
  206.                            IF ( S2 <> '' ) THEN
  207.                               Find_Spec := S2;
  208.                         END;
  209.  
  210.                   'I':  BEGIN
  211.                            VAL( S2, J, Ierr );
  212.                            IF ( Ierr = 0 ) THEN
  213.                               ArcLbr_Indent := J;
  214.                         END;
  215.  
  216.                   'M':  BEGIN
  217.                            VAL( S2, J, Ierr );
  218.                            IF ( Ierr = 0 ) THEN
  219.                               Left_Margin := J;
  220.                         END;
  221.  
  222.                   'N':  BEGIN
  223.                            Expand_Arcs_In   := FALSE;
  224.                            Expand_Arcs      := TRUE;
  225.                         END;
  226.  
  227.                   'O':  Output_File_Name := S2;
  228.  
  229.                   'P':  BEGIN
  230.                            VAL( S2, J, Ierr );
  231.                            IF ( Ierr = 0 ) THEN
  232.                               BEGIN
  233.                                  Page_Size  := J;
  234.                                  Lines_Left := J;
  235.                               END;
  236.                            Do_Printer_Format := ( Page_Size > 0 );
  237.                         END;
  238.  
  239.                   'X':  Expand_Arcs       := FALSE;
  240.  
  241.                   ELSE;
  242.  
  243.                END (* CASE *);
  244.  
  245.             END
  246.          ELSE
  247.             IF Cat_Drive IN Legit_Drives THEN
  248.                Cat_Drive := S[1];
  249.       END;
  250.                                    (* If the drive was a "?" then we have  *)
  251.                                    (* a help request.  Display help info   *)
  252.                                    (* and quit.                            *)
  253.    IF ( Cat_Drive = '?' ) THEN
  254.       BEGIN
  255.          Display_Help;
  256.          Initialize := FALSE;
  257.          Help_Only  := TRUE;
  258.          EXIT;
  259.       END;
  260.                                    (* Fix up entry spec for comparisons    *)
  261.                                    (* later on.  If '*.*', then don't      *)
  262.                                    (* bother with entry spec checks later. *)
  263.  
  264.    Check_Entry_Spec( Entry_Spec, Entry_Name, Entry_Ext, Use_Entry_Spec );
  265.  
  266.                                    (* Get string of blanks for left margin *)
  267.  
  268.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  269.  
  270.                                    (* Open output file *)
  271.       (*$I-*)
  272.    ASSIGN( Output_File , Output_File_Name );
  273.    REWRITE( Output_File );
  274.       (*$I+*)
  275.                                    (* Continue if we got it *)
  276.    IF ( IOResult = 0 ) THEN
  277.       Initialize := TRUE
  278.    ELSE
  279.       BEGIN
  280.          WRITELN;
  281.          WRITELN( 'Can''t open output file ', Output_File_Name );
  282.          WRITELN;
  283.          Initialize := FALSE;
  284.       END;
  285.  
  286. END   (* Initialize *);
  287.  
  288. (*----------------------------------------------------------------------*)
  289. (*     Display_Volume_Label   ---  Display volume label of disk         *)
  290. (*----------------------------------------------------------------------*)
  291.  
  292. PROCEDURE Display_Volume_Label;
  293.  
  294. VAR
  295.    Volume_Label : AnyStr;
  296.    Vol_Time     : INTEGER;
  297.    Vol_Date     : INTEGER;
  298.    STime        : STRING[10];
  299.    SDate        : STRING[10];
  300.  
  301. BEGIN (* Display_Volume_Label *)
  302.  
  303.                                    (* Blank out volume title line *)
  304.  
  305.    Volume_Title := DUPL( ' ' , 80 );
  306.  
  307.                                    (* Get volume label from DOS *)
  308.  
  309.    Dir_Get_Volume_Label( Cat_Drive, Volume_Label, Vol_Date, Vol_Time );
  310.  
  311.    WRITELN( Output_File );
  312.                                    (* If no volume label, don't output it. *)
  313.  
  314.    IF ( Volume_Label = '' ) THEN
  315.       BEGIN
  316.  
  317.          Volume_Title := Left_Margin_String              +
  318.                          ' Contents of volume on drive ' +
  319.                          Cat_Drive                       +
  320.                          ' as of '                       +
  321.                          DateString                      +
  322.                          '  '                            +
  323.                          TimeOfDayString;
  324.  
  325.          IF Do_Printer_Format THEN
  326.             BEGIN
  327.                WRITELN( Output_File , FF_Char );
  328.                WRITE  ( Output_File , Volume_Title );
  329.                WRITELN( Output_File , '     Page ', Page_Number );
  330.             END
  331.          ELSE
  332.             WRITELN( Output_File , Volume_Title );
  333.  
  334.          Lines_Left := Lines_Left - 1;
  335.  
  336.       END
  337.    ELSE
  338.                                    (* If volume label, output it along with *)
  339.                                    (* its creation time and date.           *)
  340.       BEGIN
  341.  
  342.          Volume_Title := Left_Margin_String        +
  343.                          ' Contents of volume '    +
  344.                          Volume_Label              +
  345.                          ' as of '                 +
  346.                          DateString                +
  347.                          '  '                      +
  348.                          TimeOfDayString;
  349.  
  350.          IF Do_Printer_Format THEN
  351.             BEGIN
  352.                WRITELN( Output_File , FF_Char );
  353.                WRITE  ( Output_File , Volume_Title );
  354.                WRITELN( Output_File , '     Page ', Page_Number );
  355.             END
  356.          ELSE
  357.             WRITELN( Output_File , Volume_Title );
  358.  
  359.          Volume_Label := Volume_Label + DUPL( ' ' , 12 - LENGTH( Volume_Label ) );
  360.  
  361.          Dir_Convert_Date( Vol_Date , SDate );
  362.          Dir_Convert_Time( Vol_Time , STime );
  363.  
  364.          WRITELN( Output_File );
  365.          WRITE  ( Output_File , Left_Margin_String,
  366.                   ' Volume: ',Volume_Label );
  367.  
  368.          IF ( SDate <> '         ' ) THEN
  369.             WRITE  ( Output_File , ' Created: ', SDate, '  ', STime );
  370.  
  371.          Lines_Left := Lines_Left - 3;
  372.  
  373.       END;
  374.  
  375.    WRITELN( Output_File );
  376.                                    (* Count lines left on page *)
  377.    Lines_Left := Lines_Left - 2;
  378.  
  379. END   (* Display_Volume_Label *);
  380.  
  381. (*----------------------------------------------------------------------*)
  382. (*     Display_Page_Titles  ---  Display page titles at top of page     *)
  383. (*----------------------------------------------------------------------*)
  384.  
  385. PROCEDURE Display_Page_Titles;
  386.  
  387. (*----------------------------------------------------------------------*)
  388. (*                                                                      *)
  389. (*    Procedure: Display_Page_Titles;                                   *)
  390. (*                                                                      *)
  391. (*    Purpose:   Displays page headers for paginated output file        *)
  392. (*                                                                      *)
  393. (*    Calling sequence:                                                 *)
  394. (*                                                                      *)
  395. (*       Display_Page_Titles;                                           *)
  396. (*                                                                      *)
  397. (*----------------------------------------------------------------------*)
  398.  
  399. BEGIN (* Display_Page_Titles *)
  400.  
  401.                                    (* Skip to top of new page using FF *)
  402.    WRITELN( Output_File , FF_Char );
  403.  
  404.                                    (* Reset lines left to page size    *)
  405.    Lines_Left := Page_Size;
  406.                                    (* Increment page count             *)
  407.  
  408.    Page_Number := SUCC( Page_Number );
  409.  
  410.                                    (* Display extant titles            *)
  411.                                    (*   -- Volume title                *)
  412.  
  413.    WRITELN( Output_File );
  414.    WRITELN( Output_File , Volume_Title , '     Page ', Page_Number );
  415.    WRITELN( Output_File );
  416.                                    (*   -- Subdirectory title          *)
  417.  
  418.    WRITELN( Output_File , Subdir_Title );
  419.    WRITELN( Output_File );
  420.  
  421.    Lines_Left := Lines_Left - 5;
  422.  
  423.    IF ( File_Title <> '' ) THEN
  424.       BEGIN
  425.                                    (*   -- File title          *)
  426.  
  427.          WRITELN( Output_File , File_Title );
  428.          WRITELN( Output_File );
  429.  
  430.          Lines_Left := Lines_Left - 2;
  431.  
  432.       END;
  433.  
  434. END   (* Display_Page_Titles *);
  435.                                    (* Archive display routines *)
  436. (*$I PIBCATA.PAS *)
  437.                                    (* Library display routines *)
  438. (*$I PIBCATL.PAS *)
  439.  
  440. (*----------------------------------------------------------------------*)
  441. (*          Move_File_Info --- Save file information for sorting        *)
  442. (*----------------------------------------------------------------------*)
  443.  
  444. PROCEDURE Move_File_Info(     Full : Directory_Record;
  445.                           VAR Short: Short_Dir_Record );
  446.  
  447. (*----------------------------------------------------------------------*)
  448. (*                                                                      *)
  449. (*    Procedure: Move_File_Info                                         *)
  450. (*                                                                      *)
  451. (*    Purpose:   Saves information about file in compact form           *)
  452. (*                                                                      *)
  453. (*    Calling sequence:                                                 *)
  454. (*                                                                      *)
  455. (*       Move_File_Info(     Full : Directory_Record;                   *)
  456. (*                       VAR Short: Short_Dir_Record );                 *)
  457. (*                                                                      *)
  458. (*          Full  --- Directory info as retrieved from DOS              *)
  459. (*          Short --- Directory info with garbage thrown out            *)
  460. (*                                                                      *)
  461. (*    Remarks:                                                          *)
  462. (*                                                                      *)
  463. (*       This routine copies the useful stuff about a file to a         *)
  464. (*       shorter record which is more easily sorted.                    *)
  465. (*                                                                      *)
  466. (*----------------------------------------------------------------------*)
  467.  
  468. BEGIN (* Move_File_Info *)
  469.  
  470.    Short.File_Date    := Full.File_Date;
  471.    Short.File_Time    := Full.File_Time;
  472.    Short.File_Size    := Full.File_Size;
  473.    Short.File_Attr    := Full.File_Attr;
  474.    Short.File_Name    := COPY( Full.File_Name, 1,
  475.                                POS( #0 , Full.File_Name ) - 1 );
  476.  
  477. END   (* Move_File_Info *);
  478.  
  479. (*----------------------------------------------------------------------*)
  480. (*        Display_File_Info --- Display information about a file        *)
  481. (*----------------------------------------------------------------------*)
  482.  
  483. PROCEDURE Display_File_Info( Dir_Entry : Short_Dir_Record );
  484.  
  485. (*----------------------------------------------------------------------*)
  486. (*                                                                      *)
  487. (*    Procedure: Display_File_Info                                      *)
  488. (*                                                                      *)
  489. (*    Purpose:   Displays information for current file                  *)
  490. (*                                                                      *)
  491. (*    Calling sequence:                                                 *)
  492. (*                                                                      *)
  493. (*       Display_File_Info( Dir_Entry : Short_Dir_Record );             *)
  494. (*                                                                      *)
  495. (*          Dir_Entry --- Directory record describing file              *)
  496. (*                                                                      *)
  497. (*    Remarks:                                                          *)
  498. (*                                                                      *)
  499. (*       The counters for total number of files and total file space    *)
  500. (*       used are incremented here.                                     *)
  501. (*                                                                      *)
  502. (*----------------------------------------------------------------------*)
  503.  
  504. VAR
  505.    RLength : REAL;
  506.    STime   : STRING[10];
  507.    SDate   : STRING[10];
  508.    I       : INTEGER;
  509.  
  510. BEGIN (* Display_File_Info *)
  511.  
  512.    WITH Dir_Entry DO
  513.       BEGIN
  514.                                    (* Ensure space left this page *)
  515.  
  516.          IF ( Lines_Left < 1 ) THEN
  517.             Display_Page_Titles;
  518.                                    (* Get length *)
  519.  
  520.          RLength := Long_To_Real( File_Size );
  521.  
  522.                                    (* Get date and time of creation *)
  523.  
  524.          Dir_Convert_Date( File_Date , SDate );
  525.          Dir_Convert_Time( File_Time , STime );
  526.  
  527.                                    (* Write out file name *)
  528.  
  529.          WRITE( Output_File , Left_Margin_String , '      ' , File_Name );
  530.  
  531.          FOR I := LENGTH( File_Name ) TO 14 DO
  532.             WRITE( Output_File , ' ');
  533.  
  534.                                    (* Write length, date, and time *)
  535.  
  536.          WRITE  ( Output_File , RLength:8:0, '  ' );
  537.          WRITE  ( Output_File , SDate, '  ' );
  538.          WRITE  ( Output_File , STime );
  539.          WRITELN( Output_File );
  540.  
  541.                                    (* Update count of lines left   *)
  542.          IF Do_Printer_Format THEN
  543.             Lines_Left := Lines_Left - 1;
  544.  
  545.       END;
  546.                                    (* Increment total file count   *)
  547.  
  548.    Total_Files := Total_Files + 1;
  549.  
  550.                                    (* Increment total space used   *)
  551.  
  552.    Total_Space := Total_Space + RLength;
  553.  
  554. END   (* Display_File_Info *);
  555.  
  556. (*----------------------------------------------------------------------*)
  557. (*          Sort_Files --- Sort files in ascending order by name        *)
  558. (*----------------------------------------------------------------------*)
  559.  
  560. PROCEDURE Sort_Files( First : INTEGER;
  561.                       Last  : INTEGER );
  562.  
  563. (*----------------------------------------------------------------------*)
  564. (*                                                                      *)
  565. (*    Procedure: Sort_Files                                             *)
  566. (*                                                                      *)
  567. (*    Purpose:   Sorts file names in current directory                  *)
  568. (*                                                                      *)
  569. (*    Calling sequence:                                                 *)
  570. (*                                                                      *)
  571. (*       Sort_Files( First : INTEGER; Last : INTEGER );                 *)
  572. (*                                                                      *)
  573. (*          First --- First entry in 'File_Stack' to sort               *)
  574. (*          Last  --- Last entry in 'File_Stack' to sort                *)
  575. (*                                                                      *)
  576. (*    Remarks:                                                          *)
  577. (*                                                                      *)
  578. (*       A shell sort is used to put the file names for the current     *)
  579. (*       directory in ascending order.  The current directory's files   *)
  580. (*       are bracketed by 'First' and 'Last'.                           *)
  581. (*                                                                      *)
  582. (*----------------------------------------------------------------------*)
  583.  
  584. VAR
  585.    Temp : Short_Dir_Record;
  586.    I    : INTEGER;
  587.    J    : INTEGER;
  588.    D    : INTEGER;
  589.  
  590. BEGIN (* Sort_Files *)
  591.  
  592.    D := ( Last - First + 1 );
  593.  
  594.    WHILE( D > 1 ) DO
  595.       BEGIN
  596.  
  597.          IF ( D < 5 ) THEN
  598.             D := 1
  599.          ELSE
  600.             D := TRUNC( 0.45454 * D );
  601.  
  602.          FOR I := ( Last - D ) DOWNTO First DO
  603.             BEGIN
  604.  
  605.                Temp       := File_Stack[I];
  606.                J          := I + D;
  607.  
  608.                WHILE( ( Temp.File_Name > File_Stack[J].File_Name ) AND ( J <= Last ) ) DO
  609.                   BEGIN
  610.                      File_Stack[J-D] := File_Stack[J];
  611.                      J               := J + D;
  612.                   END;
  613.  
  614.                File_Stack[J-D] := Temp;
  615.  
  616.             END;
  617.  
  618.       END;
  619.  
  620. END   (* Sort_Files *);
  621.  
  622. (*----------------------------------------------------------------------*)
  623. (*          Find_Files --- Recursively search directories for files     *)
  624. (*----------------------------------------------------------------------*)
  625.  
  626. PROCEDURE Find_Files( VAR Subdir    : AnyStr;
  627.                       VAR File_Spec : AnyStr;
  628.                           Attr      : INTEGER;
  629.                           Levels    : INTEGER );
  630.  
  631. (*----------------------------------------------------------------------*)
  632. (*                                                                      *)
  633. (*    Procedure: Find_Files                                             *)
  634. (*                                                                      *)
  635. (*    Purpose:   Recursively traverses directories looking for files    *)
  636. (*                                                                      *)
  637. (*    Calling sequence:                                                 *)
  638. (*                                                                      *)
  639. (*       Find_Files( VAR Subdir    : AnyStr;                            *)
  640. (*                   VAR File_Spec : AnyStr;                            *)
  641. (*                       Attr      : INTEGER;                           *)
  642. (*                       Levels    : INTEGER );                         *)
  643. (*                                                                      *)
  644. (*          Subdir    --- subdirectory name of this level               *)
  645. (*          File_Spec --- DOS file spec to match                        *)
  646. (*          Attr      --- attribute type to match                       *)
  647. (*          Levels    --- current subdirectory level depth              *)
  648. (*                                                                      *)
  649. (*    Remarks:                                                          *)
  650. (*                                                                      *)
  651. (*       This is the actual heart of PibCat.  This routine invokes      *)
  652. (*       itself recursively to traverse all subdirectories looking for  *)
  653. (*       files which match the given file specification.                *)
  654. (*                                                                      *)
  655. (*----------------------------------------------------------------------*)
  656.  
  657. VAR
  658.    Dir_Entry  : Directory_Record;
  659.    Path       : AnyStr;
  660.    Error      : INTEGER;
  661.    I          : INTEGER;
  662.    Dir        : STRING[14];
  663.    Cur_Count  : INTEGER;
  664.    Skip_Attr  : INTEGER;
  665.    Files_Here : INTEGER;
  666.  
  667. LABEL  Quit;
  668.  
  669. BEGIN  (* Find_Files *)
  670.                                    (* Save current file count *)
  671.    Cur_Count  := File_Count;
  672.                                    (* No files in this directory yet *)
  673.    Files_Here := 0;
  674.                                    (* Don't list directories as files *)
  675.  
  676.    Skip_Attr := Attribute_Volume_Label + Attribute_Subdirectory;
  677.  
  678.    IF ( Levels >= 1 ) THEN
  679.       BEGIN
  680.                                    (* Get full file spec to search for *)
  681.  
  682.          Path := Subdir + File_Spec;
  683.  
  684.                                    (* Need "Z" format string for DOS *)
  685.  
  686.          Convert_String_To_AsciiZ( Path );
  687.  
  688.                                    (* Get first file on this level *)
  689.  
  690.          Error := Dir_Find_First_File( Path , Dir_Entry );
  691.  
  692.                                    (* Get info on remaining files  *)
  693.                                    (* on this level.               *)
  694.          WHILE ( Error = 0 ) DO
  695.             BEGIN
  696.                                    (* Increment count of files in this dir *)
  697.                                    (* including subdirectories             *)
  698.  
  699.                File_Count := SUCC( File_Count );
  700.  
  701.                                    (* Increment non-directory file count *)
  702.  
  703.                IF ( ( Dir_Entry.File_Attr AND Skip_Attr ) = 0 ) THEN
  704.                    Files_Here := SUCC( Files_Here );
  705.  
  706.                                    (* Save info on this file *)
  707.  
  708.                Move_File_Info ( Dir_Entry , File_Stack[File_Count] );
  709.  
  710.                                    (* Get next file entry *)
  711.  
  712.                Error := Dir_Find_Next_File( Dir_Entry );
  713.  
  714.                                    (* Check for ^C at keyboard *)
  715.                IF KeyPressed THEN
  716.                   IF QuitFound THEN
  717.                      GOTO Quit;
  718.  
  719.             END;
  720.                                    (* Sort file names              *)
  721.  
  722.          Sort_Files( Cur_Count + 1 , File_Count );
  723.  
  724.                                    (* Increment directory count    *)
  725.  
  726.          Total_Dirs  := Total_Dirs + 1;
  727.  
  728.                                    (* Report scanning this subdirectory *)
  729.  
  730.          WRITELN(' Scanning: ', Subdir );
  731.  
  732.                                    (* Display file info header *)
  733.  
  734.          IF ( Files_Here > 0 ) THEN
  735.             BEGIN
  736.  
  737.                Subdir_Title := Left_Margin_String + ' Directory: ' + Subdir;
  738.  
  739.                IF Do_Printer_Format THEN
  740.                   IF ( Lines_Left < 4 ) THEN
  741.                      Display_Page_Titles
  742.                   ELSE
  743.                      BEGIN
  744.                         WRITELN( Output_File );
  745.                         WRITELN( Output_File , Subdir_Title );
  746.                         WRITELN( Output_File );
  747.                      END
  748.                ELSE
  749.                   BEGIN
  750.                      WRITELN( Output_File );
  751.                      WRITELN( Output_File , Subdir_Title );
  752.                      WRITELN( Output_File );
  753.                   END;
  754.                                    (* Count lines left on page *)
  755.  
  756.                IF Do_Printer_Format THEN
  757.                   BEGIN
  758.                      Lines_Left := Lines_Left - 3;
  759.                      IF ( Lines_Left < 1 ) THEN
  760.                         Display_Page_Titles;
  761.                   END;
  762.  
  763.             END;
  764.                                    (* Display info on all files       *)
  765.                                    (* But don't display directories!  *)
  766.  
  767.          FOR I := ( Cur_Count + 1 ) TO File_Count DO
  768.              BEGIN
  769.  
  770.                 IF ( ( File_Stack[I].File_Attr AND Skip_Attr ) = 0 ) THEN
  771.                    Display_File_Info( File_Stack[I] );
  772.  
  773.                 IF ( Expand_Arcs AND Expand_Arcs_In ) THEN
  774.                    BEGIN
  775.                       IF ( POS( '.ARC', File_Stack[I].File_Name ) > 0 ) THEN
  776.                          Display_Archive_Contents( Subdir + File_Stack[I].File_Name );
  777.                       IF ( POS( '.LBR', File_Stack[I].File_Name ) > 0 ) THEN
  778.                          Display_Lbr_Contents( Subdir + File_Stack[I].File_Name );
  779.                    END;
  780.  
  781.                 IF KeyPressed THEN
  782.                    IF QuitFound THEN
  783.                       GOTO Quit;
  784.  
  785.              END;
  786.                                    (* List .LBR/.ARC if requested *)
  787.  
  788.          IF ( Expand_Arcs AND ( NOT Expand_Arcs_In ) ) THEN
  789.             BEGIN
  790.                                    (* List contents of any .ARC files *)
  791.  
  792.                FOR I := ( Cur_Count + 1 ) TO File_Count DO
  793.                   BEGIN
  794.                      IF ( POS( '.ARC', File_Stack[I].File_Name ) > 0 ) THEN
  795.                         Display_Archive_Contents( Subdir + File_Stack[I].File_Name );
  796.                      IF KeyPressed THEN
  797.                         IF QuitFound THEN
  798.                            GOTO Quit;
  799.                   END;
  800.                                    (* List contents of any .LBR files *)
  801.  
  802.                FOR I := ( Cur_Count + 1 ) TO File_Count DO
  803.                   BEGIN
  804.                      IF ( POS( '.LBR', File_Stack[I].File_Name ) > 0 ) THEN
  805.                         Display_Lbr_Contents( Subdir + File_Stack[I].File_Name );
  806.                      IF KeyPressed THEN
  807.                         IF QuitFound THEN
  808.                            GOTO Quit;
  809.                   END;
  810.  
  811.             END;
  812.  
  813.          IF ( Levels >= 2 ) THEN
  814.             BEGIN
  815.                                    (* List all subdirectories to given level *)
  816.                                    (* Note: we read through whole directory  *)
  817.                                    (*       again since we probably excluded *)
  818.                                    (*       directories on first pass.       *)
  819.  
  820.                Path := Subdir + '*.*';
  821.                Convert_String_To_AsciiZ( Path );
  822.  
  823.                                    (* Get first file *)
  824.  
  825.                Error := Dir_Find_First_File( Path , Dir_Entry );
  826.  
  827.                                    (* While there are files left ... *)
  828.  
  829.                WHILE ( Error = 0 ) DO
  830.                   BEGIN
  831.                                    (* See if it's a subdirectory *)
  832.  
  833.                      IF ( ( Attribute_Subdirectory AND Dir_Entry.File_Attr ) <> 0 ) THEN
  834.                         BEGIN
  835.                                    (* Yes -- get subdirectory name *)
  836.  
  837.                            Dir := COPY( Dir_Entry.File_Name, 1,
  838.                                         POS( #0 , Dir_Entry.File_Name ) - 1 );
  839.  
  840.                                    (* Ignore '.' and '..' *)
  841.  
  842.                            IF ( ( Dir <> '.' ) AND ( Dir <> '..') ) THEN
  843.                               BEGIN
  844.  
  845.                                    (* Construct path name for subdirectory *)
  846.  
  847.                                  Path := Subdir + Dir + '\';
  848.  
  849.                                    (* List files in subdirectory *)
  850.  
  851.                                  Find_Files( Path, File_Spec, Attr, Levels - 1 );
  852.  
  853.                                  IF User_Break THEN
  854.                                     GOTO Quit;
  855.  
  856.                               END;
  857.  
  858.                         END;
  859.                                    (* Get next file entry *)
  860.  
  861.                      Error := Dir_Find_Next_File( Dir_Entry );
  862.  
  863.                   END (* WHILE *);
  864.  
  865.             END (* IF Levels >= 2 *);
  866.  
  867.       END (* IF Levels >= 1 *);
  868.                                    (* Restore previous file count *)
  869. Quit:
  870.    File_Count := Cur_Count;
  871.  
  872. END   (* Find_Files *);
  873.  
  874. (*----------------------------------------------------------------------*)
  875. (*             Perform_Cataloguing --- Do cataloguing of files          *)
  876. (*----------------------------------------------------------------------*)
  877.  
  878. PROCEDURE Perform_Cataloguing;
  879.  
  880. VAR
  881.    Name      : AnyStr;
  882.    Subdir    : AnyStr;
  883.    File_Spec : AnyStr;
  884.    I         : INTEGER;
  885.    L         : INTEGER;
  886.    Done      : BOOLEAN;
  887.  
  888. BEGIN (* Perform_Cataloguing *)
  889.                                    (* Display volume label       *)
  890.    Display_Volume_Label;
  891.                                    (* Append disk letter to file spec *)
  892.  
  893.    IF ( POS( '\' , Find_Spec ) = 0 ) THEN
  894.       Name := Cat_Drive + ':\' + Find_Spec
  895.    ELSE
  896.       Name := Cat_Drive + ':' + Find_Spec;
  897.  
  898.                                    (* Make sure some files get looked at! *)
  899.  
  900.    IF Name[LENGTH(Name)] = '\' THEN
  901.       Name := Name + '*.*';
  902.  
  903.                                    (* Split out directory from file spec *)
  904.    Subdir := Name;
  905.    I      := LENGTH( Subdir ) + 1;
  906.    Done   := FALSE;
  907.  
  908.    REPEAT
  909.       I := I - 1;
  910.       IF ( I > 0 ) THEN
  911.          Done := ( Subdir[I] = '\' )
  912.       ELSE
  913.          Done := TRUE;
  914.    UNTIL Done;
  915.  
  916.    I := LENGTH( Subdir ) - I;
  917.  
  918.    File_Spec[0] := CHR( I );
  919.  
  920.    MOVE( Subdir[ 1 + LENGTH( Subdir ) - I ] , File_Spec[ 1 ] , I );
  921.  
  922.    Subdir[0] := CHR( LENGTH( Subdir ) - I );
  923.  
  924.                                    (* Begin listing files at specified *)
  925.                                    (* subdirectory                     *)
  926.  
  927.    Find_Files( Subdir, File_Spec, $FF, 9999 );
  928.  
  929. END   (* Perform_Cataloguing *);
  930.  
  931. (*----------------------------------------------------------------------*)
  932. (*                Terminate --- Terminate cataloguing                   *)
  933. (*----------------------------------------------------------------------*)
  934.  
  935. PROCEDURE Terminate;
  936.  
  937. BEGIN (* Terminate *)
  938.                                    (* Note if catalogue terminated by ^C *)
  939.    IF ( NOT Help_Only ) THEN
  940.       IF User_Break THEN
  941.          BEGIN
  942.             IF ( Lines_Left < 6 ) THEN
  943.                Display_Page_Titles;
  944.             WRITELN( Output_File );
  945.             WRITELN( Output_File , Left_Margin_String,
  946.                      '>>>>> ^C typed, catalog listing INCOMPLETE.');
  947.             WRITELN( Output_File );
  948.             WRITELN( '^C typed, catalog listing INCOMPLETE.');
  949.          END
  950.       ELSE
  951.          BEGIN                        (* Indicate file totals *)
  952.             IF ( Lines_Left < 9 ) THEN
  953.                Display_Page_Titles;
  954.             WRITELN( Output_File );
  955.             WRITELN( Output_File , Left_Margin_String, ' Totals:');
  956.             WRITELN( Output_File , Left_Margin_String,
  957.                      '    Directories scanned: ',Total_Dirs:10:0);
  958.             WRITELN( Output_File , Left_Margin_String,
  959.                      '    Files selected     : ',Total_Files:10:0);
  960.             WRITELN( Output_File , Left_Margin_String,
  961.                      '    Bytes in files     : ',Total_Space:10:0);
  962.             WRITELN( Output_File , Left_Margin_String,
  963.                      '    Entries selected   : ',Total_Entries:10:0);
  964.             WRITELN( Output_File , Left_Margin_String,
  965.                      '    Bytes in entries   : ',Total_ESpace:10:0);
  966.             WRITELN( Output_File , Left_Margin_String,
  967.                      '    Bytes free         : ',
  968.                      Dir_Get_Free_Space( Cat_Drive ):10:0 );
  969.          END;
  970.                                    (* Close output file *)
  971.       (*$I-*)
  972.    CLOSE( Output_File );
  973.       (*$I+*)
  974.    IF ( IOResult <> 0 ) THEN;
  975.  
  976. END   (* Terminate *);
  977.  
  978. (*---------------------- Main Program of PIBCAT ------------------------*)
  979.  
  980. BEGIN (* PibCat *)
  981.                                    (* Initialize program.  If initialization *)
  982.                                    (* goes OK, then perform cataloguing.     *)
  983.    IF Initialize THEN
  984.       Perform_Cataloguing;
  985.                                    (* Close output file and terminate.       *)
  986.    Terminate;
  987.  
  988. END   (* PibCat *).
  989.