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 : in String; 
  70.                Form          : in 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.     Directory_Separator    : Character; 
  91.     Compose_File_Name      : Compose_func; 
  92.     Set_ZTime_Stamp        : Set_ZTime_Stamp_proc; -- alt. to Set_Time_Stamp 
  93.   end record; 
  94.  
  95.   null_routines: constant FS_routines_type:= (null,null,'\',null,null); 
  96.  
  97.  
  98.   ---------------------------------- 
  99.   -- Simple extraction procedures -- 
  100.   ---------------------------------- 
  101.  
  102.   -- Extract all files from an archive (from) 
  103.  
  104.   procedure Extract( from                 : String; 
  105.                      options              : Option_set:= no_option; 
  106.                      password             : String:= ""; 
  107.                      file_system_routines : FS_routines_type:= null_routines 
  108.                    ); 
  109.  
  110.   -- Extract one precise file (what) from an archive (from) 
  111.  
  112.   procedure Extract( from                 : String; 
  113.                      what                 : String; 
  114.                      options              : Option_set:= no_option; 
  115.                      password             : String:= ""; 
  116.                      file_system_routines : FS_routines_type:= null_routines 
  117.                    ); 
  118.  
  119.   -- Extract one precise file (what) from an archive (from), 
  120.   -- but save under a new name (rename) 
  121.  
  122.   procedure Extract( from                 : String; 
  123.                      what                 : String; 
  124.                      rename               : String; 
  125.                      options              : Option_set:= no_option; 
  126.                      password             : String:= ""; 
  127.                      file_system_routines : FS_routines_type:= null_routines 
  128.                    ); 
  129.  
  130.   ------------------------------------------------------------------------- 
  131.   -- Simple extraction procedures without re-searching central directory -- 
  132.   ------------------------------------------------------------------------- 
  133.  
  134.   -- Extract all files from an archive (from) 
  135.   -- Needs Zip.Load(from, ...) prior to the extraction 
  136.  
  137.   procedure Extract( from                 : Zip.Zip_info; 
  138.                      options              : Option_set:= no_option; 
  139.                      password             : String:= ""; 
  140.                      file_system_routines : FS_routines_type:= null_routines 
  141.                    ); 
  142.  
  143.   -- Extract one precise file (what) from an archive (from) 
  144.   -- Needs Zip.Load(from, ...) prior to the extraction 
  145.  
  146.   procedure Extract( from                 : Zip.Zip_info; 
  147.                      what                 : String; 
  148.                      options              : Option_set:= no_option; 
  149.                      password             : String:= ""; 
  150.                      file_system_routines : FS_routines_type:= null_routines 
  151.                    ); 
  152.  
  153.   -- Extract one precise file (what) from an archive (from), 
  154.   -- but save under a new name (rename) 
  155.   -- Needs Zip.Load(from, ...) prior to the extraction 
  156.  
  157.   procedure Extract( from                 : Zip.Zip_info; 
  158.                      what                 : String; 
  159.                      rename               : String; 
  160.                      options              : Option_set:= no_option; 
  161.                      password             : String:= ""; 
  162.                      file_system_routines : FS_routines_type:= null_routines 
  163.                    ); 
  164.  
  165.   subtype PKZip_method is Zip.PKZip_method; 
  166.  
  167.   ---------------------------------------------- 
  168.   -- Extraction procedures for user interface -- 
  169.   ---------------------------------------------- 
  170.  
  171.   -- NB: the *_proc types are accesses to procedures - their usage 
  172.   -- may require the non-standard attribute "unrestricted_access", 
  173.   -- or some changes. 
  174.   -- Read unzipada.adb for details and examples. 
  175.  
  176.   type Name_conflict_intervention is 
  177.     ( yes, no, yes_to_all, none, rename_it, abort_now ); 
  178.  
  179.   current_user_attitude : Name_conflict_intervention:= yes; 
  180.   -- reset to "yes" for a new session (in case of yes_to_all / none state!) 
  181.  
  182.   type Resolve_conflict_proc is access 
  183.     procedure ( name            :  in String; 
  184.                 action          : out Name_conflict_intervention; 
  185.                 new_name        : out String; 
  186.                 new_name_length : out Natural ); 
  187.  
  188.  
  189.   type Get_password_proc is access 
  190.     procedure(password: out Ada.Strings.Unbounded.Unbounded_String); 
  191.  
  192.   -- Data sizes in archive 
  193.   subtype File_size_type is Zip.File_size_type; 
  194.  
  195.   -- Inform user about some archive data 
  196.  
  197.   type Tell_data_proc is access 
  198.     procedure ( name               : String; 
  199.                 compressed_bytes   : File_size_type; 
  200.                 uncompressed_bytes : File_size_type; 
  201.                 method             : PKZip_method ); 
  202.  
  203.   -- Extract all files from an archive (from) 
  204.  
  205.   procedure Extract( from                 : String; 
  206.                      feedback             : Zip.Feedback_proc; 
  207.                      help_the_file_exists : Resolve_conflict_proc; 
  208.                      tell_data            : Tell_data_proc; 
  209.                      get_pwd              : Get_password_proc; 
  210.                      options              : Option_set:= no_option; 
  211.                      password             : String:= ""; 
  212.                      file_system_routines : FS_routines_type:= null_routines 
  213.                    ); 
  214.  
  215.   -- Extract one precise file (what) from an archive (from) 
  216.  
  217.   procedure Extract( from                 : String; 
  218.                      what                 : String; 
  219.                      feedback             : Zip.Feedback_proc; 
  220.                      help_the_file_exists : Resolve_conflict_proc; 
  221.                      tell_data            : Tell_data_proc; 
  222.                      get_pwd              : Get_password_proc; 
  223.                      options              : Option_set:= no_option; 
  224.                      password             : String:= ""; 
  225.                      file_system_routines : FS_routines_type:= null_routines 
  226.                    ); 
  227.  
  228.   -- Extract one precise file (what) from an archive (from), 
  229.   -- but save under a new name (rename) 
  230.  
  231.   procedure Extract( from        : String; 
  232.                      what        : String; 
  233.                      rename      : String; 
  234.                      feedback    : Zip.Feedback_proc; 
  235.                      tell_data   : Tell_data_proc; 
  236.                      get_pwd     : Get_password_proc; 
  237.                      options     : Option_set:= no_option; 
  238.                      password    : String:= ""; 
  239.                      file_system_routines : FS_routines_type:= null_routines 
  240.                    ); 
  241.  
  242.   -- Using Zip_info structure: 
  243.  
  244.   -- Extract all files from an archive (from) 
  245.   -- Needs Zip.Load(from, ...) prior to the extraction 
  246.  
  247.   procedure Extract( from                 : Zip.Zip_info; 
  248.                      feedback             : Zip.Feedback_proc; 
  249.                      help_the_file_exists : Resolve_conflict_proc; 
  250.                      tell_data            : Tell_data_proc; 
  251.                      get_pwd              : Get_password_proc; 
  252.                      options              : Option_set:= no_option; 
  253.                      password             : String:= ""; 
  254.                      file_system_routines : FS_routines_type:= null_routines 
  255.                    ); 
  256.  
  257.   -- Extract one precise file (what) from an archive (from) 
  258.   -- Needs Zip.Load(from, ...) prior to the extraction 
  259.  
  260.   procedure Extract( from                 : Zip.Zip_info; 
  261.                      what                 : String; 
  262.                      feedback             : Zip.Feedback_proc; 
  263.                      help_the_file_exists : Resolve_conflict_proc; 
  264.                      tell_data            : Tell_data_proc; 
  265.                      get_pwd              : Get_password_proc; 
  266.                      options              : Option_set:= no_option; 
  267.                      password             : String:= ""; 
  268.                      file_system_routines : FS_routines_type:= null_routines 
  269.                    ); 
  270.  
  271.   -- Extract one precise file (what) from an archive (from), 
  272.   -- but save under a new name (rename) 
  273.   -- Needs Zip.Load(from, ...) prior to the extraction 
  274.  
  275.   procedure Extract( from                 : Zip.Zip_info; 
  276.                      what                 : String; 
  277.                      rename               : String; 
  278.                      feedback             : Zip.Feedback_proc; 
  279.                      tell_data            : Tell_data_proc; 
  280.                      get_pwd              : Get_password_proc; 
  281.                      options              : Option_set:= no_option; 
  282.                      password             : String:= ""; 
  283.                      file_system_routines : FS_routines_type:= null_routines 
  284.                    ); 
  285.  
  286.   -- Errors 
  287.  
  288.   CRC_Error, 
  289.   Uncompressed_size_Error, 
  290.   Write_Error, 
  291.   Read_Error, 
  292.   Wrong_password, 
  293.   User_abort, 
  294.   Not_supported, 
  295.   Unsupported_method, 
  296.   Wrong_or_no_password, 
  297.   Internal_Error : exception; 
  298.  
  299. private 
  300.  
  301.   type Write_mode is 
  302.     ( write_to_binary_file, 
  303.       write_to_text_file, 
  304.       write_to_memory, 
  305.       just_test 
  306.     ); 
  307.  
  308.   subtype Write_to_file is Write_mode 
  309.     range write_to_binary_file..write_to_text_file; 
  310.  
  311.   type p_Stream_Element_Array is access all Ada.Streams.Stream_Element_Array; 
  312.  
  313. end UnZip;