home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / catalog / pibcat17.arc / PIBCATK.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-31  |  19KB  |  413 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Display_ZIP_Contents --- Display contents of ZIP file        *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_ZIP_Contents( ZIPFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_ZIP_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a ZIP file                        *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_ZIP_Contents( ZIPFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          ZIPFileName --- name of ZIP file whose contents are to be   *)
  18. (*                          listed.                                     *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Get_Unix_Date     --- convert Unix date to string           *)
  25. (*          Open_File         --- open a file                           *)
  26. (*          Close_File        --- close a file                          *)
  27. (*          Entry_Matches     --- Perform wildcard match                *)
  28. (*          Display_Page_Titles                                         *)
  29. (*                            --- Display titles at top of page         *)
  30. (*          DUPL              --- Duplicate a character into a string   *)
  31. (*                                                                      *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. (*----------------------------------------------------------------------*)
  35. (*               Map of ZIP file entry headers                          *)
  36. (*----------------------------------------------------------------------*)
  37.  
  38. CONST
  39.    ZIP_Central_Header_Signature  = $02014B50;
  40.    ZIP_Local_Header_Signature    = $04034B50;
  41.    ZIP_End_Central_Dir_Signature = $06054B50;
  42.  
  43.    Central_Dir_Found             = 5;
  44.  
  45. TYPE
  46.                                    (* Structure of a local file header *)
  47.    ZIP_Local_Header_Type =
  48.       RECORD
  49.          Signature           : LONGINT  (* Header signature        *);
  50.          Version             : WORD     (* Vers. needed to extract *);
  51.          BitFlag             : WORD     (* General flags           *);
  52.          CompressionMethod   : WORD     (* Compression type used   *);
  53.          FileTime            : WORD     (* File creation time      *);
  54.          FileDate            : WORD     (* File creation date      *);
  55.          CRC32               : LONGINT  (* 32-bit CRC of file      *);
  56.          CompressedSize      : LONGINT  (* Compressed size of file *);
  57.          UnCompressedSize    : LONGINT  (* Original size of file   *);
  58.          FileNameLength      : WORD     (* Length of file name     *);
  59.          ExtraFieldLength    : WORD     (* Length of extra stuff   *);
  60.       END;
  61.  
  62.                                    (* Structure of the central *)
  63.                                    (* directory record         *)
  64.    ZIP_Central_Header_Type =
  65.       RECORD
  66.           Signature           : LONGINT (* Header signature        *);
  67.           VersionMadeBy       : WORD    (* System id/program vers. *);
  68.           VersionNeeded       : WORD    (* Vers. needed to extract *);
  69.           BitFlag             : WORD    (* General flags           *);
  70.           CompressionMethod   : WORD    (* Compression type used   *);
  71.           FileTime            : WORD    (* File creation time      *);
  72.           FileDate            : WORD    (* File creation date      *);
  73.           CRC32               : LONGINT (* 32-bit CRC of file      *);
  74.           CompressedSize      : LONGINT (* Compressed size of file *);
  75.           UnCompressedSize    : LONGINT (* Original size of file   *);
  76.           FileNameLength      : WORD    (* Length of file name     *);
  77.           ExtraFieldLength    : WORD    (* Length of extra stuff   *);
  78.           CommentFieldLength  : WORD    (* Length of comments      *);
  79.           DiskStartNumber     : WORD    (* Disk # file starts on   *);
  80.           InternalAttributes  : WORD    (* Text/non-text flags     *);
  81.           ExternalAttributes  : LONGINT (* File system attributes  *);
  82.           LocalHeaderOffset   : LONGINT (* Where local hdr starts  *);
  83.       END;
  84.  
  85. VAR
  86.    ZIPFile       : FILE         (* ZIP file to be read             *);
  87.  
  88.    ZIP_Entry     : ZIP_Central_Header_Type (* Central header       *);
  89.  
  90.    ZIP_Pos       : LONGINT      (* Current byte offset in ZIP file *);
  91.    Bytes_Read    : INTEGER      (* # bytes read from ZIP file file *);
  92.    Ierr          : INTEGER      (* Error flag                      *);
  93.    File_Name     : AnyStr       (* File name of entry in ZIP file  *);
  94.  
  95. (*----------------------------------------------------------------------*)
  96. (* Get_Next_ZIP_Local_Header --- Get next local header in ZIP file      *)
  97. (*----------------------------------------------------------------------*)
  98.  
  99. FUNCTION Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header :
  100.                                         ZIP_Local_Header_Type;
  101.                                     VAR Error : INTEGER  ) : BOOLEAN;
  102.  
  103. (*----------------------------------------------------------------------*)
  104. (*                                                                      *)
  105. (*    Function:  Get_Next_ZIP_Local_Header                              *)
  106. (*                                                                      *)
  107. (*    Purpose:   Gets next local header record in ZIP file              *)
  108. (*                                                                      *)
  109. (*    Calling sequence:                                                 *)
  110. (*                                                                      *)
  111. (*       OK := Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header:         *)
  112. (*                                            ZIP_Local_Header_Type;    *)
  113. (*                                        VAR Error : INTEGER ) :       *)
  114. (*                                        BOOLEAN;                      *)
  115. (*                                                                      *)
  116. (*          ZIP_Local_Header --- Local header data                      *)
  117. (*          Error            --- Error flag                             *)
  118. (*          OK               --- TRUE if header successfully found      *)
  119. (*                                                                      *)
  120. (*----------------------------------------------------------------------*)
  121.  
  122. BEGIN (* Get_Next_ZIP_Local_Header *)
  123.  
  124.                                    (* Assume no error to start       *)
  125.    Error := 0;
  126.                                    (* Position file                  *)
  127.    Seek( ZIPFile , ZIP_Pos );
  128.                                    (* Read in the file header entry. *)
  129.  
  130.    IF ( IOResult <> 0 ) THEN
  131.       Error := Format_Error
  132.  
  133.    ELSE
  134.       BEGIN
  135.  
  136.          BlockRead( ZIPFile, ZIP_Local_Header, SIZEOF( ZIP_Local_Header ),
  137.                     Bytes_Read );
  138.  
  139.                                    (* If wrong size read, or header marker *)
  140.                                    (* byte is incorrect, report ZIP file   *)
  141.                                    (* format error.                        *)
  142.  
  143.          IF ( ( IOResult <> 0 ) OR
  144.               ( Bytes_Read < SIZEOF( ZIP_Local_Header_Type ) ) ) THEN
  145.             Error := Format_Error
  146.          ELSE
  147.                                     (* Check for a legitimate header type  *)
  148.  
  149.             IF ( ZIP_Local_Header.Signature = ZIP_Local_Header_Signature ) THEN
  150.                BEGIN (* Local header -- skip it and associated data *)
  151.  
  152.                   ZIP_Pos := ZIP_Pos + ZIP_Local_Header.FileNameLength +
  153.                                        ZIP_Local_Header.ExtraFieldLength +
  154.                                        ZIP_Local_Header.CompressedSize +
  155.                                        SIZEOF( Zip_Local_Header_Type );
  156.                END
  157.  
  158.             ELSE IF ( ZIP_Local_Header.Signature = ZIP_Central_Header_Signature ) THEN
  159.                BEGIN (* Central header -- we want this *)
  160.  
  161.                   Error := Central_Dir_Found;
  162.  
  163.                END
  164.  
  165.             ELSE IF ( ZIP_Local_Header.Signature = ZIP_End_Central_Dir_Signature ) THEN
  166.                Error := End_Of_File;
  167.  
  168.       END;
  169.                                     (* Report success/failure to calling *)
  170.                                     (* routine.                          *)
  171.  
  172.    Get_Next_ZIP_Local_Header := ( Error = 0 );
  173.  
  174. END   (* Get_Next_ZIP_Local_Header *);
  175.  
  176. (*----------------------------------------------------------------------*)
  177. (*     Get_Next_ZIP_Entry --- Get next header entry in ZIP file         *)
  178. (*----------------------------------------------------------------------*)
  179.  
  180. FUNCTION Get_Next_ZIP_Entry( VAR ZIP_Entry : ZIP_Central_Header_Type;
  181.                              VAR FileName  : AnyStr;
  182.                              VAR Error     : INTEGER  ) : BOOLEAN;
  183.  
  184. (*----------------------------------------------------------------------*)
  185. (*                                                                      *)
  186. (*    Function:  Get_Next_ZIP_Entry                                     *)
  187. (*                                                                      *)
  188. (*    Purpose:   Gets header information for next file in ZIP file      *)
  189. (*                                                                      *)
  190. (*    Calling sequence:                                                 *)
  191. (*                                                                      *)
  192. (*       OK := Get_Next_ZIP_Entry( VAR ZIP_Entry :                      *)
  193. (*                                     ZIP_Central_Header_Type;         *)
  194. (*                                 VAR FileName  : AnyStr;              *)
  195. (*                                 VAR Error     : INTEGER ) : BOOLEAN; *)
  196. (*                                                                      *)
  197. (*          ZIP_Entry --- Header data for next file in ZIP file         *)
  198. (*          FileName  --- File name for this entry                      *)
  199. (*          Error     --- Error flag                                    *)
  200. (*          OK        --- TRUE if header successfully found, else FALSE *)
  201. (*                                                                      *)
  202. (*----------------------------------------------------------------------*)
  203.  
  204. VAR
  205.    L     : INTEGER;
  206.    L_Get : INTEGER;
  207.    L_Got : INTEGER;
  208.  
  209. BEGIN (* Get_Next_ZIP_Entry *)
  210.                                    (* Assume no error to start       *)
  211.    Error := 0;
  212.                                    (* Position file                  *)
  213.    Seek( ZIPFile , ZIP_Pos );
  214.                                    (* Read in the file header entry. *)
  215.  
  216.    IF ( IOResult <> 0 ) THEN
  217.       Error := Format_Error
  218.  
  219.    ELSE
  220.       BEGIN
  221.  
  222.          BlockRead( ZIPFile, ZIP_Entry, SIZEOF( ZIP_Central_Header_Type ),
  223.                     Bytes_Read );
  224.  
  225.                                    (* If wrong size read, or header marker *)
  226.                                    (* byte is incorrect, report ZIP file   *)
  227.                                    (* format error.                        *)
  228.  
  229.          IF ( ( IOResult <> 0 ) OR
  230.               ( Bytes_Read < SIZEOF( ZIP_Central_Header_Type ) ) ) THEN
  231.             Error := Format_Error
  232.          ELSE
  233.                                     (* Check for a legitimate header type  *)
  234.  
  235.             IF ( ZIP_Entry.Signature = ZIP_Central_Header_Signature ) THEN
  236.                BEGIN (* Central header -- we want this *)
  237.  
  238.                                    (* Pick up file name length.       *)
  239.                                    (* Only first 255 chars retrieved. *)
  240.  
  241.                   L := ZIP_Entry.FileNameLength;
  242.  
  243.                   IF ( L > 255 ) THEN
  244.                      L_Get := 255
  245.                   ELSE
  246.                      L_Get := L;
  247.  
  248.                                    (* Read file name characters. *)
  249.  
  250.                   BlockRead( ZIPFile, FileName[ 1 ], L_Get, L_Got );
  251.  
  252.                                    (* Check for I/O error *)
  253.  
  254.                   IF ( ( IOResult <> 0 ) OR ( L_Get<> L_Got ) ) THEN
  255.                      Error := Format_Error
  256.                   ELSE
  257.                      BEGIN
  258.                                    (* Position to next header *)
  259.  
  260.                         ZIP_Pos := ZIP_Pos + ZIP_Entry.ExtraFieldLength   +
  261.                                              ZIP_Entry.CommentFieldLength +
  262.                                              ZIP_Entry.FileNameLength     +
  263.                                              SIZEOF( Zip_Central_Header_Type );
  264.  
  265.                                    (* Set length of file name *)
  266.  
  267.                         FileName[ 0 ] := CHR( L_Got );
  268.  
  269.                      END;
  270.  
  271.                END
  272.                                    (* Check for end of directory *)
  273.  
  274.             ELSE IF ( ZIP_Entry.Signature = ZIP_End_Central_Dir_Signature ) THEN
  275.                Error := End_Of_File
  276.  
  277.                                    (* Anything else is bogus *)
  278.             ELSE
  279.                Error := Format_Error;
  280.  
  281.       END;
  282.  
  283.    Get_Next_ZIP_Entry := ( Error = 0 );
  284.  
  285. END   (* Get_Next_ZIP_Entry *);
  286.  
  287. (*----------------------------------------------------------------------*)
  288. (*   Find_ZIP_Central_Directory --- Find central ZIP file directory     *)
  289. (*----------------------------------------------------------------------*)
  290.  
  291. FUNCTION Find_ZIP_Central_Directory( VAR Error : INTEGER ) : BOOLEAN;
  292.  
  293. (*----------------------------------------------------------------------*)
  294. (*                                                                      *)
  295. (*    Function:  Find_ZIP_Central_Directory                             *)
  296. (*                                                                      *)
  297. (*    Purpose:   Finds central ZIP file directory                       *)
  298. (*                                                                      *)
  299. (*    Calling sequence:                                                 *)
  300. (*                                                                      *)
  301. (*       OK := Find_ZIP_Central_Directory( VAR Error : INTEGER ) :      *)
  302. (*                BOOLEAN;                                              *)
  303. (*                                                                      *)
  304. (*          Error    --- Error flag                                     *)
  305. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  306. (*                                                                      *)
  307. (*----------------------------------------------------------------------*)
  308.  
  309. VAR
  310.    ZIP_Local_Hdr : ZIP_Local_Header_Type   (* Local header         *);
  311.  
  312. BEGIN (* Find_ZIP_Central_Directory *)
  313.  
  314.                                    (* Assume no error to start          *)
  315.    Error   := 0;
  316.                                    (* Start at beginning of file.       *)
  317.    ZIP_Pos := 0;
  318.                                    (* Begin loop over local headers.    *)
  319.  
  320.                                    (* Report success/failure to calling *)
  321.                                    (* routine.                          *)
  322.  
  323.    WHILE ( Get_Next_ZIP_Local_Header( ZIP_Local_Hdr , Error ) ) DO;
  324.  
  325.    Find_ZIP_Central_Directory := ( Error = Central_Dir_Found );
  326.  
  327. END   (* Find_ZIP_Central_Directory *);
  328.  
  329. (*----------------------------------------------------------------------*)
  330. (*        Display_ZIP_Entry --- Display ZIP file file entry info        *)
  331. (*----------------------------------------------------------------------*)
  332.  
  333. PROCEDURE Display_ZIP_Entry( ZIP_Entry : ZIP_Central_Header_Type ;
  334.                              File_Name : AnyStr           );
  335.  
  336. VAR
  337.    FName     : AnyStr;
  338.    TimeDate  : LONGINT;
  339.    TimeDateW : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  340.    DirS      : DirStr;
  341.    FExt      : ExtStr;
  342.  
  343. BEGIN (* Display_ZIP_Entry *)
  344.  
  345.    WITH ZIP_Entry DO
  346.       BEGIN
  347.                                    (* Pick up short file name. *)
  348.  
  349.          FSplit( File_Name, DirS, FName, FExt );
  350.  
  351.          FName := FName + FExt;
  352.  
  353.                                    (* See if this file matches the   *)
  354.                                    (* entry spec wildcard.  Exit if  *)
  355.                                    (* not.                           *)
  356.          IF Use_Entry_Spec THEN
  357.             IF ( NOT Entry_Matches( FName ) ) THEN
  358.                EXIT;
  359.                                    (* Get date and time of creation *)
  360.  
  361.          TimeDateW[ 1 ] := FileTime;
  362.          TimeDateW[ 2 ] := FileDate;
  363.  
  364.                                    (* Display long file name if requested *)
  365.                                    (* and if not the same as the short    *)
  366.                                    (* name.                               *)
  367.  
  368.          IF Show_Long_File_Names THEN
  369.             IF ( FName = File_Name ) THEN
  370.                File_Name := '';
  371.  
  372.                                    (* Display this entry's information *)
  373.  
  374.          Display_One_Entry( FName, UnCompressedSize, TimeDate, ZIPFileName,
  375.                             Current_Subdirectory, File_Name );
  376.  
  377.       END;
  378.  
  379. END (* Display_ZIP_Entry *);
  380.  
  381. (*----------------------------------------------------------------------*)
  382.  
  383. BEGIN (* Display_ZIP_Contents *)
  384.                                    (* Open ZIP file and initialize *)
  385.                                    (* contents display.            *)
  386.  
  387.    IF Start_Contents_Listing( ' ZIP file: ',
  388.                               Current_Subdirectory + ZIPFileName, ZIPFile,
  389.                               ZIP_Pos, Ierr ) THEN
  390.       BEGIN
  391.                                    (* Skip to central directory in ZIP file *)
  392.  
  393.          IF Find_ZIP_Central_Directory( Ierr ) THEN
  394.  
  395.                                    (* Loop over entries      *)
  396.  
  397.             WHILE ( Get_Next_ZIP_Entry( ZIP_Entry , File_Name , Ierr ) ) DO
  398.                Display_ZIP_Entry( ZIP_Entry , File_Name )
  399.  
  400.          ELSE
  401.             IF ( NOT Do_Condensed_Listing ) THEN
  402.                WRITELN( Output_File , 'Failed to find central ZIP directory' )
  403.             ELSE
  404.                WRITELN( Status_File , 'Failed to find central ZIP directory for ', ZIPFileName );
  405.  
  406.                                    (* Close ZIP file file *)
  407.  
  408.          End_Contents_Listing( ZIPFile );
  409.  
  410.       END;
  411.  
  412. END   (* Display_ZIP_Contents *);
  413.