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 .. 2012 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 (info            : out Zip_info; 
  63.                    from            :     String; -- Zip file name 
  64.                    case_sensitive  :     Boolean := False); 
  65.  
  66.   -- Load from a stream 
  67.  
  68.    procedure Load (info            : out Zip_info; 
  69.                    from            :     Zip_Streams.Zipstream_Class; 
  70.                    case_sensitive  :     Boolean := False); 
  71.  
  72.   Zip_file_Error, 
  73.   Zip_file_open_Error, 
  74.   Duplicate_name : exception; 
  75.  
  76.   -- Parameter Form added to *_IO.[Open|Create] 
  77.   Form_For_IO_Open_N_Create  : Ada.Strings.Unbounded.Unbounded_String 
  78.     := Ada.Strings.Unbounded.Null_Unbounded_String; 
  79.   -- See RM A.8.2 : File Management 
  80.   -- Example : "encoding=8bits" 
  81.  
  82.   function Is_loaded (info : Zip_info) return Boolean; 
  83.  
  84.   function Zip_name (info : Zip_info) return String; 
  85.  
  86.   function Zip_comment (info : Zip_info) return String; 
  87.  
  88.   function Zip_Stream (info : Zip_info) return Zip_Streams.Zipstream_Class; 
  89.  
  90.   function Entries (info : Zip_info) return Natural; 
  91.  
  92.   procedure Delete (info  : in out Zip_info); 
  93.  
  94.   Forgot_to_load_zip_info : exception; 
  95.  
  96.   -- Data sizes in archive 
  97.   subtype File_size_type is Interfaces.Unsigned_32; 
  98.  
  99.   --------- 
  100.  
  101.   -- Compression methods or formats in the "official" PKWARE Zip format. 
  102.   -- Details in appnote.txt, part V.J 
  103.   --   C : supported for compressing 
  104.   --   D : supported for decompressing 
  105.  
  106.   type PKZip_method is 
  107.    (store,     -- C, D 
  108.      shrink,    -- C, D 
  109.      reduce_1,  -- C, D 
  110.      reduce_2,  -- C, D 
  111.      reduce_3,  -- C, D 
  112.      reduce_4,  -- C, D 
  113.      implode,   --   D 
  114.      tokenize, 
  115.      deflate,   --   D 
  116.      deflate_e, --   D - Enhanced deflate 
  117.      bzip2,     --   D 
  118.      lzma, 
  119.      ppmd, 
  120.      unknown 
  121. ); 
  122.  
  123.   -- Technical : translates the method code as set in zip archives 
  124.   function Method_from_code (x : Interfaces.Unsigned_16) return PKZip_method; 
  125.   function Method_from_code (x : Natural)                return PKZip_method; 
  126.  
  127.   -- Internal time definition 
  128.    subtype Time is Zip_Streams.Time; 
  129.  
  130.   function Convert (date : Ada.Calendar.Time) return Time              renames Zip_Streams.Calendar.Convert; 
  131.   function Convert (date : Time)              return Ada.Calendar.Time renames Zip_Streams.Calendar.Convert; 
  132.  
  133.   -- Traverse a whole Zip_info directory in sorted order, giving the 
  134.   -- name for each entry to an user - defined "Action" procedure. 
  135.   -- Concretely, you can process a whole Zip file that way, by extracting data 
  136.   -- with Extract, or open a reader stream with UnZip.Streams. 
  137.   -- See the Comp_Zip or Find_Zip tools as application examples. 
  138.   generic 
  139.     with procedure Action (name : String); -- 'name' is compressed entry's name 
  140.   procedure Traverse (z : Zip_info); 
  141.  
  142.   -- Same as Traverse, but Action gives also technical informations about the 
  143.   -- compressed entry. 
  144.   generic 
  145.     with procedure Action ( 
  146.       name              : String; -- 'name' is compressed entry's name 
  147.       file_index        : Positive; 
  148.       comp_size         : File_size_type; 
  149.       uncomp_size       : File_size_type; 
  150.       crc_32            : Interfaces.Unsigned_32; 
  151.       date_time         : Time; 
  152.       method            : PKZip_method; 
  153.       unicode_file_name : Boolean 
  154. ); 
  155.   procedure Traverse_verbose (z : Zip_info); 
  156.  
  157.    -- Academic : see how well the name tree is balanced 
  158.    procedure Tree_stat (z         :     Zip_info; 
  159.                         total     : out Natural; 
  160.                         max_depth : out Natural; 
  161.                         avg_depth : out Float); 
  162.  
  163.   -------------------------------------------------------------------------- 
  164.   -- Offsets - various procedures giving 1 - based indexes to local headers -- 
  165.   -------------------------------------------------------------------------- 
  166.  
  167.   -- Find 1st offset in a Zip stream 
  168.  
  169.    procedure Find_first_offset (file            :     Zip_Streams.Zipstream_Class; 
  170.                                 file_index      : out Positive); 
  171.  
  172.   -- Find offset of a certain compressed file 
  173.   -- in a Zip file (file opened and kept open) 
  174.  
  175.    procedure Find_offset (file            :     Zip_Streams.Zipstream_Class; 
  176.                           name            :     String; 
  177.                           case_sensitive  :     Boolean; 
  178.                           file_index      : out Positive; 
  179.                           comp_size       : out File_size_type; 
  180.                           uncomp_size     : out File_size_type); 
  181.  
  182.    -- Find offset of a certain compressed file in a Zip_info data 
  183.  
  184.    procedure Find_offset (info            :     Zip_info; 
  185.                           name            :     String; 
  186.                           case_sensitive  :     Boolean; 
  187.                           file_index      : out Ada.Streams.Stream_IO.Positive_Count; 
  188.                           comp_size       : out File_size_type; 
  189.                           uncomp_size     : out File_size_type); 
  190.  
  191.   File_name_not_found : exception; 
  192.  
  193.    procedure Get_sizes (info            :     Zip_info; 
  194.                         name            :     String; 
  195.                         case_sensitive  :     Boolean; 
  196.                         comp_size       : out File_size_type; 
  197.                         uncomp_size     : out File_size_type); 
  198.  
  199.   -- User - defined procedure for feedback occuring during 
  200.   -- compression or decompression (entry_skipped meaningful 
  201.   -- only for the latter) 
  202.  
  203.   type Feedback_proc is access 
  204.      procedure (percents_done :     Natural;  -- %'s completed 
  205.                 entry_skipped :     Boolean;  -- indicates one can show "skipped", no %'s 
  206.                 user_abort    : out Boolean);   -- e.g. transmit a "click on Cancel" here 
  207.  
  208.   ------------------------------------------------------------------------- 
  209.   -- Goodies - things used internally but that might be generally useful -- 
  210.   ------------------------------------------------------------------------- 
  211.  
  212.   -- BlockRead : general - purpose procedure (nothing really specific to Zip / 
  213.   -- UnZip) : reads either the whole buffer from a file, or if the end of 
  214.   -- the file lays inbetween, a part of the buffer. 
  215.   -- 
  216.   -- The procedure's names and parameters match Borland Pascal / Delphi 
  217.  
  218.   subtype Byte is Interfaces.Unsigned_8; 
  219.   type Byte_Buffer is array (Integer range <>) of aliased Byte; 
  220.   type p_Byte_Buffer is access Byte_Buffer; 
  221.  
  222.    procedure BlockRead (file          :     Ada.Streams.Stream_IO.File_Type; 
  223.                         buffer        : out Byte_Buffer; 
  224.                         actually_read : out Natural); 
  225.                         -- = buffer'Length if no end of file before last buffer element 
  226.  
  227.    -- Same for general streams 
  228.    -- 
  229.    procedure BlockRead (stream        :     Zip_Streams.Zipstream_Class; 
  230.                         buffer        : out Byte_Buffer; 
  231.                         actually_read : out Natural); 
  232.    -- = buffer'Length if no end of stream before last buffer element 
  233.  
  234.   -- Same, but instead of giving actually_read, raises End_Error if 
  235.   -- the buffer cannot be fully read. 
  236.   -- This mimics the 'Read stream attribute; can be a lot faster, depending 
  237.   -- on the compiler's run - time library. 
  238.    procedure BlockRead (stream  :     Zip_Streams.Zipstream_Class; 
  239.                         buffer  : out Byte_Buffer); 
  240.  
  241.   -- This mimics the 'Write stream attribute; can be a lot faster, depending 
  242.   -- on the compiler's run - time library. 
  243.   -- NB : here we can use the root stream type : no question of size, index, .. . 
  244.    procedure BlockWrite (stream  : in out Ada.Streams.Root_Stream_Type'Class; 
  245.                          buffer  :        Byte_Buffer); 
  246.  
  247.    -- This does the same as Ada 2005's Ada.Directories.Exists 
  248.    -- Just there as helper for Ada 95 only systems 
  249.    -- 
  250.   function Exists (name : String) return Boolean; 
  251.  
  252.   -- Write a string containing line endings (possible from another system) 
  253.   --   into a text file, with the correct native line endings. 
  254.   --   Works for displaying/saving correctly 
  255.   --   CR&LF (DOS/Win), LF (UNIX), CR (Mac OS < 9) 
  256.   -- 
  257.   procedure Put_Multi_Line ( 
  258.     out_file  :        Ada.Text_IO.File_Type; 
  259.     text      :        String 
  260. ); 
  261.  
  262.   procedure Write_as_text ( 
  263.     out_file  :        Ada.Text_IO.File_Type; 
  264.     buffer    :        Byte_Buffer; 
  265.     last_char : in out Character -- track line - ending characters between writes 
  266. ); 
  267.  
  268.   -------------------------------------------------------------- 
  269.   -- Information about this package - e.g. for an "about" box -- 
  270.   -------------------------------------------------------------- 
  271.  
  272.   version    : constant String := "43 - pre"; 
  273.   reference  : constant String := "14 - Jul - 2012"; 
  274.   web        : constant String := "http://unzip - ada.sf.net/"; 
  275.   -- hopefully the latest version is at that URL .. .  --- ^ 
  276.  
  277.   ------------------- 
  278.   -- Private items -- 
  279.   ------------------- 
  280.  
  281. private 
  282.   -- Zip_info, 23.VI.1999. 
  283.  
  284.   -- The PKZIP central directory is coded here as a binary tree 
  285.   -- to allow a fast retrieval of the searched offset in zip file. 
  286.   -- E.g. for a 1000 - file archive, the offset will be found in less 
  287.   -- than 11 moves : 2**10=1024 (balanced case), without any read 
  288.   -- in the archive. 
  289.  
  290.   type Dir_node; 
  291.   type p_Dir_node is access Dir_node; 
  292.  
  293.   type Dir_node (name_len : Natural) is record 
  294.     left, right       : p_Dir_node; 
  295.     dico_name         : String (1 .. name_len); -- UPPER if case - insensitive search 
  296.     file_name         : String (1 .. name_len); 
  297.     file_index        : Ada.Streams.Stream_IO.Positive_Count; 
  298.     comp_size         : File_size_type; 
  299.     uncomp_size       : File_size_type; 
  300.     crc_32            : Interfaces.Unsigned_32; 
  301.     date_time         : Time; 
  302.     method            : PKZip_method; 
  303.     unicode_file_name : Boolean; 
  304.   end record; 
  305.  
  306.   type p_String is access String; 
  307.  
  308.   type Zip_info is record 
  309.     loaded           : Boolean := False; 
  310.     zip_file_name    : p_String;        -- a file name .. . 
  311.     zip_input_stream : Zip_Streams.Zipstream_Class; -- . .. or an input stream 
  312.     -- ^ when not null, we use this and not zip_file_name 
  313.     dir_binary_tree  : p_Dir_node; 
  314.     total_entries    : Natural; 
  315.     zip_file_comment : p_String; 
  316.   end record; 
  317.  
  318. end Zip;