1. --  ________  ___   ______       ______     ___ 
  2. -- /___..._/  |.|   |.___.\     /. __ .\  __|.|   ____ 
  3. --    /../    |.|   |.____/     |.|__|.| /....|  __\..\ 
  4. --  _/../___  |.|   |.|    ===  |..__..||. = .| | = ..| 
  5. -- /_______/  |_|  /__|        /__|  |_| \__\_|  \__\_| 
  6.  
  7. -- Zip library 
  8. -------------- 
  9. -- Library for manipulating archive files in the Zip format 
  10. -- 
  11. -- Pure Ada 95+ code, 100% portable: OS-, CPU- and compiler- independent. 
  12. -- 
  13. -- Version / date / download info: see the version, reference, web strings 
  14. --   defined at the end of the public part of this package. 
  15.  
  16. -- Legal licensing note: 
  17.  
  18. --  Copyright (c) 1999..2011 Gautier de Montmollin 
  19.  
  20. --  Permission is hereby granted, free of charge, to any person obtaining a copy 
  21. --  of this software and associated documentation files (the "Software"), to deal 
  22. --  in the Software without restriction, including without limitation the rights 
  23. --  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
  24. --  copies of the Software, and to permit persons to whom the Software is 
  25. --  furnished to do so, subject to the following conditions: 
  26.  
  27. --  The above copyright notice and this permission notice shall be included in 
  28. --  all copies or substantial portions of the Software. 
  29.  
  30. --  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
  31. --  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
  32. --  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
  33. --  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
  34. --  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
  35. --  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 
  36. --  THE SOFTWARE. 
  37.  
  38. -- NB: this is the MIT License, as found 12-Sep-2007 on the site 
  39. -- http://www.opensource.org/licenses/mit-license.php 
  40.  
  41. with Zip_Streams; 
  42. with Ada.Calendar, Ada.Streams.Stream_IO, Ada.Text_IO, Ada.Strings.Unbounded; 
  43. with Interfaces; 
  44.  
  45. package Zip is 
  46.  
  47.   -------------- 
  48.   -- Zip_info -- 
  49.   -------------- 
  50.  
  51.   -- Zip_info contains the Zip file name or input stream, 
  52.   -- and the archive's sorted directory 
  53.   type Zip_info is private; 
  54.  
  55.   ----------------------------------------------------------------------- 
  56.   -- Load the whole .zip directory in archive (from) into a tree, for  -- 
  57.   -- fast searching                                                    -- 
  58.   ----------------------------------------------------------------------- 
  59.  
  60.   -- Load from a file 
  61.  
  62.   procedure Load( 
  63.     info           : out Zip_info; 
  64.     from           : in  String; -- Zip file name 
  65.     case_sensitive : in  Boolean:= False 
  66.   ); 
  67.  
  68.   -- Load from a stream 
  69.  
  70.   procedure Load( 
  71.     info           : out Zip_info; 
  72.     from           : in  Zip_Streams.Zipstream_Class; 
  73.     case_sensitive : in  Boolean:= False 
  74.   ); 
  75.  
  76.  
  77.   Zip_file_Error, 
  78.   Zip_file_open_Error, 
  79.   Duplicate_name: exception; 
  80.  
  81.   -- Parameter Form added to *_IO.[Open|Create] 
  82.   Form_For_IO_Open_N_Create : Ada.Strings.Unbounded.Unbounded_String 
  83.     := Ada.Strings.Unbounded.Null_Unbounded_String; 
  84.   -- See RM A.8.2: File Management 
  85.   -- Example: "encoding=8bits" 
  86.  
  87.   function Is_loaded( info: in Zip_info ) return Boolean; 
  88.  
  89.   function Zip_name( info: in Zip_info ) return String; 
  90.  
  91.   function Zip_comment( info: in Zip_info ) return String; 
  92.  
  93.   function Zip_stream( info: in Zip_info ) return Zip_Streams.Zipstream_Class; 
  94.  
  95.   function Entries( info: in Zip_info ) return Natural; 
  96.  
  97.   procedure Delete( info : in out Zip_info ); 
  98.  
  99.   Forgot_to_load_zip_info: exception; 
  100.  
  101.   -- Data sizes in archive 
  102.   subtype File_size_type is Interfaces.Unsigned_32; 
  103.  
  104.   --------- 
  105.  
  106.   -- Compression methods or formats in the "official" PKWARE Zip format. 
  107.   -- Details in appnote.txt, part V.J 
  108.   --   C: supported for compressing 
  109.   --   D: supported for decompressing 
  110.  
  111.   type PKZip_method is 
  112.    ( store,     -- C,D 
  113.      shrink,    -- C,D 
  114.      reduce_1,  -- C,D 
  115.      reduce_2,  -- C,D 
  116.      reduce_3,  -- C,D 
  117.      reduce_4,  -- C,D 
  118.      implode,   --   D 
  119.      tokenize, 
  120.      deflate,   --   D 
  121.      deflate_e, --   D - Enhanced deflate 
  122.      bzip2,     --   D 
  123.      lzma, 
  124.      ppmd, 
  125.      unknown 
  126.    ); 
  127.  
  128.   -- Technical: translates the method code as set in zip archives 
  129.   function Method_from_code(x: Interfaces.Unsigned_16) return PKZip_method; 
  130.   function Method_from_code(x: Natural) return PKZip_method; 
  131.  
  132.   -- Internal time definition 
  133.   subtype Time is Zip_Streams.Time; 
  134.   function Convert(date : in Ada.Calendar.Time) return Time 
  135.     renames Zip_Streams.Calendar.Convert; 
  136.   function Convert(date : in Time) return Ada.Calendar.Time 
  137.     renames Zip_Streams.Calendar.Convert; 
  138.  
  139.   -- Traverse a whole Zip_info directory in sorted order, giving the 
  140.   -- name for each entry to an user-defined "Action" procedure. 
  141.   -- Concretely, you can process a whole Zip file that way, by extracting data 
  142.   -- with Extract, or open a reader stream with UnZip.Streams. 
  143.   -- See the Comp_Zip or Find_Zip tools as application examples. 
  144.   generic 
  145.     with procedure Action( name: String ); -- 'name' is compressed entry's name 
  146.   procedure Traverse( z: Zip_info ); 
  147.  
  148.   -- Same as Traverse, but Action gives also technical informations about the 
  149.   -- compressed entry. 
  150.   generic 
  151.     with procedure Action( 
  152.       name             : String; -- 'name' is compressed entry's name 
  153.       file_index       : Positive; 
  154.       comp_size        : File_size_type; 
  155.       uncomp_size      : File_size_type; 
  156.       crc_32           : Interfaces.Unsigned_32; 
  157.       date_time        : Time; 
  158.       method           : PKZip_method; 
  159.       unicode_file_name: Boolean 
  160.     ); 
  161.   procedure Traverse_verbose( z: Zip_info ); 
  162.  
  163.   -- Academic: see how well the name tree is balanced 
  164.   procedure Tree_stat( 
  165.     z        : in     Zip_info; 
  166.     total    :    out Natural; 
  167.     max_depth:    out Natural; 
  168.     avg_depth:    out Float 
  169.   ); 
  170.  
  171.   -------------------------------------------------------------------------- 
  172.   -- Offsets - various procedures giving 1-based indexes to local headers -- 
  173.   -------------------------------------------------------------------------- 
  174.  
  175.   -- Find 1st offset in a Zip stream 
  176.  
  177.   procedure Find_first_offset( 
  178.     file           : in     Zip_Streams.Zipstream_Class; 
  179.     file_index     :    out Positive ); 
  180.  
  181.   -- Find offset of a certain compressed file 
  182.   -- in a Zip file (file opened and kept open) 
  183.  
  184.   procedure Find_offset( 
  185.     file           : in     Zip_Streams.Zipstream_Class; 
  186.     name           : in     String; 
  187.     case_sensitive : in     Boolean; 
  188.     file_index     :    out Positive; 
  189.     comp_size      :    out File_size_type; 
  190.     uncomp_size    :    out File_size_type 
  191.   ); 
  192.  
  193.   -- Find offset of a certain compressed file in a Zip_info data 
  194.  
  195.   procedure Find_offset( 
  196.     info           : in     Zip_info; 
  197.     name           : in     String; 
  198.     case_sensitive : in     Boolean; 
  199.     file_index     :    out Ada.Streams.Stream_IO.Positive_Count; 
  200.     comp_size      :    out File_size_type; 
  201.     uncomp_size    :    out File_size_type 
  202.   ); 
  203.  
  204.   File_name_not_found: exception; 
  205.  
  206.   procedure Get_sizes( 
  207.     info           : in     Zip_info; 
  208.     name           : in     String; 
  209.     case_sensitive : in     Boolean; 
  210.     comp_size      :    out File_size_type; 
  211.     uncomp_size    :    out File_size_type 
  212.   ); 
  213.  
  214.   -- User-defined procedure for feedback occuring during 
  215.   -- compression or decompression (entry_skipped meaningful 
  216.   -- only for the latter) 
  217.  
  218.   type Feedback_proc is access 
  219.     procedure ( 
  220.       percents_done:  in Natural;  -- %'s completed 
  221.       entry_skipped:  in Boolean;  -- indicates one can show "skipped", no %'s 
  222.       user_abort   : out Boolean   -- e.g. transmit a "click on Cancel" here 
  223.     ); 
  224.  
  225.   ------------------------------------------------------------------------- 
  226.   -- Goodies - things used internally but that might be generally useful -- 
  227.   ------------------------------------------------------------------------- 
  228.  
  229.   -- BlockRead: general-purpose procedure (nothing really specific to Zip / 
  230.   -- UnZip): reads either the whole buffer from a file, or if the end of 
  231.   -- the file lays inbetween, a part of the buffer. 
  232.   -- 
  233.   -- The procedure's names and parameters match Borland Pascal / Delphi 
  234.  
  235.   subtype Byte is Interfaces.Unsigned_8; 
  236.   type Byte_Buffer is array(Integer range <>) of aliased Byte; 
  237.   type p_Byte_Buffer is access Byte_Buffer; 
  238.  
  239.   procedure BlockRead( 
  240.     file         : in     Ada.Streams.Stream_IO.File_Type; 
  241.     buffer       :    out Byte_Buffer; 
  242.     actually_read:    out Natural 
  243.     -- = buffer'Length if no end of file before last buffer element 
  244.   ); 
  245.  
  246.   -- Same for general streams 
  247.   -- 
  248.   procedure BlockRead( 
  249.     stream       : in     Zip_Streams.Zipstream_Class; 
  250.     buffer       :    out Byte_Buffer; 
  251.     actually_read:    out Natural 
  252.     -- = buffer'Length if no end of stream before last buffer element 
  253.   ); 
  254.  
  255.   -- Same, but instead of giving actually_read, raises End_Error if 
  256.   -- the buffer cannot be fully read. 
  257.   -- This mimics the 'Read stream attribute; can be a lot faster, depending 
  258.   -- on the compiler's run-time library. 
  259.   procedure BlockRead( 
  260.     stream : in     Zip_Streams.Zipstream_Class; 
  261.     buffer :    out Byte_Buffer 
  262.   ); 
  263.  
  264.   -- This mimics the 'Write stream attribute; can be a lot faster, depending 
  265.   -- on the compiler's run-time library. 
  266.   -- NB: here we can use the root stream type: no question of size, index,... 
  267.   procedure BlockWrite( 
  268.     stream : in out Ada.Streams.Root_Stream_Type'Class; 
  269.     buffer : in     Byte_Buffer 
  270.   ); 
  271.  
  272.   -- This does the same as Ada 2005's Ada.Directories.Exists 
  273.   -- Just there as helper for Ada 95 only systems 
  274.   -- 
  275.   function Exists(name:String) return Boolean; 
  276.  
  277.   -- Write a string containing line endings (possible from another system) 
  278.   --   into a text file, with the correct native line endings. 
  279.   --   Works for displaying/saving correctly 
  280.   --   CR&LF (DOS/Win), LF (UNIX), CR (Mac OS < 9) 
  281.   -- 
  282.   procedure Put_Multi_Line( 
  283.     out_file :        Ada.Text_IO.File_Type; 
  284.     text     :        String 
  285.   ); 
  286.  
  287.   procedure Write_as_text( 
  288.     out_file :        Ada.Text_IO.File_Type; 
  289.     buffer   :        Byte_Buffer; 
  290.     last_char: in out Character -- track line-ending characters between writes 
  291.   ); 
  292.  
  293.   -------------------------------------------------------------- 
  294.   -- Information about this package - e.g. for an "about" box -- 
  295.   -------------------------------------------------------------- 
  296.  
  297.   version   : constant String:= "41"; 
  298.   reference : constant String:= "22-Jul-2011"; 
  299.   copyright : constant String:= "Copyright (c) 1999..2011 Gautier de Montmollin"; 
  300.   web       : constant String:= "http://unzip-ada.sf.net/"; 
  301.   -- hopefully the latest version is at that URL...  ---^ 
  302.  
  303.   ------------------- 
  304.   -- Private items -- 
  305.   ------------------- 
  306.  
  307. private 
  308.   -- Zip_info, 23.VI.1999. 
  309.  
  310.   -- The PKZIP central directory is coded here as a binary tree 
  311.   -- to allow a fast retrieval of the searched offset in zip file. 
  312.   -- E.g. for a 1000-file archive, the offset will be found in less 
  313.   -- than 11 moves: 2**10=1024 (balanced case), without any read 
  314.   -- in the archive. 
  315.  
  316.   type Dir_node; 
  317.   type p_Dir_node is access Dir_node; 
  318.  
  319.   type Dir_node(name_len: Natural) is record 
  320.     left, right      : p_Dir_node; 
  321.     name             : String(1..name_len); 
  322.     file_index       : Ada.Streams.Stream_IO.Positive_Count; 
  323.     comp_size        : File_size_type; 
  324.     uncomp_size      : File_size_type; 
  325.     crc_32           : Interfaces.Unsigned_32; 
  326.     date_time        : Time; 
  327.     method           : PKZip_method; 
  328.     unicode_file_name: Boolean; 
  329.   end record; 
  330.  
  331.   type p_String is access String; 
  332.  
  333.   type Zip_info is record 
  334.     loaded          : Boolean:= False; 
  335.     zip_file_name   : p_String;        -- a file name... 
  336.     zip_input_stream: Zip_Streams.Zipstream_Class; -- ...or an input stream 
  337.     -- ^ when not null, we use this and not zip_file_name 
  338.     dir_binary_tree : p_Dir_node; 
  339.     total_entries   : Natural; 
  340.     zip_file_comment: p_String; 
  341.   end record; 
  342.  
  343. end Zip;