home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PIBCAT14.ZIP / PIBCATL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-29  |  16.6 KB  |  404 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: WORD                   (* Offset within Library *);
  42.                        N_Sec : WORD                   (* Number of 128-byte sectors *);
  43.                        CRC   : WORD                   (* CRC (optional) *);
  44.                        Date  : WORD                   (* # days since 1/1/1978 *);
  45.                        UDate : WORD                   (* Date of last update *);
  46.                        Time  : WORD                   (* Packed time *);
  47.                        UTime : WORD                   (* 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       : LONGINT         (* 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 ) THEN
  99.                Seek( 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    : LONGINT;
  202.    RSize      : LONGINT;
  203.    DateTime   : LONGINT;
  204.    DTWord     : ARRAY[1..2] OF WORD ABSOLUTE DateTime;
  205.  
  206. BEGIN (* Display_Lbr_Entry *)
  207.  
  208.    WITH Lbr_Entry DO
  209.       BEGIN
  210.                                    (* Pick up file name *)
  211.  
  212.          FName := TRIM( Name );
  213.  
  214.          IF ( Ext <> '   ' ) THEN
  215.             FName   := FName + '.' + Ext;
  216.  
  217.                                    (* See if this file matches the   *)
  218.                                    (* entry spec wildcard.  Exit if  *)
  219.                                    (* not.                           *)
  220.  
  221.          IF Use_Entry_Spec THEN
  222.             IF ( NOT Entry_Matches( Fname ) ) THEN
  223.                EXIT;
  224.  
  225.                                    (* Make sure room on current page *)
  226.                                    (* for this entry name.           *)
  227.                                    (* If enough room, print blank    *)
  228.                                    (* line if requested.  This will  *)
  229.                                    (* only happen for first file.    *)
  230.          IF Do_Blank_Line THEN
  231.             BEGIN
  232.                IF ( Lines_Left < 2 ) THEN
  233.                   Display_Page_Titles
  234.                ELSE
  235.                   BEGIN
  236.                      WRITELN( Output_File );
  237.                      Lines_left := Lines_Left - 1;
  238.                   END;
  239.                Do_Blank_Line := FALSE;
  240.             END
  241.          ELSE
  242.             IF ( Lines_Left < 1 ) THEN
  243.                Display_Page_Titles;
  244.  
  245.                                    (* Add '. ' to front if we're     *)
  246.                                    (* expanding LBRs in main listing *)
  247.          IF Expand_Arcs_In THEN
  248.             Fname := '. ' + Fname;
  249.  
  250.                                    (* Write out file name *)
  251.  
  252.          WRITE( Output_File , Left_Margin_String , '      ' , FName );
  253.  
  254.          FOR I := LENGTH( FName ) TO 14 DO
  255.             WRITE( Output_File , ' ' );
  256.  
  257.                                    (* Convert length in sectors to *)
  258.                                    (* length in bytes.             *)
  259.  
  260.          RLength := N_Sec * 128;
  261.          WRITE( Output_File , RLength:8, '  ' );
  262.  
  263.                                    (* If time/date specified, output *)
  264.                                    (* them.                          *)
  265.          IF ( Date > 0 ) THEN
  266.             BEGIN
  267.                DTWord[1] := Time;
  268.                DTWord[2] := Date;
  269.                Dir_Convert_Date_And_Time( DateTime , SDate , STime );
  270.             END
  271.          ELSE
  272.             BEGIN
  273.                SDate := '        ';
  274.                STime := '        ';
  275.             END;
  276.  
  277.          WRITE( Output_File , SDate, '  ' );
  278.          WRITE( Output_File , STime );
  279.          WRITELN( Output_File );
  280.  
  281.                                    (* Count lines left on page *)
  282.          IF Do_Printer_Format THEN
  283.             Lines_Left := Lines_Left - 1;
  284.  
  285.                                    (* Increment total entry count *)
  286.  
  287.          Total_Entries := Total_Entries + 1;
  288.  
  289.                                    (* Increment total space used  *)
  290.  
  291.          Total_ESpace := Total_ESpace + RLength;
  292.  
  293.       END;
  294.  
  295. END (* Display_Lbr_Entry *);
  296.  
  297. (*----------------------------------------------------------------------*)
  298.  
  299. BEGIN (* Display_Lbr_Contents *)
  300.  
  301.                                    (* Set library left margin spacing *)
  302.  
  303.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , ArcLbr_Indent );
  304.  
  305.                                    (* Set file title *)
  306.  
  307.    File_Title := Left_Margin_String + ' Library file: ' + LbrFileName;
  308.  
  309.                                    (* Display library file's name *)
  310.    IF Do_Printer_Format THEN
  311.       IF Lines_Left < 3 THEN
  312.          Display_Page_Titles;
  313.                                    (* If we're listing contents at end  *)
  314.                                    (* of directory, print library name. *)
  315.                                    (* Do_Blank_Line flags whether we    *)
  316.                                    (* need to print blank line in entry *)
  317.                                    (* lister subroutine.  If listing    *)
  318.                                    (* inline, then it's true for the    *)
  319.                                    (* first file; otherwise it's false. *)
  320.                                    (* This is to prevent unnecessary    *)
  321.                                    (* blank lines in output listing     *)
  322.                                    (* when no files are selected from   *)
  323.                                    (* a given library.                  *)
  324.    IF ( NOT Expand_Arcs_In ) THEN
  325.       BEGIN
  326.          WRITELN( Output_File ) ;
  327.          WRITE  ( Output_File , File_Title );
  328.          Lines_Left    := Lines_Left - 2;
  329.          Do_Blank_Line := FALSE;
  330.       END
  331.    ELSE
  332.       Do_Blank_Line := TRUE;
  333.                                    (* Open library file *)
  334.  
  335.    Open_File( LbrFileName , LbrFile, Lbr_Pos, Ierr );
  336.  
  337.                                    (* Set # directory entries = 1 so   *)
  338.                                    (* we can process actual directory. *)
  339.    Lbr_Dir_Size := 1;
  340.                                    (* Issue error message if library file *)
  341.                                    (* can't be opened.                    *)
  342.    IF ( Ierr <> 0 ) THEN
  343.       BEGIN
  344.          WRITELN( Output_File ,
  345.                   DUPL( ' ' , MAX( 0 , MIN( 12 , 13 - LENGTH( LbrFileName ) ) ) ),
  346.                   '     Can''t open library file ',LbrFileName );
  347.          IF Do_Printer_Format THEN
  348.             BEGIN
  349.                Lines_Left := Lines_Left - 1;
  350.                IF ( Lines_Left < 1 ) THEN
  351.                   Display_Page_Titles;
  352.             END;
  353.          EXIT;
  354.       END
  355.    ELSE IF ( NOT Expand_Arcs_In ) THEN
  356.       BEGIN
  357.  
  358.          WRITELN( Output_File );
  359.          WRITELN( Output_File );
  360.                                    (* Count lines left on page *)
  361.          IF Do_Printer_Format THEN
  362.             Lines_Left := Lines_Left - 1;
  363.  
  364.       END;
  365.                                    (* Pick up actual number of entries *)
  366.                                    (* in library.                      *)
  367.  
  368.    IF ( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) THEN
  369.       WITH Lbr_Entry DO
  370.          IF ( ( ( Flag OR Offset ) = 0 ) AND ( N_Sec <> 0 ) ) THEN
  371.             Lbr_Dir_Size := N_Sec * 4 - 1
  372.          ELSE
  373.             Ierr := Format_Error;
  374.  
  375.                                    (* Loop over library entries and print *)
  376.                                    (* information about each entry.       *)
  377.    IF( Ierr = 0 ) THEN
  378.       WHILE( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) DO
  379.          Display_Lbr_Entry( Lbr_Entry );
  380.  
  381.                                    (* Print blank line after last entry   *)
  382.                                    (* in library, if we're expanding      *)
  383.                                    (* libraries right after listing them, *)
  384.                                    (* but only if library had any entries *)
  385.                                    (* listed.                             *)
  386.  
  387.    IF ( Expand_Arcs_In AND ( NOT Do_Blank_Line ) ) THEN
  388.       BEGIN
  389.          WRITELN( Output_File );
  390.          IF Do_Printer_Format THEN
  391.             Lines_Left := Lines_Left - 1;
  392.       END;
  393.  
  394.                                    (* Close library file *)
  395.    Close_File( LbrFile );
  396.                                    (* Restore previous left margin spacing *)
  397.  
  398.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  399.  
  400.                                    (* No file title *)
  401.    File_Title := '';
  402.  
  403. END   (* Display_Lbr_Contents *);
  404.