home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PIBCAT14.ZIP / PIBCAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-29  |  39.3 KB  |  984 lines
  1. (*$V-,R-,S-,B-,I-,F+*)
  2. PROGRAM PibCat;
  3.  
  4. (*----------------------------------------------------------------------*)
  5. (*                                                                      *)
  6. (*    Program: PIBCAT --- Catalog files on a disk.                      *)
  7. (*                                                                      *)
  8. (*    Author:  Philip R. Burns.                                         *)
  9. (*                                                                      *)
  10. (*    Version: 1.4    May 29, 1988.                                     *)
  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.4    May 29, 1988.');
  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( Ch );
  109.  
  110.    WHILE( KeyPressed ) DO
  111.       READ( 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.    GetDir( 0 , S );
  145.    Cat_Drive         := UpCase( S[1] );
  146.  
  147.                                    (* Default output file is CATALOG.LIS *)
  148.  
  149.    Output_File_Name  := 'CATALOG.LIS';
  150.  
  151.                                    (* Don't produce paginated listing file *)
  152.    Do_Printer_Format := FALSE;
  153.    Page_Size         := 0;
  154.                                    (* No extra spaces at left margin *)
  155.    Left_Margin       := 0;
  156.                                    (* No extra indent for .ARC/.LBR *)
  157.    ArcLbr_Indent     := 0;
  158.                                    (* List contents of .ARC/.LBR files *)
  159.    Expand_Arcs       := TRUE;
  160.                                    (* Expand .ARC/.LBR after main listing *)
  161.    Expand_Arcs_In    := TRUE;
  162.                                    (* No ^C hit yet terminating cataloguing *)
  163.    User_Break        := FALSE;
  164.                                    (* Catalog all files by default *)
  165.    Find_Spec         := '*.*';
  166.                                    (* Catalog all .ARC/.LBR entries by default *)
  167.    Entry_Spec        := '*.*';
  168.                                    (* We start on first page *)
  169.    Page_Number       := 1;
  170.                                    (* Lots of lines left on this page *)
  171.    Lines_Left        := 32767;
  172.                                    (* No files yet *)
  173.    File_Count    := 0;
  174.    Total_Files   := 0;
  175.    Total_Space   := 0;
  176.    Total_Entries := 0;
  177.    Total_ESpace  := 0;
  178.    Total_Dirs    := 0;
  179.                                    (* No titles yet *)
  180.    Volume_Title  := '';
  181.    Subdir_Title  := '';
  182.    File_Title    := '';
  183.                                    (* Not help mode only *)
  184.    Help_Only     := FALSE;
  185.                                    (* Grab command line parameters *)
  186.    FOR I := 1 TO ParamCount DO
  187.       BEGIN
  188.  
  189.          S := UpperCase( ParamStr( I ) );
  190.  
  191.          IF ( S[1] = '/' ) THEN
  192.             BEGIN
  193.  
  194.                IF ( S[3] = '=' ) THEN
  195.                   S2 := COPY( S, 4, LENGTH( S ) - 3 )
  196.                ELSE
  197.                   S2 := '';
  198.  
  199.                CASE UpCase( S[2] ) OF
  200.  
  201.                   'E':  BEGIN
  202.                            IF ( S2 <> '' ) THEN
  203.                               Entry_Spec := S2;
  204.                         END;
  205.  
  206.                   'F':  BEGIN
  207.                            IF ( S2 <> '' ) THEN
  208.                               Find_Spec := S2;
  209.                         END;
  210.  
  211.                   'I':  BEGIN
  212.                            VAL( S2, J, Ierr );
  213.                            IF ( Ierr = 0 ) THEN
  214.                               ArcLbr_Indent := J;
  215.                         END;
  216.  
  217.                   'M':  BEGIN
  218.                            VAL( S2, J, Ierr );
  219.                            IF ( Ierr = 0 ) THEN
  220.                               Left_Margin := J;
  221.                         END;
  222.  
  223.                   'N':  BEGIN
  224.                            Expand_Arcs_In   := FALSE;
  225.                            Expand_Arcs      := TRUE;
  226.                         END;
  227.  
  228.                   'O':  Output_File_Name := S2;
  229.  
  230.                   'P':  BEGIN
  231.                            VAL( S2, J, Ierr );
  232.                            IF ( Ierr = 0 ) THEN
  233.                               BEGIN
  234.                                  Page_Size  := J;
  235.                                  Lines_Left := J;
  236.                               END;
  237.                            Do_Printer_Format := ( Page_Size > 0 );
  238.                         END;
  239.  
  240.                   'X':  Expand_Arcs       := FALSE;
  241.  
  242.                   ELSE;
  243.  
  244.                END (* CASE *);
  245.  
  246.             END
  247.          ELSE
  248.             IF Cat_Drive IN Legit_Drives THEN
  249.                Cat_Drive := S[1];
  250.       END;
  251.                                    (* If the drive was a "?" then we have  *)
  252.                                    (* a help request.  Display help info   *)
  253.                                    (* and quit.                            *)
  254.    IF ( Cat_Drive = '?' ) THEN
  255.       BEGIN
  256.          Display_Help;
  257.          Initialize := FALSE;
  258.          Help_Only  := TRUE;
  259.          EXIT;
  260.       END;
  261.                                    (* Fix up entry spec for comparisons    *)
  262.                                    (* later on.  If '*.*', then don't      *)
  263.                                    (* bother with entry spec checks later. *)
  264.  
  265.    Check_Entry_Spec( Entry_Spec, Entry_Name, Entry_Ext, Use_Entry_Spec );
  266.  
  267.                                    (* Get string of blanks for left margin *)
  268.  
  269.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  270.  
  271.                                    (* Open output file *)
  272.       (*$I-*)
  273.    ASSIGN( Output_File , Output_File_Name );
  274.    SetTextBuf( Output_File , Output_File_Buffer );
  275.    REWRITE( Output_File );
  276.       (*$I+*)
  277.                                    (* Continue if we got it *)
  278.    IF ( IOResult = 0 ) THEN
  279.       Initialize := TRUE
  280.    ELSE
  281.       BEGIN
  282.          WRITELN;
  283.          WRITELN( 'Can''t open output file ', Output_File_Name );
  284.          WRITELN;
  285.          Initialize := FALSE;
  286.       END;
  287.  
  288. END   (* Initialize *);
  289.  
  290. (*----------------------------------------------------------------------*)
  291. (*     Display_Volume_Label   ---  Display volume label of disk         *)
  292. (*----------------------------------------------------------------------*)
  293.  
  294. PROCEDURE Display_Volume_Label;
  295.  
  296. VAR
  297.    Volume_Label : AnyStr;
  298.    Vol_Time     : LONGINT;
  299.    STime        : STRING[10];
  300.    SDate        : STRING[10];
  301.  
  302. BEGIN (* Display_Volume_Label *)
  303.  
  304.                                    (* Blank out volume title line *)
  305.  
  306.    Volume_Title := DUPL( ' ' , 80 );
  307.  
  308.                                    (* Get volume label from DOS *)
  309.  
  310.    Dir_Get_Volume_Label( Cat_Drive, Volume_Label, Vol_Time );
  311.  
  312.    WRITELN( Output_File );
  313.                                    (* If no volume label, don't output it. *)
  314.  
  315.    IF ( Volume_Label = '' ) THEN
  316.       BEGIN
  317.  
  318.          Volume_Title := Left_Margin_String              +
  319.                          ' Contents of volume on drive ' +
  320.                          Cat_Drive                       +
  321.                          ' as of '                       +
  322.                          DateString                      +
  323.                          '  '                            +
  324.                          TimeOfDayString;
  325.  
  326.          IF Do_Printer_Format THEN
  327.             BEGIN
  328.                WRITELN( Output_File , FF_Char );
  329.                WRITE  ( Output_File , Volume_Title );
  330.                WRITELN( Output_File , '     Page ', Page_Number );
  331.             END
  332.          ELSE
  333.             WRITELN( Output_File , Volume_Title );
  334.  
  335.          Lines_Left := Lines_Left - 1;
  336.  
  337.       END
  338.    ELSE
  339.                                    (* If volume label, output it along with *)
  340.                                    (* its creation time and date.           *)
  341.       BEGIN
  342.  
  343.          Volume_Title := Left_Margin_String        +
  344.                          ' Contents of volume '    +
  345.                          Volume_Label              +
  346.                          ' as of '                 +
  347.                          DateString                +
  348.                          '  '                      +
  349.                          TimeOfDayString;
  350.  
  351.          IF Do_Printer_Format THEN
  352.             BEGIN
  353.                WRITELN( Output_File , FF_Char );
  354.                WRITE  ( Output_File , Volume_Title );
  355.                WRITELN( Output_File , '     Page ', Page_Number );
  356.             END
  357.          ELSE
  358.             WRITELN( Output_File , Volume_Title );
  359.  
  360.          Volume_Label := Volume_Label + DUPL( ' ' , 12 - LENGTH( Volume_Label ) );
  361.  
  362.          Dir_Convert_Date_And_Time( Vol_Time , SDate , 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 : SearchRec;
  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 : SearchRec;                          *)
  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_Time    := Full.Time;
  471.    Short.File_Size    := Full.Size;
  472.    Short.File_Attr    := Full.Attr;
  473.    Short.File_Name    := Full.Name;
  474.  
  475. END   (* Move_File_Info *);
  476.  
  477. (*----------------------------------------------------------------------*)
  478. (*        Display_File_Info --- Display information about a file        *)
  479. (*----------------------------------------------------------------------*)
  480.  
  481. PROCEDURE Display_File_Info( Dir_Entry : Short_Dir_Record );
  482.  
  483. (*----------------------------------------------------------------------*)
  484. (*                                                                      *)
  485. (*    Procedure: Display_File_Info                                      *)
  486. (*                                                                      *)
  487. (*    Purpose:   Displays information for current file                  *)
  488. (*                                                                      *)
  489. (*    Calling sequence:                                                 *)
  490. (*                                                                      *)
  491. (*       Display_File_Info( Dir_Entry : Short_Dir_Record );             *)
  492. (*                                                                      *)
  493. (*          Dir_Entry --- Directory record describing file              *)
  494. (*                                                                      *)
  495. (*    Remarks:                                                          *)
  496. (*                                                                      *)
  497. (*       The counters for total number of files and total file space    *)
  498. (*       used are incremented here.                                     *)
  499. (*                                                                      *)
  500. (*----------------------------------------------------------------------*)
  501.  
  502. VAR
  503.    RLength : LONGINT;
  504.    STime   : STRING[10];
  505.    SDate   : STRING[10];
  506.    I       : INTEGER;
  507.  
  508. BEGIN (* Display_File_Info *)
  509.  
  510.    WITH Dir_Entry DO
  511.       BEGIN
  512.                                    (* Ensure space left this page *)
  513.  
  514.          IF ( Lines_Left < 1 ) THEN
  515.             Display_Page_Titles;
  516.                                    (* Get length *)
  517.  
  518.          RLength := File_Size;
  519.  
  520.                                    (* Get date and time of creation *)
  521.  
  522.          Dir_Convert_Date_And_Time( File_Time , SDate , STime );
  523.  
  524.                                    (* Write out file name *)
  525.  
  526.          WRITE( Output_File , Left_Margin_String , '      ' , File_Name );
  527.  
  528.          FOR I := LENGTH( File_Name ) TO 14 DO
  529.             WRITE( Output_File , ' ');
  530.  
  531.                                    (* Write length, date, and time *)
  532.  
  533.          WRITE  ( Output_File , RLength:8, '  ' );
  534.          WRITE  ( Output_File , SDate, '  ' );
  535.          WRITE  ( Output_File , STime );
  536.          WRITELN( Output_File );
  537.  
  538.                                    (* Update count of lines left   *)
  539.          IF Do_Printer_Format THEN
  540.             Lines_Left := Lines_Left - 1;
  541.  
  542.       END;
  543.                                    (* Increment total file count   *)
  544.  
  545.    Total_Files := Total_Files + 1;
  546.  
  547.                                    (* Increment total space used   *)
  548.  
  549.    Total_Space := Total_Space + RLength;
  550.  
  551. END   (* Display_File_Info *);
  552.  
  553. (*----------------------------------------------------------------------*)
  554. (*          Sort_Files --- Sort files in ascending order by name        *)
  555. (*----------------------------------------------------------------------*)
  556.  
  557. PROCEDURE Sort_Files( First : INTEGER;
  558.                       Last  : INTEGER );
  559.  
  560. (*----------------------------------------------------------------------*)
  561. (*                                                                      *)
  562. (*    Procedure: Sort_Files                                             *)
  563. (*                                                                      *)
  564. (*    Purpose:   Sorts file names in current directory                  *)
  565. (*                                                                      *)
  566. (*    Calling sequence:                                                 *)
  567. (*                                                                      *)
  568. (*       Sort_Files( First : INTEGER; Last : INTEGER );                 *)
  569. (*                                                                      *)
  570. (*          First --- First entry in 'File_Stack' to sort               *)
  571. (*          Last  --- Last entry in 'File_Stack' to sort                *)
  572. (*                                                                      *)
  573. (*    Remarks:                                                          *)
  574. (*                                                                      *)
  575. (*       A shell sort is used to put the file names for the current     *)
  576. (*       directory in ascending order.  The current directory's files   *)
  577. (*       are bracketed by 'First' and 'Last'.                           *)
  578. (*                                                                      *)
  579. (*----------------------------------------------------------------------*)
  580.  
  581. VAR
  582.    Temp : Short_Dir_Record;
  583.    I    : INTEGER;
  584.    J    : INTEGER;
  585.    D    : INTEGER;
  586.  
  587. BEGIN (* Sort_Files *)
  588.  
  589.    D := ( Last - First + 1 );
  590.  
  591.    WHILE( D > 1 ) DO
  592.       BEGIN
  593.  
  594.          IF ( D < 5 ) THEN
  595.             D := 1
  596.          ELSE
  597.             D := TRUNC( 0.45454 * D );
  598.  
  599.          FOR I := ( Last - D ) DOWNTO First DO
  600.             BEGIN
  601.  
  602.                Temp       := File_Stack[I];
  603.                J          := I + D;
  604.  
  605.                WHILE( ( Temp.File_Name > File_Stack[J].File_Name ) AND ( J <= Last ) ) DO
  606.                   BEGIN
  607.                      File_Stack[J-D] := File_Stack[J];
  608.                      J               := J + D;
  609.                   END;
  610.  
  611.                File_Stack[J-D] := Temp;
  612.  
  613.             END;
  614.  
  615.       END;
  616.  
  617. END   (* Sort_Files *);
  618.  
  619. (*----------------------------------------------------------------------*)
  620. (*          Find_Files --- Recursively search directories for files     *)
  621. (*----------------------------------------------------------------------*)
  622.  
  623. PROCEDURE Find_Files( VAR Subdir    : AnyStr;
  624.                       VAR File_Spec : AnyStr;
  625.                           Attr      : INTEGER;
  626.                           Levels    : INTEGER );
  627.  
  628. (*----------------------------------------------------------------------*)
  629. (*                                                                      *)
  630. (*    Procedure: Find_Files                                             *)
  631. (*                                                                      *)
  632. (*    Purpose:   Recursively traverses directories looking for files    *)
  633. (*                                                                      *)
  634. (*    Calling sequence:                                                 *)
  635. (*                                                                      *)
  636. (*       Find_Files( VAR Subdir    : AnyStr;                            *)
  637. (*                   VAR File_Spec : AnyStr;                            *)
  638. (*                       Attr      : INTEGER;                           *)
  639. (*                       Levels    : INTEGER );                         *)
  640. (*                                                                      *)
  641. (*          Subdir    --- subdirectory name of this level               *)
  642. (*          File_Spec --- DOS file spec to match                        *)
  643. (*          Attr      --- attribute type to match                       *)
  644. (*          Levels    --- current subdirectory level depth              *)
  645. (*                                                                      *)
  646. (*    Remarks:                                                          *)
  647. (*                                                                      *)
  648. (*       This is the actual heart of PibCat.  This routine invokes      *)
  649. (*       itself recursively to traverse all subdirectories looking for  *)
  650. (*       files which match the given file specification.                *)
  651. (*                                                                      *)
  652. (*----------------------------------------------------------------------*)
  653.  
  654. VAR
  655.    Dir_Entry  : SearchRec;
  656.    Path       : AnyStr;
  657.    Error      : INTEGER;
  658.    I          : INTEGER;
  659.    Dir        : STRING[14];
  660.    Cur_Count  : INTEGER;
  661.    Skip_Attr  : INTEGER;
  662.    Files_Here : INTEGER;
  663.  
  664. LABEL  Quit;
  665.  
  666. BEGIN  (* Find_Files *)
  667.                                    (* Save current file count *)
  668.    Cur_Count  := File_Count;
  669.                                    (* No files in this directory yet *)
  670.    Files_Here := 0;
  671.                                    (* Don't list directories as files *)
  672.  
  673.    Skip_Attr := VolumeID + Directory;
  674.  
  675.    IF ( Levels >= 1 ) THEN
  676.       BEGIN
  677.                                    (* Get full file spec to search for *)
  678.  
  679.          Path := Subdir + File_Spec;
  680.  
  681.                                    (* Get first file on this level *)
  682.  
  683.          FindFirst( Path, AnyFile, Dir_Entry );
  684.          Error := DosError;
  685.  
  686.                                    (* Get info on remaining files  *)
  687.                                    (* on this level.               *)
  688.          WHILE ( Error = 0 ) DO
  689.             BEGIN
  690.                                    (* Increment count of files in this dir *)
  691.                                    (* including subdirectories             *)
  692.  
  693.                INC( File_Count );
  694.  
  695.                                    (* Increment non-directory file count *)
  696.  
  697.                IF ( ( Dir_Entry.Attr AND Skip_Attr ) = 0 ) THEN
  698.                    INC( Files_Here );
  699.  
  700.                                    (* Save info on this file *)
  701.  
  702.                Move_File_Info ( Dir_Entry , File_Stack[File_Count] );
  703.  
  704.                                    (* Get next file entry *)
  705.  
  706.                FindNext( Dir_Entry );
  707.                Error := DosError;
  708.  
  709.                                    (* Check for ^C at keyboard *)
  710.                IF KeyPressed THEN
  711.                   IF QuitFound THEN
  712.                      GOTO Quit;
  713.  
  714.             END;
  715.                                    (* Sort file names              *)
  716.  
  717.          Sort_Files( Cur_Count + 1 , File_Count );
  718.  
  719.                                    (* Increment directory count    *)
  720.  
  721.          Total_Dirs  := Total_Dirs + 1;
  722.  
  723.                                    (* Report scanning this subdirectory *)
  724.  
  725.          WRITELN(' Scanning: ', Subdir );
  726.  
  727.                                    (* Display file info header *)
  728.  
  729.          IF ( Files_Here > 0 ) THEN
  730.             BEGIN
  731.  
  732.                Subdir_Title := Left_Margin_String + ' Directory: ' + Subdir;
  733.  
  734.                IF Do_Printer_Format THEN
  735.                   IF ( Lines_Left < 4 ) THEN
  736.                      Display_Page_Titles
  737.                   ELSE
  738.                      BEGIN
  739.                         WRITELN( Output_File );
  740.                         WRITELN( Output_File , Subdir_Title );
  741.                         WRITELN( Output_File );
  742.                      END
  743.                ELSE
  744.                   BEGIN
  745.                      WRITELN( Output_File );
  746.                      WRITELN( Output_File , Subdir_Title );
  747.                      WRITELN( Output_File );
  748.                   END;
  749.                                    (* Count lines left on page *)
  750.  
  751.                IF Do_Printer_Format THEN
  752.                   BEGIN
  753.                      Lines_Left := Lines_Left - 3;
  754.                      IF ( Lines_Left < 1 ) THEN
  755.                         Display_Page_Titles;
  756.                   END;
  757.  
  758.             END;
  759.                                    (* Display info on all files       *)
  760.                                    (* But don't display directories!  *)
  761.  
  762.          FOR I := SUCC( Cur_Count ) TO File_Count DO
  763.              BEGIN
  764.  
  765.                 IF ( ( File_Stack[I].File_Attr AND Skip_Attr ) = 0 ) THEN
  766.                    Display_File_Info( File_Stack[I] );
  767.  
  768.                 IF ( Expand_Arcs AND Expand_Arcs_In ) THEN
  769.                    BEGIN
  770.                       IF ( POS( '.ARC', File_Stack[I].File_Name ) > 0 ) THEN
  771.                          Display_Archive_Contents( Subdir + File_Stack[I].File_Name );
  772.                       IF ( POS( '.LBR', File_Stack[I].File_Name ) > 0 ) THEN
  773.                          Display_Lbr_Contents( Subdir + File_Stack[I].File_Name );
  774.                    END;
  775.  
  776.                 IF KeyPressed THEN
  777.                    IF QuitFound THEN
  778.                       GOTO Quit;
  779.  
  780.              END;
  781.                                    (* List .LBR/.ARC if requested *)
  782.  
  783.          IF ( Expand_Arcs AND ( NOT Expand_Arcs_In ) ) THEN
  784.             BEGIN
  785.                                    (* List contents of any .ARC files *)
  786.  
  787.                FOR I := SUCC( Cur_Count ) TO File_Count DO
  788.                   BEGIN
  789.                      IF ( POS( '.ARC', File_Stack[I].File_Name ) > 0 ) THEN
  790.                         Display_Archive_Contents( Subdir + File_Stack[I].File_Name );
  791.                      IF KeyPressed THEN
  792.                         IF QuitFound THEN
  793.                            GOTO Quit;
  794.                   END;
  795.                                    (* List contents of any .LBR files *)
  796.  
  797.                FOR I := SUCC( Cur_Count ) TO File_Count DO
  798.                   BEGIN
  799.                      IF ( POS( '.LBR', File_Stack[I].File_Name ) > 0 ) THEN
  800.                         Display_Lbr_Contents( Subdir + File_Stack[I].File_Name );
  801.                      IF KeyPressed THEN
  802.                         IF QuitFound THEN
  803.                            GOTO Quit;
  804.                   END;
  805.  
  806.             END;
  807.  
  808.          IF ( Levels >= 2 ) THEN
  809.             BEGIN
  810.                                    (* List all subdirectories to given level *)
  811.                                    (* Note: we read through whole directory  *)
  812.                                    (*       again since we probably excluded *)
  813.                                    (*       directories on first pass.       *)
  814.  
  815.                Path := Subdir + '*.*';
  816.  
  817.                                    (* Get first file *)
  818.  
  819.                FindFirst( Path, AnyFile, Dir_Entry );
  820.                Error := DosError;
  821.  
  822.                                    (* While there are files left ... *)
  823.  
  824.                WHILE ( Error = 0 ) DO
  825.                   BEGIN
  826.                                    (* See if it's a subdirectory *)
  827.  
  828.                      IF ( ( Dir_Entry.Attr AND Directory ) <> 0 ) THEN
  829.                         BEGIN
  830.                                    (* Yes -- get subdirectory name *)
  831.  
  832.                            Dir := Dir_Entry.Name;
  833.  
  834.                                    (* Ignore '.' and '..' *)
  835.  
  836.                            IF ( ( Dir <> '.' ) AND ( Dir <> '..') ) THEN
  837.                               BEGIN
  838.  
  839.                                    (* Construct path name for subdirectory *)
  840.  
  841.                                  Path := Subdir + Dir + '\';
  842.  
  843.                                    (* List files in subdirectory *)
  844.  
  845.                                  Find_Files( Path, File_Spec, Attr, Levels - 1 );
  846.  
  847.                                  IF User_Break THEN
  848.                                     GOTO Quit;
  849.  
  850.                               END;
  851.  
  852.                         END;
  853.                                    (* Get next file entry *)
  854.  
  855.                      FindNext( Dir_Entry );
  856.                      Error := DosError;
  857.  
  858.                   END (* WHILE *);
  859.  
  860.             END (* IF Levels >= 2 *);
  861.  
  862.       END (* IF Levels >= 1 *);
  863.                                    (* Restore previous file count *)
  864. Quit:
  865.    File_Count := Cur_Count;
  866.  
  867. END   (* Find_Files *);
  868.  
  869. (*----------------------------------------------------------------------*)
  870. (*             Perform_Cataloguing --- Do cataloguing of files          *)
  871. (*----------------------------------------------------------------------*)
  872.  
  873. PROCEDURE Perform_Cataloguing;
  874.  
  875. VAR
  876.    Name      : AnyStr;
  877.    Subdir    : AnyStr;
  878.    File_Spec : AnyStr;
  879.    I         : INTEGER;
  880.    L         : INTEGER;
  881.    Done      : BOOLEAN;
  882.  
  883. BEGIN (* Perform_Cataloguing *)
  884.                                    (* Display volume label       *)
  885.    Display_Volume_Label;
  886.                                    (* Append disk letter to file spec *)
  887.  
  888.    IF ( POS( '\' , Find_Spec ) = 0 ) THEN
  889.       Name := Cat_Drive + ':\' + Find_Spec
  890.    ELSE
  891.       Name := Cat_Drive + ':' + Find_Spec;
  892.  
  893.                                    (* Make sure some files get looked at! *)
  894.  
  895.    IF Name[LENGTH(Name)] = '\' THEN
  896.       Name := Name + '*.*';
  897.  
  898.                                    (* Split out directory from file spec *)
  899.    Subdir := Name;
  900.    I      := LENGTH( Subdir ) + 1;
  901.    Done   := FALSE;
  902.  
  903.    REPEAT
  904.       DEC( I );
  905.       IF ( I > 0 ) THEN
  906.          Done := ( Subdir[I] = '\' )
  907.       ELSE
  908.          Done := TRUE;
  909.    UNTIL Done;
  910.  
  911.    I := LENGTH( Subdir ) - I;
  912.  
  913.    File_Spec[0] := CHR( I );
  914.  
  915.    MOVE( Subdir[ 1 + LENGTH( Subdir ) - I ] , File_Spec[ 1 ] , I );
  916.  
  917.    Subdir[0] := CHR( LENGTH( Subdir ) - I );
  918.  
  919.                                    (* Begin listing files at specified *)
  920.                                    (* subdirectory                     *)
  921.  
  922.    Find_Files( Subdir, File_Spec, $FF, 9999 );
  923.  
  924. END   (* Perform_Cataloguing *);
  925.  
  926. (*----------------------------------------------------------------------*)
  927. (*                Terminate --- Terminate cataloguing                   *)
  928. (*----------------------------------------------------------------------*)
  929.  
  930. PROCEDURE Terminate;
  931.  
  932. BEGIN (* Terminate *)
  933.                                    (* Note if catalogue terminated by ^C *)
  934.    IF ( NOT Help_Only ) THEN
  935.       IF User_Break THEN
  936.          BEGIN
  937.             IF ( Lines_Left < 6 ) THEN
  938.                Display_Page_Titles;
  939.             WRITELN( Output_File );
  940.             WRITELN( Output_File , Left_Margin_String,
  941.                      '>>>>> ^C typed, catalog listing INCOMPLETE.');
  942.             WRITELN( Output_File );
  943.             WRITELN( '^C typed, catalog listing INCOMPLETE.');
  944.          END
  945.       ELSE
  946.          BEGIN                        (* Indicate file totals *)
  947.             IF ( Lines_Left < 9 ) THEN
  948.                Display_Page_Titles;
  949.             WRITELN( Output_File );
  950.             WRITELN( Output_File , Left_Margin_String, ' Totals:');
  951.             WRITELN( Output_File , Left_Margin_String,
  952.                      '    Directories scanned: ',Total_Dirs:10);
  953.             WRITELN( Output_File , Left_Margin_String,
  954.                      '    Files selected     : ',Total_Files:10);
  955.             WRITELN( Output_File , Left_Margin_String,
  956.                      '    Bytes in files     : ',Total_Space:10);
  957.             WRITELN( Output_File , Left_Margin_String,
  958.                      '    Entries selected   : ',Total_Entries:10);
  959.             WRITELN( Output_File , Left_Margin_String,
  960.                      '    Bytes in entries   : ',Total_ESpace:10);
  961.             WRITELN( Output_File , Left_Margin_String,
  962.                      '    Bytes free         : ',
  963.                      DiskFree( SUCC( ORD( Cat_Drive ) - ORD('A') ) ):10 );
  964.          END;
  965.                                    (* Close output file *)
  966.       (*$I-*)
  967.    CLOSE( Output_File );
  968.       (*$I+*)
  969.    IF ( IOResult <> 0 ) THEN;
  970.  
  971. END   (* Terminate *);
  972.  
  973. (*---------------------- Main Program of PIBCAT ------------------------*)
  974.  
  975. BEGIN (* PibCat *)
  976.                                    (* Initialize program.  If initialization *)
  977.                                    (* goes OK, then perform cataloguing.     *)
  978.    IF Initialize THEN
  979.       Perform_Cataloguing;
  980.                                    (* Close output file and terminate.       *)
  981.    Terminate;
  982.  
  983. END   (* PibCat *).
  984.