home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBCAT.ZIP / PIBCATA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-30  |  14.0 KB  |  317 lines
  1. (*----------------------------------------------------------------------*)
  2. (*     Display_Archive_Contents --- Display contents of archive file    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Archive_Contents( ArcFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Archive_Contents                               *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of an archive (.ARC file)            *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Archive_Contents( ArcFileName : AnyStr );              *)
  16. (*                                                                      *)
  17. (*          ArcFileName --- name of archive file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Long_To_Real      --- convert long (32 bit) INTEGER to real *)
  25. (*          Dir_Convert_Date  --- convert DOS packed date to string     *)
  26. (*          Dir_Convert_Time  --- convert DOS packed time to string     *)
  27. (*          Display_File_Info --- display information about a file      *)
  28. (*          Open_File         --- open a file                           *)
  29. (*          Close_File        --- close a file                          *)
  30. (*                                                                      *)
  31. (*----------------------------------------------------------------------*)
  32.  
  33. (*----------------------------------------------------------------------*)
  34. (*                  Map of Archive file entry header                    *)
  35. (*----------------------------------------------------------------------*)
  36.  
  37. TYPE
  38.    Archive_Entry_Type = RECORD
  39.                            Marker   : BYTE      (* Flags beginning of entry *);
  40.                            Version  : BYTE      (* Compression method       *);
  41.                            Filename : ARRAY[1..13] OF CHAR  (* file and extension *);
  42.                            Size     : LongInt   (* Compressed size *);
  43.                            Date     : INTEGER   (* Packed date *);
  44.                            Time     : INTEGER   (* Packed time *);
  45.                            CRC      : INTEGER   (* Cyclic Redundancy Check *);
  46.                            OLength  : LongInt   (* Original length *);
  47.                         END;
  48.  
  49. CONST
  50.    Archive_Header_Length = 29      (* Length of an archive header entry *);
  51.    Archive_Marker        = 26      (* Marks start of an archive header  *);
  52.  
  53. VAR
  54.    ArcFile       : FILE                 (* Archive file to be read        *);
  55.    Archive_Entry : Archive_Entry_Type   (* Header for one file in archive *);
  56.    Archive_Pos   : REAL                 (* Current byte offset in archive *);
  57.    Bytes_Read    : INTEGER              (* # bytes read from archive file *);
  58.    Ierr          : INTEGER              (* Error flag                     *);
  59.    Do_Blank_Line : BOOLEAN              (* TRUE to print blank line       *);
  60.  
  61. (*----------------------------------------------------------------------*)
  62. (*   Get_Next_Archive_Entry --- Get next header entry in archive        *)
  63. (*----------------------------------------------------------------------*)
  64.  
  65. FUNCTION Get_Next_Archive_Entry( VAR ArcEntry : Archive_Entry_Type;
  66.                                  VAR Error    : INTEGER ) : BOOLEAN;
  67.  
  68. (*----------------------------------------------------------------------*)
  69. (*                                                                      *)
  70. (*    Function:  Get_Next_Archive_Entry                                 *)
  71. (*                                                                      *)
  72. (*    Purpose:   Gets header information for next file in archive       *)
  73. (*                                                                      *)
  74. (*    Calling sequence:                                                 *)
  75. (*                                                                      *)
  76. (*       OK := Get_Next_Archive_Entry( VAR ArcEntry :                   *)
  77. (*                                         Archive_Entry_Type;          *)
  78. (*                                     VAR Error    : INTEGER );        *)
  79. (*                                                                      *)
  80. (*          ArcEntry --- Header data for next file in archive           *)
  81. (*          Error    --- Error flag                                     *)
  82. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  83. (*                                                                      *)
  84. (*----------------------------------------------------------------------*)
  85.  
  86. BEGIN (* Get_Next_Archive_Entry *)
  87.                                    (* Assume no error to start *)
  88.    Error := 0;
  89.                                    (* Except first time, move to     *)
  90.                                    (* next supposed header record in *)
  91.                                    (* archive.                       *)
  92.  
  93.    IF ( Archive_Pos <> 0.0 ) THEN
  94.       LongSeek( ArcFile, Archive_Pos );
  95.  
  96.                                    (* Read in the file header entry. *)
  97.  
  98.    BlockRead( ArcFile, ArcEntry, Archive_Header_Length, Bytes_Read );
  99.    Error := 0;
  100.                                    (* If wrong size read, or header marker *)
  101.                                    (* byte is incorrect, report archive    *)
  102.                                    (* format error.                        *)
  103.  
  104.    IF ( ( Bytes_Read < Archive_Header_Length ) OR
  105.         ( ArcEntry.Marker <> Archive_Marker ) ) THEN
  106.       Error := Format_Error
  107.    ELSE                            (* Header looks ok -- see if it *)
  108.                                    (* is the end of file marker.   *)
  109.  
  110.       IF ( ArcEntry.Version = 0 ) THEN
  111.          Error := End_Of_File
  112.       ELSE                         (* Not end of file marker -- get entry data. *)
  113.          WITH ArcEntry DO
  114.             BEGIN
  115.                                    (* Get position of next archive header *)
  116.  
  117.                Archive_Pos := Archive_Pos + Long_To_Real( Size ) +
  118.                               Archive_Header_Length;
  119.  
  120.                                    (* Adjust for older archives *)
  121.  
  122.                IF ( Version = 1 ) THEN
  123.                   BEGIN
  124.                      OLength     := Size;
  125.                      Version     := 2;
  126.                      Archive_Pos := Archive_Pos - 2.0;
  127.                   END;
  128.  
  129.             END;
  130.                                     (* Report success/failure to calling *)
  131.                                     (* routine.                          *)
  132.  
  133.    Get_Next_Archive_Entry := ( Error = 0 );
  134.  
  135. END   (* Get_Next_Archive_Entry *);
  136.  
  137. (*----------------------------------------------------------------------*)
  138. (*      Display_Archive_Entry --- Display archive header entry          *)
  139. (*----------------------------------------------------------------------*)
  140.  
  141. PROCEDURE Display_Archive_Entry( Archive_Entry : Archive_Entry_Type );
  142.  
  143. VAR
  144.    SDate      : STRING[10];
  145.    STime      : STRING[12];
  146.    I          : INTEGER;
  147.    FName      : AnyStr;
  148.    RLength    : REAL;
  149.  
  150. BEGIN (* Display_Archive_Entry *)
  151.  
  152.    WITH Archive_Entry DO
  153.       BEGIN
  154.                                    (* Pick up file name *)
  155.  
  156.          Fname := COPY( FileName, 1, POS( #0 , FileName ) - 1 );
  157.  
  158.                                    (* See if this file matches the   *)
  159.                                    (* entry spec wildcard.  Exit if  *)
  160.                                    (* not.                           *)
  161.  
  162.          IF Use_Entry_Spec THEN
  163.             IF ( NOT Entry_Matches( Fname ) ) THEN
  164.                EXIT;
  165.                                    (* Make sure room on current page *)
  166.                                    (* for this entry name.           *)
  167.                                    (* If enough room, print blank    *)
  168.                                    (* line if requested.  This will  *)
  169.                                    (* only happen for first file.    *)
  170.          IF Do_Blank_Line THEN
  171.             BEGIN
  172.                IF ( Lines_Left < 2 ) THEN
  173.                   Display_Page_Titles
  174.                ELSE
  175.                   BEGIN
  176.                      WRITELN( Output_File );
  177.                      Lines_left := Lines_Left - 1;
  178.                   END;
  179.                Do_Blank_Line := FALSE;
  180.             END
  181.          ELSE
  182.             IF ( Lines_Left < 1 ) THEN
  183.                Display_Page_Titles;
  184.  
  185.                                    (* Add '. ' to front if we're     *)
  186.                                    (* expanding ARCs in main listing *)
  187.          IF Expand_Arcs_In THEN
  188.             Fname := '. ' + Fname;
  189.  
  190.                                    (* Get original file size *)
  191.  
  192.          RLength := Long_To_Real( Olength );
  193.  
  194.                                    (* Get date and time of creation *)
  195.  
  196.          Dir_Convert_Date( Date , SDate );
  197.          Dir_Convert_Time( Time , STime );
  198.  
  199.                                    (* Write out file name, length, date, time *)
  200.  
  201.          WRITE( Output_File , Left_Margin_String, '      ' , FName );
  202.  
  203.          FOR I := LENGTH( FName ) TO 14 DO
  204.             WRITE( Output_File , ' ' );
  205.  
  206.          WRITE  ( Output_File , RLength:8:0, '  ' );
  207.          WRITE  ( Output_File , SDate, '  ' );
  208.          WRITE  ( Output_File , STime );
  209.          WRITELN( Output_File );
  210.  
  211.                                    (* Count lines left on page *)
  212.          IF Do_Printer_Format THEN
  213.             Lines_Left := Lines_Left - 1;
  214.  
  215.                                    (* Increment total entry count *)
  216.  
  217.          Total_Entries := Total_Entries + 1;
  218.  
  219.                                    (* Increment total space used  *)
  220.  
  221.          Total_ESpace := Total_ESpace + RLength;
  222.  
  223.       END;
  224.  
  225. END (* Display_Archive_Entry *);
  226.  
  227. (*----------------------------------------------------------------------*)
  228.  
  229. BEGIN (* Display_Archive_Contents *)
  230.  
  231.                                    (* Set left margin spacing *)
  232.  
  233.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , ArcLbr_Indent );
  234.  
  235.                                    (* Set file title *)
  236.  
  237.    File_Title := Left_Margin_String + ' Archive file: ' + ArcFileName;
  238.  
  239.                                    (* Display archive file's name *)
  240.    IF Do_Printer_Format THEN
  241.       IF ( Lines_Left < 3 ) THEN
  242.          Display_Page_Titles;
  243.                                    (* If we're listing contents at end  *)
  244.                                    (* of directory, print archive name. *)
  245.                                    (* Do_Blank_Line flags whether we    *)
  246.                                    (* need to print blank line in entry *)
  247.                                    (* lister subroutine.  If listing    *)
  248.                                    (* inline, then it's true for the    *)
  249.                                    (* first file; otherwise it's false. *)
  250.                                    (* This is to prevent unnecessary    *)
  251.                                    (* blank lines in output listing     *)
  252.                                    (* when no files are selected from   *)
  253.                                    (* a given archive.                  *)
  254.    IF ( NOT Expand_Arcs_In ) THEN
  255.       BEGIN
  256.          WRITELN( Output_File ) ;
  257.          WRITE  ( Output_File , File_Title );
  258.          Lines_Left    := Lines_Left - 2;
  259.          Do_Blank_Line := FALSE;
  260.       END
  261.    ELSE
  262.       Do_Blank_Line := TRUE;
  263.                                    (* Try opening archive file for processing *)
  264.  
  265.    Open_File( ArcFileName , ArcFile, Archive_Pos, Ierr );
  266.  
  267.                                    (* Issue error message if open fails *)
  268.    IF ( Ierr <> 0 ) THEN
  269.       BEGIN
  270.          WRITELN( Output_File , DUPL( ' ' , 13 - LENGTH( ArcFileName ) ),
  271.                                 '     Can''t open archive file ',ArcFileName );
  272.          IF Do_Printer_Format THEN
  273.             BEGIN
  274.                Lines_Left := Lines_Left - 1;
  275.                IF ( Lines_Left < 1 ) THEN
  276.                   Display_Page_Titles;
  277.             END;
  278.          EXIT;
  279.       END
  280.    ELSE IF ( NOT Expand_Arcs_In ) THEN
  281.       BEGIN
  282.  
  283.          WRITELN( Output_File );
  284.          WRITELN( Output_File );
  285.                                    (* Count lines left on page *)
  286.          IF Do_Printer_Format THEN
  287.             Lines_Left := Lines_Left - 1;
  288.  
  289.       END;
  290.                                    (* Loop over entries in archive file *)
  291.  
  292.    WHILE( Get_Next_Archive_Entry( Archive_Entry , Ierr ) ) DO
  293.       Display_Archive_Entry( Archive_Entry );
  294.  
  295.                                    (* Print blank line after last entry   *)
  296.                                    (* in archive, if we're expanding      *)
  297.                                    (* archives right after listing them,  *)
  298.                                    (* but only if archive had any entries *)
  299.                                    (* listed.                             *)
  300.  
  301.    IF ( Expand_Arcs_In AND ( NOT Do_Blank_Line ) ) THEN
  302.       BEGIN
  303.          WRITELN( Output_File );
  304.          IF Do_Printer_Format THEN
  305.             Lines_Left := Lines_Left - 1;
  306.       END;
  307.                                    (* Close archive file *)
  308.    Close_File( ArcFile );
  309.                                    (* Restore previous left margin spacing *)
  310.  
  311.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  312.  
  313.                                    (* No file title *)
  314.    File_Title := '';
  315.  
  316. END   (* Display_Archive_Contents *);
  317.