1. --  ________  ___   ______       ______     ___ 
  2.  -- /___ .. ._/  |.|   |.___.\     /. __ .\  __|.|   ____ 
  3.  --    / .. /    |.|   |.____/     |.|__|.| / .. ..|  __\ .. \ 
  4.  --  _/ .. /___  |.|   |.|    ===  | .. __ .. ||. = .| | = .. | 
  5.  -- /_______/  |_|  /__|        /__|  |_| \__\_|  \__\_| 
  6.  
  7.  -- UnZip 
  8.  -------- 
  9.  -- This library allows to uncompress deflated, enhanced deflated, bzip2 - ed, 
  10.  -- imploded, reduced, shrunk and stored streams from a Zip archive stream. 
  11.  -- 
  12.  -- Pure Ada 95 code, 100% portable : OS - , CPU - and compiler - independent. 
  13.  
  14.  --  Ada translation and substantial rewriting by Gautier de Montmollin 
  15.  --    On the web : see the Zip.web constant below. 
  16.  --  based on Pascal version 2.10 by Abimbola A Olowofoyeku, 
  17.  --    http://www.greatchief.plus.com/ 
  18.  --  itself based on Pascal version by Christian Ghisler, 
  19.  --  itself based on C code by Info - Zip group (Mark Adler et al.) 
  20.  --    http://www.info - zip.org/UnZip.html 
  21.  
  22.  -- Technical documentation : read appnote.txt 
  23.  
  24.  -- Legal licensing note: 
  25.  
  26.  --  Copyright (c) 1999 .. 2010 Gautier de Montmollin 
  27.  
  28.  --  Permission is hereby granted, free of charge, to any person obtaining a copy 
  29.  --  of this software and associated documentation files (the "Software"), to deal 
  30.  --  in the Software without restriction, including without limitation the rights 
  31.  --  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
  32.  --  copies of the Software, and to permit persons to whom the Software is 
  33.  --  furnished to do so, subject to the following conditions: 
  34.  
  35.  --  The above copyright notice and this permission notice shall be included in 
  36.  --  all copies or substantial portions of the Software. 
  37.  
  38.  --  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
  39.  --  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
  40.  --  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
  41.  --  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
  42.  --  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
  43.  --  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 
  44.  --  THE SOFTWARE. 
  45.  
  46.  -- NB : this is the MIT License, as found 12 - Sep - 2007 on the site 
  47.  -- http://www.opensource.org/licenses/mit - license.php 
  48.  
  49. with Zip; 
  50.  
  51. with Ada.Calendar, Ada.Streams, Ada.Strings.Unbounded; 
  52.  
  53. package UnZip is 
  54.  
  55.   type option is ( 
  56.     test_only,            -- test .zip file integrity, no write 
  57.     junk_directories,     -- ignore directory info - > extract to current one 
  58.     case_sensitive_match, -- case sensitive name matching 
  59.     extract_as_text       -- files will be written with native line endings 
  60. ); 
  61.  
  62.   type Option_set is array (option) of Boolean; 
  63.  
  64.   no_option : constant Option_set := (others => False); 
  65.  
  66.   -- Ada 2005's Ada.Directories.Create_Path. 
  67.   -- For Ada 95 compatibility we pass it as an optional procedure access. 
  68.   type Create_Path_proc is access 
  69.     procedure (New_Directory : String; 
  70.                Form          : String := ""); 
  71.  
  72.   -- This is system - dependent (or in a future Ada) 
  73.   type Set_Time_Stamp_proc is access 
  74.     procedure (file_name : String; stamp : Ada.Calendar.Time); 
  75.  
  76.   -- Alternatively, you can use Zip.Time to set file time stamps 
  77.   type Set_ZTime_Stamp_proc is access 
  78.     procedure (file_name : String; stamp : Zip.Time); 
  79.   -- NB : you can use Zip.Convert to change Ada.Calendar.Time from/to Zip.Time 
  80.   --     or use our Split to avoid using Ada.Calendar at all. 
  81.  
  82.   -- This is for modifying output file names (e.g. adding a 
  83.   -- work directory, modifying the archived path, etc.) 
  84.   type Compose_func is access function (File_Name  : String) return String; 
  85.  
  86.   -- File System dependent settings 
  87.   type FS_routines_type is record 
  88.     Create_Path             : Create_Path_proc; 
  89.     Set_Time_Stamp          : Set_Time_Stamp_proc; 
  90.     Compose_File_Name       : Compose_func; 
  91.     Set_ZTime_Stamp         : Set_ZTime_Stamp_proc; -- alt. to Set_Time_Stamp 
  92.   end record; 
  93.  
  94.   null_routines : constant FS_routines_type := (null, null, null, null); 
  95.  
  96.   ---------------------------------- 
  97.   -- Simple extraction procedures -- 
  98.   ---------------------------------- 
  99.  
  100.   -- Extract all files from an archive (from) 
  101.  
  102.   procedure Extract (from                  : String; 
  103.                      options               : Option_set := no_option; 
  104.                      password              : String := ""; 
  105.                      file_system_routines  : FS_routines_type := null_routines 
  106. ); 
  107.  
  108.   -- Extract one precise file (what) from an archive (from) 
  109.  
  110.   procedure Extract (from                  : String; 
  111.                      what                  : String; 
  112.                      options               : Option_set := no_option; 
  113.                      password              : String := ""; 
  114.                      file_system_routines  : FS_routines_type := null_routines 
  115. ); 
  116.  
  117.   -- Extract one precise file (what) from an archive (from), 
  118.   -- but save under a new name (rename) 
  119.  
  120.   procedure Extract (from                  : String; 
  121.                      what                  : String; 
  122.                      rename                : String; 
  123.                      options               : Option_set := no_option; 
  124.                      password              : String := ""; 
  125.                      file_system_routines  : FS_routines_type := null_routines 
  126. ); 
  127.  
  128.   ------------------------------------------------------------------------- 
  129.   -- Simple extraction procedures without re - searching central directory -- 
  130.   ------------------------------------------------------------------------- 
  131.  
  132.   -- Extract all files from an archive (from) 
  133.   -- Needs Zip.Load (from, . .. ) prior to the extraction 
  134.  
  135.   procedure Extract (from                  : Zip.Zip_info; 
  136.                      options               : Option_set := no_option; 
  137.                      password              : String := ""; 
  138.                      file_system_routines  : FS_routines_type := null_routines 
  139. ); 
  140.  
  141.   -- Extract one precise file (what) from an archive (from) 
  142.   -- Needs Zip.Load (from, . .. ) prior to the extraction 
  143.  
  144.   procedure Extract (from                  : Zip.Zip_info; 
  145.                      what                  : String; 
  146.                      options               : Option_set := no_option; 
  147.                      password              : String := ""; 
  148.                      file_system_routines  : FS_routines_type := null_routines 
  149. ); 
  150.  
  151.   -- Extract one precise file (what) from an archive (from), 
  152.   -- but save under a new name (rename) 
  153.   -- Needs Zip.Load (from, . .. ) prior to the extraction 
  154.  
  155.   procedure Extract (from                  : Zip.Zip_info; 
  156.                      what                  : String; 
  157.                      rename                : String; 
  158.                      options               : Option_set := no_option; 
  159.                      password              : String := ""; 
  160.                      file_system_routines  : FS_routines_type := null_routines 
  161. ); 
  162.  
  163.   subtype PKZip_method is Zip.PKZip_method; 
  164.  
  165.   ---------------------------------------------- 
  166.   -- Extraction procedures for user interface -- 
  167.   ---------------------------------------------- 
  168.  
  169.   -- NB : the *_proc types are accesses to procedures - their usage 
  170.   -- may require the non - standard attribute "unrestricted_access", 
  171.   -- or some changes. 
  172.   -- Read unzipada.adb for details and examples. 
  173.  
  174.   type Name_conflict_intervention is 
  175.     (yes, no, yes_to_all, none, rename_it, abort_now); 
  176.  
  177.   current_user_attitude  : Name_conflict_intervention := yes; 
  178.   -- reset to "yes" for a new session (in case of yes_to_all / none state!) 
  179.  
  180.    type Resolve_conflict_proc is access 
  181.      procedure (name             :     String; 
  182.                 action           : out Name_conflict_intervention; 
  183.                 new_name         : out String; 
  184.                 new_name_length  : out Natural); 
  185.  
  186.   type Get_password_proc is access 
  187.     procedure (password : out Ada.Strings.Unbounded.Unbounded_String); 
  188.  
  189.   -- Data sizes in archive 
  190.   subtype File_size_type is Zip.File_size_type; 
  191.  
  192.   -- Inform user about some archive data 
  193.  
  194.   type Tell_data_proc is access 
  195.     procedure (name                : String; 
  196.                 compressed_bytes    : File_size_type; 
  197.                 uncompressed_bytes  : File_size_type; 
  198.                 method              : PKZip_method); 
  199.  
  200.   -- Extract all files from an archive (from) 
  201.  
  202.   procedure Extract (from                  : String; 
  203.                      feedback              : Zip.Feedback_proc; 
  204.                      help_the_file_exists  : Resolve_conflict_proc; 
  205.                      tell_data             : Tell_data_proc; 
  206.                      get_pwd               : Get_password_proc; 
  207.                      options               : Option_set := no_option; 
  208.                      password              : String := ""; 
  209.                      file_system_routines  : FS_routines_type := null_routines 
  210. ); 
  211.  
  212.   -- Extract one precise file (what) from an archive (from) 
  213.  
  214.   procedure Extract (from                  : String; 
  215.                      what                  : String; 
  216.                      feedback              : Zip.Feedback_proc; 
  217.                      help_the_file_exists  : Resolve_conflict_proc; 
  218.                      tell_data             : Tell_data_proc; 
  219.                      get_pwd               : Get_password_proc; 
  220.                      options               : Option_set := no_option; 
  221.                      password              : String := ""; 
  222.                      file_system_routines  : FS_routines_type := null_routines 
  223. ); 
  224.  
  225.   -- Extract one precise file (what) from an archive (from), 
  226.   -- but save under a new name (rename) 
  227.  
  228.   procedure Extract (from         : String; 
  229.                      what         : String; 
  230.                      rename       : String; 
  231.                      feedback     : Zip.Feedback_proc; 
  232.                      tell_data    : Tell_data_proc; 
  233.                      get_pwd      : Get_password_proc; 
  234.                      options      : Option_set := no_option; 
  235.                      password     : String := ""; 
  236.                      file_system_routines  : FS_routines_type := null_routines 
  237. ); 
  238.  
  239.   -- Using Zip_info structure: 
  240.  
  241.   -- Extract all files from an archive (from) 
  242.   -- Needs Zip.Load (from, . .. ) prior to the extraction 
  243.  
  244.   procedure Extract (from                  : Zip.Zip_info; 
  245.                      feedback              : Zip.Feedback_proc; 
  246.                      help_the_file_exists  : Resolve_conflict_proc; 
  247.                      tell_data             : Tell_data_proc; 
  248.                      get_pwd               : Get_password_proc; 
  249.                      options               : Option_set := no_option; 
  250.                      password              : String := ""; 
  251.                      file_system_routines  : FS_routines_type := null_routines 
  252. ); 
  253.  
  254.   -- Extract one precise file (what) from an archive (from) 
  255.   -- Needs Zip.Load (from, . .. ) prior to the extraction 
  256.  
  257.   procedure Extract (from                  : Zip.Zip_info; 
  258.                      what                  : String; 
  259.                      feedback              : Zip.Feedback_proc; 
  260.                      help_the_file_exists  : Resolve_conflict_proc; 
  261.                      tell_data             : Tell_data_proc; 
  262.                      get_pwd               : Get_password_proc; 
  263.                      options               : Option_set := no_option; 
  264.                      password              : String := ""; 
  265.                      file_system_routines  : FS_routines_type := null_routines 
  266. ); 
  267.  
  268.   -- Extract one precise file (what) from an archive (from), 
  269.   -- but save under a new name (rename) 
  270.   -- Needs Zip.Load (from, . .. ) prior to the extraction 
  271.  
  272.   procedure Extract (from                  : Zip.Zip_info; 
  273.                      what                  : String; 
  274.                      rename                : String; 
  275.                      feedback              : Zip.Feedback_proc; 
  276.                      tell_data             : Tell_data_proc; 
  277.                      get_pwd               : Get_password_proc; 
  278.                      options               : Option_set := no_option; 
  279.                      password              : String := ""; 
  280.                      file_system_routines  : FS_routines_type := null_routines 
  281. ); 
  282.  
  283.   -- Errors 
  284.  
  285.   CRC_Error, 
  286.   Uncompressed_size_Error, 
  287.   Write_Error, 
  288.   Read_Error, 
  289.   Wrong_password, 
  290.   User_abort, 
  291.   Not_supported, 
  292.   Unsupported_method, 
  293.   Wrong_or_no_password, 
  294.   Internal_Error  : exception; 
  295.  
  296. private 
  297.  
  298.   type Write_mode is 
  299.     (write_to_binary_file, 
  300.       write_to_text_file, 
  301.       write_to_memory, 
  302.       just_test 
  303. ); 
  304.  
  305.   subtype Write_to_file is Write_mode 
  306.     range write_to_binary_file .. write_to_text_file; 
  307.  
  308.   type p_Stream_Element_Array is access all Ada.Streams.Stream_Element_Array; 
  309.  
  310. end UnZip;