home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBCAT.ZIP / PIBCATL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-30  |  16.4 KB  |  400 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Display_Lbr_Contents --- Display contents of library (.LBR) file   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Lbr_Contents( LbrFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Lbr_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a library file (.LBR file)        *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Lbr_Contents( LbrFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          LbrFileName --- name of library file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Dir_Convert_Date  --- convert DOS packed date to string     *)
  25. (*          Dir_Convert_Time  --- convert DOS packed time to string     *)
  26. (*          Display_File_Info --- display information about a file      *)
  27. (*          Open_File         --- open a file                           *)
  28. (*          Close_File        --- close a file                          *)
  29. (*                                                                      *)
  30. (*----------------------------------------------------------------------*)
  31.  
  32. (*----------------------------------------------------------------------*)
  33. (*              Map of Library file (.LBR) entry header                 *)
  34. (*----------------------------------------------------------------------*)
  35.  
  36. TYPE
  37.    Lbr_Entry_Type = RECORD
  38.                        Flag  : BYTE                   (* LBR - Entry flag *);
  39.                        Name  : ARRAY[1 .. 8] OF CHAR  (* File name *);
  40.                        Ext   : ARRAY[1 .. 3] OF CHAR  (* Extension *);
  41.                        Offset: INTEGER                (* Offset within Library *);
  42.                        N_sec : INTEGER                (* Number of 128-byte sectors *);
  43.                        CRC   : INTEGER                (* CRC (optional) *);
  44.                        Date  : INTEGER                (* # days since 1/1/1978 *);
  45.                        UDate : INTEGER                (* Date of last update *);
  46.                        Time  : INTEGER                (* Packed time *);
  47.                        UTime : INTEGER                (* Time of last update *);
  48.                        Pads  : ARRAY[1 .. 6] OF CHAR  (* Currently unused *);
  49.                     END;
  50.  
  51. CONST
  52.    Lbr_Header_Length = 32          (* Length of library file header entry *);
  53.  
  54. VAR
  55.    LbrFile       : FILE            (* Library file *);
  56.    Lbr_Entry     : Lbr_Entry_Type  (* Header describing one file in library *);
  57.    Lbr_Pos       : REAL            (* Current byte position in library *);
  58.    Lbr_Dir_Size  : INTEGER         (* # of entries in library directory *);
  59.    Bytes_Read    : INTEGER         (* # bytes read at current file position *);
  60.    Ierr          : INTEGER         (* Error flag *);
  61.    Do_Blank_Line : BOOLEAN         (* TRUE to print blank line before entry *);
  62.  
  63. (*----------------------------------------------------------------------*)
  64. (*      Get_Next_Lbr_Entry --- Get next header entry in library         *)
  65. (*----------------------------------------------------------------------*)
  66.  
  67. FUNCTION Get_Next_Lbr_Entry( VAR LbrEntry : Lbr_Entry_Type;
  68.                              VAR Error    : INTEGER ) : BOOLEAN;
  69.  
  70. VAR
  71.    Month : INTEGER;
  72.    Year  : INTEGER;
  73.    Done  : BOOLEAN;
  74.    T     : INTEGER;
  75.                                    (* # of days in each month *)
  76. (* STRUCTURED *) CONST
  77.    NDays : ARRAY[1..12] OF INTEGER = ( 31, 28, 31, 30, 31, 30,
  78.                                        31, 31, 30, 31, 30, 31  );
  79.  
  80. BEGIN (* Get_Next_Lbr_Entry *)
  81.                                    (* Assume no error *)
  82.    Error := 0;
  83.                                    (* Loop over directory entries *)
  84.    REPEAT
  85.                                    (* Decrement directory entry count. *)
  86.                                    (* If = 0, reached end of directory *)
  87.                                    (* entries.                         *)
  88.  
  89.       Lbr_Dir_Size := PRED( Lbr_Dir_Size );
  90.       IF ( Lbr_Dir_Size < 0 ) THEN
  91.          Error := End_Of_File;
  92.                                    (* If not end of entries ... *)
  93.       IF ( Error = 0 ) THEN
  94.          BEGIN
  95.                                    (* If not first time, move to next   *)
  96.                                    (* directory entry position in file. *)
  97.  
  98.             IF ( Lbr_Pos <> 0.0 ) THEN
  99.                LongSeek( LbrFile, Lbr_Pos );
  100.  
  101.                                    (* Read directory entry *)
  102.  
  103.             BlockRead( LbrFile, Lbr_Entry, SizeOf( Lbr_Entry ), Bytes_Read );
  104.             Error := 0;
  105.                                    (* If wrong length, .LBR format must *)
  106.                                    (* be incorrect.                     *)
  107.  
  108.             IF ( Bytes_Read < Lbr_Header_Length ) THEN
  109.                Error := Format_Error
  110.             ELSE
  111.                                    (* If length OK, assume entry OK. *)
  112.                WITH Lbr_Entry DO
  113.                   BEGIN
  114.                                    (* Point to next .LBR entry in file *)
  115.  
  116.                      Lbr_Pos := Lbr_Pos + Lbr_Header_Length;
  117.  
  118.                                    (* Pick up time/date of creation this *)
  119.                                    (* entry if specified.  If the update *)
  120.                                    (* time/date is different, then we    *)
  121.                                    (* will report that instead.          *)
  122.  
  123.                      IF ( Time = 0 ) THEN
  124.                         BEGIN
  125.                            Time := UTime;
  126.                            Date := UDate;
  127.                         END
  128.                      ELSE
  129.                         IF ( ( Time <> UTime ) OR ( Date <> UDate ) ) THEN
  130.                            BEGIN
  131.                               Time := UTime;
  132.                               Date := UDate;
  133.                            END;
  134.                                    (* Convert date from library format of *)
  135.                                    (* # days since 1/1/1978 to DOS format *)
  136.                      Month := 1;
  137.                      Year  := 78;
  138.                                    (* This is done using brute force. *)
  139.                      REPEAT
  140.                                    (* Account for leap years *)
  141.  
  142.                         T    := 365 + ORD( Year MOD 4 = 0 );
  143.  
  144.                                    (* See if we have less than 1 year left *)
  145.  
  146.                         Done := ( Date < T );
  147.  
  148.                         IF ( NOT Done ) THEN
  149.                            BEGIN
  150.                               Year := SUCC( Year );
  151.                               Date := Date - T;
  152.                            END;
  153.  
  154.                      UNTIL Done;
  155.                                    (* Now get months and days within year *)
  156.                      REPEAT
  157.  
  158.                         T    := Ndays[Month] +
  159.                                 ORD( ( Month = 2 ) AND ( Year MOD 4 = 0 ) );
  160.  
  161.                         Done := ( Date < T );
  162.  
  163.                         IF ( NOT Done ) THEN
  164.                            BEGIN
  165.                               Month := SUCC( Month );
  166.                               Date  := Date - T;
  167.                            END;
  168.  
  169.                      UNTIL Done;
  170.                                    (* If > 1980, convert to DOS date *)
  171.                                    (* else leave unconverted.        *)
  172.  
  173.                      IF ( Year >= 80 ) THEN
  174.                         Date := ( Year - 80 ) SHL 9 + Month SHL 5 + Date
  175.                      ELSE
  176.                         Date := 0;
  177.  
  178.                   END (* With *);
  179.  
  180.          END   (* Error = 0 *);
  181.  
  182.    UNTIL ( ( Error <> 0 ) OR ( Lbr_Entry.Flag = 0 ) );
  183.  
  184.                                    (* Report success/failure to caller *)
  185.  
  186.    Get_Next_Lbr_Entry := ( Error = 0 );
  187.  
  188. END   (* Get_Next_Lbr_Entry *);
  189.  
  190. (*----------------------------------------------------------------------*)
  191. (*      Display_Lbr_Entry --- Display library header entry              *)
  192. (*----------------------------------------------------------------------*)
  193.  
  194. PROCEDURE Display_Lbr_Entry( Lbr_Entry : Lbr_Entry_Type );
  195.  
  196. VAR
  197.    SDate      : STRING[10];
  198.    STime      : STRING[12];
  199.    I          : INTEGER;
  200.    FName      : AnyStr;
  201.    RLength    : REAL;
  202.    RSize      : REAL;
  203.  
  204. BEGIN (* Display_Lbr_Entry *)
  205.  
  206.    WITH Lbr_Entry DO
  207.       BEGIN
  208.                                    (* Pick up file name *)
  209.  
  210.          FName := TRIM( Name );
  211.  
  212.          IF ( Ext <> '   ' ) THEN
  213.             FName   := FName + '.' + Ext;
  214.  
  215.                                    (* See if this file matches the   *)
  216.                                    (* entry spec wildcard.  Exit if  *)
  217.                                    (* not.                           *)
  218.  
  219.          IF Use_Entry_Spec THEN
  220.             IF ( NOT Entry_Matches( Fname ) ) THEN
  221.                EXIT;
  222.  
  223.                                    (* Make sure room on current page *)
  224.                                    (* for this entry name.           *)
  225.                                    (* If enough room, print blank    *)
  226.                                    (* line if requested.  This will  *)
  227.                                    (* only happen for first file.    *)
  228.          IF Do_Blank_Line THEN
  229.             BEGIN
  230.                IF ( Lines_Left < 2 ) THEN
  231.                   Display_Page_Titles
  232.                ELSE
  233.                   BEGIN
  234.                      WRITELN( Output_File );
  235.                      Lines_left := Lines_Left - 1;
  236.                   END;
  237.                Do_Blank_Line := FALSE;
  238.             END
  239.          ELSE
  240.             IF ( Lines_Left < 1 ) THEN
  241.                Display_Page_Titles;
  242.  
  243.                                    (* Add '. ' to front if we're     *)
  244.                                    (* expanding LBRs in main listing *)
  245.          IF Expand_Arcs_In THEN
  246.             Fname := '. ' + Fname;
  247.  
  248.                                    (* Write out file name *)
  249.  
  250.          WRITE( Output_File , Left_Margin_String , '      ' , FName );
  251.  
  252.          FOR I := LENGTH( FName ) TO 14 DO
  253.             WRITE( Output_File , ' ' );
  254.  
  255.                                    (* Convert length in sectors to *)
  256.                                    (* length in bytes.             *)
  257.  
  258.          RLength := N_Sec * 128.0;
  259.          WRITE( Output_File , RLength:8:0, '  ' );
  260.  
  261.                                    (* If time/date specified, output *)
  262.                                    (* them.                          *)
  263.          IF ( Date > 0 ) THEN
  264.             BEGIN
  265.                Dir_Convert_Date( Date , SDate );
  266.                Dir_Convert_Time( Time , STime );
  267.             END
  268.          ELSE
  269.             BEGIN
  270.                SDate := '        ';
  271.                STime := '        ';
  272.             END;
  273.  
  274.          WRITE( Output_File , SDate, '  ' );
  275.          WRITE( Output_File , STime );
  276.          WRITELN( Output_File );
  277.  
  278.                                    (* Count lines left on page *)
  279.          IF Do_Printer_Format THEN
  280.             Lines_Left := Lines_Left - 1;
  281.  
  282.                                    (* Increment total entry count *)
  283.  
  284.          Total_Entries := Total_Entries + 1;
  285.  
  286.                                    (* Increment total space used  *)
  287.  
  288.          Total_ESpace := Total_ESpace + RLength;
  289.  
  290.       END;
  291.  
  292. END (* Display_Lbr_Entry *);
  293.  
  294. (*----------------------------------------------------------------------*)
  295.  
  296. BEGIN (* Display_Lbr_Contents *)
  297.  
  298.                                    (* Set library left margin spacing *)
  299.  
  300.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , ArcLbr_Indent );
  301.  
  302.                                    (* Set file title *)
  303.  
  304.    File_Title := Left_Margin_String + ' Library file: ' + LbrFileName;
  305.  
  306.                                    (* Display library file's name *)
  307.    IF Do_Printer_Format THEN
  308.       IF Lines_Left < 3 THEN
  309.          Display_Page_Titles;
  310.                                    (* If we're listing contents at end  *)
  311.                                    (* of directory, print library name. *)
  312.                                    (* Do_Blank_Line flags whether we    *)
  313.                                    (* need to print blank line in entry *)
  314.                                    (* lister subroutine.  If listing    *)
  315.                                    (* inline, then it's true for the    *)
  316.                                    (* first file; otherwise it's false. *)
  317.                                    (* This is to prevent unnecessary    *)
  318.                                    (* blank lines in output listing     *)
  319.                                    (* when no files are selected from   *)
  320.                                    (* a given library.                  *)
  321.    IF ( NOT Expand_Arcs_In ) THEN
  322.       BEGIN
  323.          WRITELN( Output_File ) ;
  324.          WRITE  ( Output_File , File_Title );
  325.          Lines_Left    := Lines_Left - 2;
  326.          Do_Blank_Line := FALSE;
  327.       END
  328.    ELSE
  329.       Do_Blank_Line := TRUE;
  330.                                    (* Open library file *)
  331.  
  332.    Open_File( LbrFileName , LbrFile, Lbr_Pos, Ierr );
  333.  
  334.                                    (* Set # directory entries = 1 so   *)
  335.                                    (* we can process actual directory. *)
  336.    Lbr_Dir_Size := 1;
  337.                                    (* Issue error message if library file *)
  338.                                    (* can't be opened.                    *)
  339.    IF ( Ierr <> 0 ) THEN
  340.       BEGIN
  341.          WRITELN( Output_File , DUPL( ' ' , 13 - LENGTH( LbrFileName ) ),
  342.                                 '     Can''t open library file ',LbrFileName );
  343.          IF Do_Printer_Format THEN
  344.             BEGIN
  345.                Lines_Left := Lines_Left - 1;
  346.                IF ( Lines_Left < 1 ) THEN
  347.                   Display_Page_Titles;
  348.             END;
  349.          EXIT;
  350.       END
  351.    ELSE IF ( NOT Expand_Arcs_In ) THEN
  352.       BEGIN
  353.  
  354.          WRITELN( Output_File );
  355.          WRITELN( Output_File );
  356.                                    (* Count lines left on page *)
  357.          IF Do_Printer_Format THEN
  358.             Lines_Left := Lines_Left - 1;
  359.  
  360.       END;
  361.                                    (* Pick up actual number of entries *)
  362.                                    (* in library.                      *)
  363.  
  364.    IF ( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) THEN
  365.       WITH Lbr_Entry DO
  366.          IF ( ( ( Flag OR Offset ) = 0 ) AND ( N_sec <> 0 ) ) THEN
  367.             Lbr_Dir_Size := N_Sec * 4 - 1
  368.          ELSE
  369.             Ierr := Format_Error;
  370.  
  371.                                    (* Loop over library entries and print *)
  372.                                    (* information about each entry.       *)
  373.    IF( Ierr = 0 ) THEN
  374.       WHILE( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) DO
  375.          Display_Lbr_Entry( Lbr_Entry );
  376.  
  377.                                    (* Print blank line after last entry   *)
  378.                                    (* in library, if we're expanding      *)
  379.                                    (* libraries right after listing them, *)
  380.                                    (* but only if library had any entries *)
  381.                                    (* listed.                             *)
  382.  
  383.    IF ( Expand_Arcs_In AND ( NOT Do_Blank_Line ) ) THEN
  384.       BEGIN
  385.          WRITELN( Output_File );
  386.          IF Do_Printer_Format THEN
  387.             Lines_Left := Lines_Left - 1;
  388.       END;
  389.  
  390.                                    (* Close library file *)
  391.    Close_File( LbrFile );
  392.                                    (* Restore previous left margin spacing *)
  393.  
  394.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  395.  
  396.                                    (* No file title *)
  397.    File_Title := '';
  398.  
  399. END   (* Display_Lbr_Contents *);
  400.