home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / catalog / pibcat17.arc / PIBCATA.PAS < prev    next >
Pascal/Delphi Source File  |  1989-02-26  |  14KB  |  297 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. (*          Dir_Convert_Date_And_Time                                   *)
  23. (*          Start_Library_Listing                                       *)
  24. (*          End_Library_Listing                                         *)
  25. (*          Display_Page_Titles                                         *)
  26. (*          Entry_Matches                                               *)
  27. (*                                                                      *)
  28. (*----------------------------------------------------------------------*)
  29.  
  30. (*----------------------------------------------------------------------*)
  31. (*                  Map of Archive file entry header                    *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. TYPE
  35.    FNameType = ARRAY[1..13] OF CHAR;
  36.  
  37.    Archive_Entry_Type = RECORD
  38.                            Marker   : BYTE      (* Flags beginning of entry *);
  39.                            Version  : BYTE      (* Compression method       *);
  40.                            FileName : FNameType (* file and extension       *);
  41.                            Size     : LONGINT   (* Compressed size          *);
  42.                            Date     : WORD      (* Packed date              *);
  43.                            Time     : WORD      (* Packed time              *);
  44.                            CRC      : WORD      (* Cyclic Redundancy Check  *);
  45.                            OLength  : LONGINT   (* Original length          *);
  46.                         END;
  47.  
  48. CONST
  49.    Archive_Header_Length = 29      (* Length of an archive header entry *);
  50.    Archive_Marker        = 26      (* Marks start of an archive header  *);
  51.    Max_Subdirs           = 20      (* Maximum number of nested subdirs  *);
  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.  
  60.                                         (* Nested directory names in      *)
  61.                                         (* archive                        *)
  62.  
  63.    Subdir_Names  : ARRAY[1..Max_Subdirs] OF STRING[13];
  64.  
  65.    Subdir_Depth  : INTEGER              (* Current subdirectory in archive*);
  66.  
  67.    Display_Entry : BOOLEAN              (* TRUE to display this entry *);
  68.    Long_Name     : AnyStr               (* Long file name             *);
  69.  
  70. (*----------------------------------------------------------------------*)
  71. (*   Get_Next_Archive_Entry --- Get next header entry in archive        *)
  72. (*----------------------------------------------------------------------*)
  73.  
  74. FUNCTION Get_Next_Archive_Entry( VAR ArcEntry      : Archive_Entry_Type;
  75.                                  VAR Display_Entry : BOOLEAN;
  76.                                  VAR Error         : INTEGER ) : BOOLEAN;
  77.  
  78. (*----------------------------------------------------------------------*)
  79. (*                                                                      *)
  80. (*    Function:  Get_Next_Archive_Entry                                 *)
  81. (*                                                                      *)
  82. (*    Purpose:   Gets header information for next file in archive       *)
  83. (*                                                                      *)
  84. (*    Calling sequence:                                                 *)
  85. (*                                                                      *)
  86. (*       OK := Get_Next_Archive_Entry( VAR ArcEntry :                   *)
  87. (*                                         Archive_Entry_Type;          *)
  88. (*                                     VAR Display_Entry : BOOLEAN;     *)
  89. (*                                     VAR Error    : INTEGER ) :       *)
  90. (*                                     BOOLEAN;                         *)
  91. (*                                                                      *)
  92. (*          ArcEntry      --- Header data for next file in archive      *)
  93. (*          Display_Entry --- TRUE to display this entry                *)
  94. (*          Error         --- Error flag                                *)
  95. (*          OK            --- TRUE if header successfully found         *)
  96. (*                                                                      *)
  97. (*----------------------------------------------------------------------*)
  98.  
  99. BEGIN (* Get_Next_Archive_Entry *)
  100.                                    (* Assume no error to start *)
  101.    Error := 0;
  102.                                    (* Assume we don't display this   *)
  103.                                    (* entry.                         *)
  104.    Display_Entry := FALSE;
  105.                                    (* Except first time, move to     *)
  106.                                    (* next supposed header record in *)
  107.                                    (* archive.                       *)
  108.  
  109.    IF ( Archive_Pos <> 0 ) THEN
  110.       Seek( ArcFile, Archive_Pos );
  111.  
  112.                                    (* Read in the file header entry. *)
  113.  
  114.    BlockRead( ArcFile, ArcEntry, Archive_Header_Length, Bytes_Read );
  115.    Error := 0;
  116.                                    (* If wrong size read, or header marker *)
  117.                                    (* byte is incorrect, report archive    *)
  118.                                    (* format error.                        *)
  119.  
  120.    IF ( ( Bytes_Read < 2                    ) OR
  121.         ( ArcEntry.Marker <> Archive_Marker ) ) THEN
  122.       Error := Format_Error
  123.    ELSE                            (* Header looks ok -- figure out *)
  124.                                    (* whaty kind of header it is.   *)
  125.       WITH ArcEntry DO
  126.          CASE Version OF
  127.                                    (* End of archive marker *)
  128.  
  129.             0       : Error := End_Of_File;
  130.  
  131.                                    (* Compressed file *)
  132.  
  133.             1 .. 19 : BEGIN
  134.                                    (* Get position of next archive header *)
  135.  
  136.                          IF ( Bytes_Read < Archive_Header_Length ) THEN
  137.                             Error := Format_Error
  138.                          ELSE
  139.                             BEGIN
  140.  
  141.                                Archive_Pos := Archive_Pos + Size +
  142.                                               Archive_Header_Length;
  143.  
  144.                                    (* Adjust for older archives *)
  145.  
  146.                                IF ( Version = 1 ) THEN
  147.                                   BEGIN
  148.                                      OLength := Size;
  149.                                      Version := 2;
  150.                                      DEC( Archive_Pos , 2 );
  151.                                   END;
  152.  
  153.                                    (* Display this entry *)
  154.  
  155.                                Display_Entry := TRUE;
  156.  
  157.                             END;
  158.  
  159.                       END;
  160.  
  161.             30      : BEGIN        (* Subdirectory begins *)
  162.  
  163.                                    (* If there is room, add this *)
  164.                                    (* subdirectory to current    *)
  165.                                    (* nesting list.              *)
  166.  
  167.                          IF ( Bytes_Read < Archive_Header_Length ) THEN
  168.                             Error := Format_Error
  169.                          ELSE IF ( Subdir_Depth < Max_Subdirs ) THEN
  170.                             BEGIN
  171.  
  172.                                INC( Subdir_Depth );
  173.  
  174.                                Subdir_Names[ Subdir_Depth ] :=
  175.                                   COPY( FileName, 1,
  176.                                         PRED( POS( #0 , FileName ) ) );
  177.  
  178.                             END
  179.                          ELSE
  180.                             Error := Too_Many_Subs;
  181.  
  182.                          Archive_Pos := Archive_Pos + Archive_Header_Length;
  183.  
  184.                       END;
  185.  
  186.             31      : BEGIN        (* End of subdirectory *)
  187.  
  188.                                    (* Remove this subdirectory from *)
  189.                                    (* current nesting               *)
  190.  
  191.                          IF ( Subdir_Depth > 0 ) THEN
  192.                             DEC( Subdir_Depth );
  193.  
  194.                                    (* Position past header          *)
  195.  
  196.                          Archive_Pos := Archive_Pos + 2;
  197.  
  198.                       END;
  199.  
  200.             ELSE                      (* Skip over other header types  *)
  201.  
  202.                       IF ( Bytes_Read < Archive_Header_Length ) THEN
  203.                          Error := Format_Error
  204.                       ELSE
  205.                          Archive_Pos := Archive_Pos + Size +
  206.                                         Archive_Header_Length;
  207.  
  208.          END (* CASE *);
  209.                                     (* Report success/failure to calling *)
  210.                                     (* routine.                          *)
  211.  
  212.    Get_Next_Archive_Entry := ( Error = 0 );
  213.  
  214. END   (* Get_Next_Archive_Entry *);
  215.  
  216. (*----------------------------------------------------------------------*)
  217. (*      Display_Archive_Entry --- Display archive file entry info       *)
  218. (*----------------------------------------------------------------------*)
  219.  
  220. PROCEDURE Display_Archive_Entry( Archive_Entry : Archive_Entry_Type );
  221.  
  222. VAR
  223.    I          : INTEGER;
  224.    FName      : AnyStr;
  225.    TimeDate   : LONGINT;
  226.    TimeDateW  : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  227.  
  228. BEGIN (* Display_Archive_Entry *)
  229.  
  230.    WITH Archive_Entry DO
  231.       BEGIN
  232.                                    (* Pick up file name *)
  233.  
  234.          FName    := COPY( FileName, 1, PRED( POS( #0 , FileName ) ) );
  235.  
  236.                                    (* See if this file matches the   *)
  237.                                    (* entry spec wildcard.  Exit if  *)
  238.                                    (* not.                           *)
  239.          IF Use_Entry_Spec THEN
  240.             IF ( NOT Entry_Matches( FName ) ) THEN
  241.                EXIT;
  242.                                    (* Get date and time of creation *)
  243.          TimeDateW[ 1 ] := Time;
  244.          TimeDateW[ 2 ] := Date;
  245.                                    (* See if we're to write out *)
  246.                                    (* long file names.  If so,  *)
  247.                                    (* get subdirectory path     *)
  248.                                    (* followed by file name.    *)
  249.          Long_Name := '';
  250.  
  251.          IF Show_Long_File_Names THEN
  252.             IF ( Subdir_Depth > 0 ) THEN
  253.                BEGIN
  254.  
  255.                   FOR I := 1 TO Subdir_Depth DO
  256.                      Long_Name := Long_Name + Subdir_Names[ I ] + '\';
  257.  
  258.                   Long_Name := Long_Name + FName;
  259.  
  260.                END;
  261.                                    (* Display info for this entry *)
  262.  
  263.          Display_One_Entry( FName, Olength, TimeDate, ArcFileName,
  264.                             Current_Subdirectory, Long_Name );
  265.  
  266.       END;
  267.  
  268. END (* Display_Archive_Entry *);
  269.  
  270. (*----------------------------------------------------------------------*)
  271.  
  272. BEGIN (* Display_Archive_Contents *)
  273.  
  274.                                    (* Open archive file and initialize *)
  275.                                    (* contents display.                *)
  276.  
  277.    IF Start_Contents_Listing( ' Archive file: ',
  278.                               Current_Subdirectory + ArcFileName, ArcFile,
  279.                               Archive_Pos, Ierr ) THEN
  280.       BEGIN
  281.                                    (* No subdirectories yet encountered *)
  282.                                    (* in archive file                   *)
  283.          Subdir_Depth := 0;
  284.                                    (* Loop over entries in archive file *)
  285.  
  286.          WHILE( Get_Next_Archive_Entry( Archive_Entry , Display_Entry , Ierr ) ) DO
  287.             IF Display_Entry THEN
  288.                Display_Archive_Entry( Archive_Entry );
  289.  
  290.                                    (* Close library files, complete display *)
  291.  
  292.          End_Contents_Listing( ArcFile );
  293.  
  294.       END;
  295.  
  296. END   (* Display_Archive_Contents *);
  297.