home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PIBCAT14.ZIP / PIBCATA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-29  |  14.1 KB  |  322 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_And_Time                                   *)
  26. (*                            --- convert DOS packed date/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     : WORD      (* Packed date *);
  44.                            Time     : WORD      (* Packed time *);
  45.                            CRC      : WORD      (* 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   : LONGINT              (* 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 ) THEN
  94.       Seek( 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 + 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;
  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    : LONGINT;
  149.    TimeDate   : LONGINT;
  150.    TimeDateW  : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  151.  
  152. BEGIN (* Display_Archive_Entry *)
  153.  
  154.    WITH Archive_Entry DO
  155.       BEGIN
  156.                                    (* Pick up file name *)
  157.  
  158.          Fname := COPY( FileName, 1, POS( #0 , FileName ) - 1 );
  159.  
  160.                                    (* See if this file matches the   *)
  161.                                    (* entry spec wildcard.  Exit if  *)
  162.                                    (* not.                           *)
  163.  
  164.          IF Use_Entry_Spec THEN
  165.             IF ( NOT Entry_Matches( Fname ) ) THEN
  166.                EXIT;
  167.                                    (* Make sure room on current page *)
  168.                                    (* for this entry name.           *)
  169.                                    (* If enough room, print blank    *)
  170.                                    (* line if requested.  This will  *)
  171.                                    (* only happen for first file.    *)
  172.          IF Do_Blank_Line THEN
  173.             BEGIN
  174.                IF ( Lines_Left < 2 ) THEN
  175.                   Display_Page_Titles
  176.                ELSE
  177.                   BEGIN
  178.                      WRITELN( Output_File );
  179.                      Lines_left := Lines_Left - 1;
  180.                   END;
  181.                Do_Blank_Line := FALSE;
  182.             END
  183.          ELSE
  184.             IF ( Lines_Left < 1 ) THEN
  185.                Display_Page_Titles;
  186.  
  187.                                    (* Add '. ' to front if we're     *)
  188.                                    (* expanding ARCs in main listing *)
  189.          IF Expand_Arcs_In THEN
  190.             Fname := '. ' + Fname;
  191.  
  192.                                    (* Get original file size *)
  193.  
  194.          RLength := Olength;
  195.  
  196.                                    (* Get date and time of creation *)
  197.  
  198.          TimeDateW[1] := Time;
  199.          TimeDateW[2] := Date;
  200.  
  201.          Dir_Convert_Date_And_Time( TimeDate , SDate , STime );
  202.  
  203.                                    (* Write out file name, length, date, time *)
  204.  
  205.          WRITE( Output_File , Left_Margin_String, '      ' , FName );
  206.  
  207.          FOR I := LENGTH( FName ) TO 14 DO
  208.             WRITE( Output_File , ' ' );
  209.  
  210.          WRITE  ( Output_File , RLength:8, '  ' );
  211.          WRITE  ( Output_File , SDate, '  ' );
  212.          WRITE  ( Output_File , STime );
  213.          WRITELN( Output_File );
  214.  
  215.                                    (* Count lines left on page *)
  216.          IF Do_Printer_Format THEN
  217.             Lines_Left := Lines_Left - 1;
  218.  
  219.                                    (* Increment total entry count *)
  220.  
  221.          Total_Entries := Total_Entries + 1;
  222.  
  223.                                    (* Increment total space used  *)
  224.  
  225.          Total_ESpace := Total_ESpace + RLength;
  226.  
  227.       END;
  228.  
  229. END (* Display_Archive_Entry *);
  230.  
  231. (*----------------------------------------------------------------------*)
  232.  
  233. BEGIN (* Display_Archive_Contents *)
  234.  
  235.                                    (* Set left margin spacing *)
  236.  
  237.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , ArcLbr_Indent );
  238.  
  239.                                    (* Set file title *)
  240.  
  241.    File_Title := Left_Margin_String + ' Archive file: ' + ArcFileName;
  242.  
  243.                                    (* Display archive file's name *)
  244.    IF Do_Printer_Format THEN
  245.       IF ( Lines_Left < 3 ) THEN
  246.          Display_Page_Titles;
  247.                                    (* If we're listing contents at end  *)
  248.                                    (* of directory, print archive name. *)
  249.                                    (* Do_Blank_Line flags whether we    *)
  250.                                    (* need to print blank line in entry *)
  251.                                    (* lister subroutine.  If listing    *)
  252.                                    (* inline, then it's true for the    *)
  253.                                    (* first file; otherwise it's false. *)
  254.                                    (* This is to prevent unnecessary    *)
  255.                                    (* blank lines in output listing     *)
  256.                                    (* when no files are selected from   *)
  257.                                    (* a given archive.                  *)
  258.    IF ( NOT Expand_Arcs_In ) THEN
  259.       BEGIN
  260.          WRITELN( Output_File ) ;
  261.          WRITE  ( Output_File , File_Title );
  262.          Lines_Left    := Lines_Left - 2;
  263.          Do_Blank_Line := FALSE;
  264.       END
  265.    ELSE
  266.       Do_Blank_Line := TRUE;
  267.                                    (* Try opening archive file for processing *)
  268.  
  269.    Open_File( ArcFileName , ArcFile, Archive_Pos, Ierr );
  270.  
  271.                                    (* Issue error message if open fails *)
  272.    IF ( Ierr <> 0 ) THEN
  273.       BEGIN
  274.          WRITELN( Output_File ,
  275.                   DUPL( ' ' , MAX( 0 , MIN( 12 , 13 - LENGTH( ArcFileName ) ) ) ),
  276.                   '     Can''t open archive file ',ArcFileName );
  277.          IF Do_Printer_Format THEN
  278.             BEGIN
  279.                Lines_Left := Lines_Left - 1;
  280.                IF ( Lines_Left < 1 ) THEN
  281.                   Display_Page_Titles;
  282.             END;
  283.          EXIT;
  284.       END
  285.    ELSE IF ( NOT Expand_Arcs_In ) THEN
  286.       BEGIN
  287.  
  288.          WRITELN( Output_File );
  289.          WRITELN( Output_File );
  290.                                    (* Count lines left on page *)
  291.          IF Do_Printer_Format THEN
  292.             Lines_Left := Lines_Left - 1;
  293.  
  294.       END;
  295.                                    (* Loop over entries in archive file *)
  296.  
  297.    WHILE( Get_Next_Archive_Entry( Archive_Entry , Ierr ) ) DO
  298.       Display_Archive_Entry( Archive_Entry );
  299.  
  300.                                    (* Print blank line after last entry   *)
  301.                                    (* in archive, if we're expanding      *)
  302.                                    (* archives right after listing them,  *)
  303.                                    (* but only if archive had any entries *)
  304.                                    (* listed.                             *)
  305.  
  306.    IF ( Expand_Arcs_In AND ( NOT Do_Blank_Line ) ) THEN
  307.       BEGIN
  308.          WRITELN( Output_File );
  309.          IF Do_Printer_Format THEN
  310.             Lines_Left := Lines_Left - 1;
  311.       END;
  312.                                    (* Close archive file *)
  313.    Close_File( ArcFile );
  314.                                    (* Restore previous left margin spacing *)
  315.  
  316.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  317.  
  318.                                    (* No file title *)
  319.    File_Title := '';
  320.  
  321. END   (* Display_Archive_Contents *);
  322.