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