1. with Ada.Streams.Stream_IO; 
  2. with Interfaces;                        use Interfaces; 
  3. with Zip.Headers, UnZip.Decompress; 
  4. with Zip_Streams; 
  5.  
  6. package body UnZip is 
  7.  
  8.    use Ada.Streams, Ada.Strings.Unbounded; 
  9.  
  10.    -------------------------------------------------- 
  11.    -- *The* internal 1 - file unzipping procedure.   -- 
  12.    -- Input must be _open_ and won't be _closed_ ! -- 
  13.    -------------------------------------------------- 
  14.  
  15.    procedure UnZipFile ( 
  16.                         zip_file                  : Zip_Streams.Zipstream_Class; 
  17.                         out_name                  : String; 
  18.                         name_from_header          : Boolean; 
  19.                         header_index              : in out Positive; 
  20.                         hint_comp_size            : File_size_type; -- Added 2007 for .ODS files 
  21.                         feedback                  : Zip.Feedback_proc; 
  22.                         help_the_file_exists      : Resolve_conflict_proc; 
  23.                         tell_data                 : Tell_data_proc; 
  24.                         get_pwd                   : Get_password_proc; 
  25.                         options                   : Option_set; 
  26.                         password                  : in out Unbounded_String; 
  27.                         file_system_routines      : FS_routines_type 
  28.                        ) 
  29.    is 
  30.       work_index : Positive := header_index; 
  31.       local_header : Zip.Headers.Local_File_Header; 
  32.       data_descriptor_after_data : Boolean; 
  33.       method : PKZip_method; 
  34.  
  35.       skip_this_file : Boolean := False; 
  36.       bin_text_mode : constant array (Boolean) of Write_mode := 
  37.         (write_to_binary_file, write_to_text_file); 
  38.       mode : constant array (Boolean) of Write_mode := 
  39.         (bin_text_mode (options (extract_as_text)), just_test); 
  40.       actual_mode : Write_mode := mode (options (test_only)); 
  41.  
  42.       true_packed_size : File_size_type; -- encryption adds 12 to packed size 
  43.  
  44.       the_output_name : Unbounded_String; 
  45.  
  46.       -- 27 - Jun - 2001  : possibility of trashing directory part of a name 
  47.       --               e.g.  :  unzipada\uza_src\unzip.ads - > unzip.ads 
  48.       function Maybe_trash_dir (n : String) return String is 
  49.          idx : Integer := n'First - 1; 
  50.       begin 
  51.          if options (junk_directories) then 
  52.             for i in n'Range loop 
  53.                if n (i) = '/' or else n (i) = '\' then 
  54.                   idx := i; 
  55.                end if; 
  56.             end loop; 
  57.             -- idx points on the index just before the interesting part 
  58.             return n (idx + 1 .. n'Last); 
  59.          else 
  60.             return n; 
  61.          end if; 
  62.       end Maybe_trash_dir; 
  63.  
  64.       procedure Set_definitively_named_outfile (composed_name : String) is 
  65.          idx : Integer := composed_name'First - 1; 
  66.          first_in_name : Integer; 
  67.       begin 
  68.          for i in composed_name'Range loop 
  69.             if composed_name (i) = '/' or else composed_name (i) = '\' then 
  70.                idx := i; 
  71.             end if; 
  72.          end loop; 
  73.          -- idx points on the index just before the name part 
  74.  
  75.          if idx >= composed_name'First and then 
  76.            actual_mode in Write_to_file and then 
  77.            file_system_routines.Create_Path /= null 
  78.          then 
  79.             -- Not only the name, also a path. 
  80.             -- In that case, we may need to create parts of the path. 
  81.             declare 
  82.                Directory_Separator : constant Character := '/'; 
  83.                -- The '/' separator is also recognized by Windows' routines, 
  84.                -- so we can just use it as a standard. See the discussion started 
  85.                -- in July 2010 in the Ada Comment mailing list about it 
  86.                -- for the 2012 standard. 
  87.                path : String := composed_name (composed_name'First .. idx - 1); 
  88.             begin 
  89.                -- Set the file separator recognized by the O.S. 
  90.                for i in path'Range loop 
  91.                   if path (i) = '\' or else path (i) = '/' then 
  92.                      path (i) := Directory_Separator; 
  93.                   end if; 
  94.                end loop; 
  95.                file_system_routines.Create_Path (path); 
  96.             end; 
  97.          end if; 
  98.          -- Now we can create the file itself. 
  99.          first_in_name := composed_name'First; 
  100.          -- 
  101.          the_output_name := 
  102.            To_Unbounded_String (composed_name (first_in_name .. composed_name'Last)); 
  103.       end Set_definitively_named_outfile; 
  104.  
  105.       function Full_Path_Name (Archive_File_Name  : String) return String is 
  106.       begin 
  107.          if file_system_routines.Compose_File_Name = null then 
  108.             return Archive_File_Name; 
  109.          else 
  110.             return file_system_routines.Compose_File_Name.all (Archive_File_Name); 
  111.          end if; 
  112.       end Full_Path_Name; 
  113.  
  114.       procedure Set_outfile (long_not_composed_name : String) is 
  115.          -- Eventually trash the archived directory structure, then 
  116.          -- eventually add/modify/ .. . another one: 
  117.          name : constant String := 
  118.            Full_Path_Name (Maybe_trash_dir (long_not_composed_name)); 
  119.       begin 
  120.          Set_definitively_named_outfile (name); 
  121.       end Set_outfile; 
  122.  
  123.       procedure Set_outfile_interactive (long_not_composed_possible_name : String) is 
  124.          -- Eventually trash the archived directory structure, then 
  125.          -- eventually add/modify/ .. . another one: 
  126.          possible_name : constant String := 
  127.            Full_Path_Name (Maybe_trash_dir (long_not_composed_possible_name)); 
  128.          new_name  : String (1 .. 1024); 
  129.          new_name_length  : Natural; 
  130.       begin 
  131.          if help_the_file_exists /= null and then Zip.Exists (possible_name) then 
  132.             loop 
  133.                case current_user_attitude is 
  134.                when yes | no | rename_it => -- then ask for this name too 
  135.                   help_the_file_exists ( 
  136.                                         possible_name, 
  137.                                         current_user_attitude, 
  138.                                         new_name, new_name_length 
  139.                                        ); 
  140.                when yes_to_all | none | abort_now => 
  141.                   exit; -- nothing to decide : previous decision was definitive 
  142.                end case; 
  143.                exit when not ( 
  144.                               current_user_attitude = rename_it and then -- new name exists too! 
  145.                               Zip.Exists (new_name (1 .. new_name_length)) 
  146.                              ); 
  147.             end loop; 
  148.  
  149.             -- User has decided. 
  150.             case current_user_attitude is 
  151.             when yes | yes_to_all => 
  152.                skip_this_file := False; 
  153.                Set_definitively_named_outfile (possible_name); 
  154.             when no | none => 
  155.                skip_this_file := True; 
  156.             when rename_it => 
  157.                skip_this_file := False; 
  158.                Set_definitively_named_outfile (new_name (1 .. new_name_length)); 
  159.             when abort_now => 
  160.                raise User_abort; 
  161.             end case; 
  162.  
  163.          else -- no name conflict or non - interactive (help_the_file_exists=null) 
  164.  
  165.             skip_this_file := False; 
  166.             Set_definitively_named_outfile (possible_name); 
  167.          end if; 
  168.       end Set_outfile_interactive; 
  169.  
  170.       procedure Inform_User ( 
  171.                              name : String; 
  172.                              comp, uncomp : File_size_type 
  173.                             ) 
  174.       is 
  175.       begin 
  176.          if tell_data /= null  then 
  177.             tell_data (name, comp, uncomp, method); 
  178.          end if; 
  179.       end Inform_User; 
  180.  
  181.       the_name     : String (1 .. 1000); 
  182.       the_name_len : Natural; 
  183.       use Zip, Zip_Streams; 
  184.  
  185.       actual_feedback : Zip.Feedback_proc; 
  186.  
  187.       dummy : p_Stream_Element_Array; 
  188.       encrypted, dummy_bool : Boolean; 
  189.  
  190.    begin 
  191.       begin 
  192.          Set_Index (zip_file, work_index); 
  193.          declare 
  194.             TempStream  : constant Zipstream_Class := zip_file; 
  195.          begin 
  196.             Zip.Headers.Read_and_check (TempStream, local_header); 
  197.          end; 
  198.       exception 
  199.          when Zip.Headers.bad_local_header => 
  200.             raise; 
  201.          when others => 
  202.             raise Read_Error; 
  203.       end; 
  204.  
  205.       method := Zip.Method_from_code (local_header.zip_type); 
  206.       if method = unknown then 
  207.          raise Unsupported_method; 
  208.       end if; 
  209.  
  210.       -- calculate offset of data 
  211.  
  212.       work_index := 
  213.         work_index + Positive (Ada.Streams.Stream_IO.Count ( 
  214.                                local_header.filename_length    + 
  215.                                  local_header.extra_field_length + 
  216.                                    Zip.Headers.local_header_length) 
  217.                               ); 
  218.  
  219.       data_descriptor_after_data := (local_header.bit_flag and 8) /= 0; 
  220.  
  221.       if data_descriptor_after_data then 
  222.          -- Sizes and CRC are stored after the data 
  223.          -- We set size to avoid getting a sudden Zip_EOF ! 
  224.          local_header.dd.crc_32            := 0; 
  225.          local_header.dd.compressed_size   := hint_comp_size; 
  226.          local_header.dd.uncompressed_size := File_size_type'Last; 
  227.          actual_feedback := null; -- no feedback possible : unknown sizes 
  228.       else 
  229.          -- Sizes and CRC are stored before the data, inside the local header 
  230.          actual_feedback := feedback; -- use the given feedback procedure 
  231.       end if; 
  232.  
  233.       encrypted := (local_header.bit_flag and 1) /= 0; 
  234.  
  235.       -- 13 - Dec - 2002 
  236.       true_packed_size := File_size_type (local_header.dd.compressed_size); 
  237.       if encrypted then 
  238.          true_packed_size := true_packed_size - 12; 
  239.       end if; 
  240.  
  241.       if name_from_header then -- Name from local header is used as output name 
  242.          the_name_len := Natural (local_header.filename_length); 
  243.          String'Read (zip_file, the_name (1 .. the_name_len)); 
  244.          if not data_descriptor_after_data then 
  245.             Inform_User ( 
  246.                          the_name (1 .. the_name_len), 
  247.                          true_packed_size, 
  248.                          File_size_type (local_header.dd.uncompressed_size) 
  249.                         ); 
  250.          end if; 
  251.          if the_name_len = 0 or else 
  252.            (the_name (the_name_len) = '/' or else 
  253.             the_name (the_name_len) = '\') 
  254.          then 
  255.             -- This is a directory name (12 - feb - 2000) 
  256.             skip_this_file := True; 
  257.          elsif actual_mode in Write_to_file then 
  258.             Set_outfile_interactive (the_name (1 .. the_name_len)); 
  259.          else -- only informational, no need for interaction 
  260.             Set_outfile (the_name (1 .. the_name_len)); 
  261.          end if; 
  262.       else -- Output name is given : out_name 
  263.          if not data_descriptor_after_data then 
  264.             Inform_User ( 
  265.                          out_name, 
  266.                          true_packed_size, 
  267.                          File_size_type (local_header.dd.uncompressed_size) 
  268.                         ); 
  269.          end if; 
  270.          if out_name'Length = 0 or else 
  271.            (out_name (out_name'Last) = '/' or else 
  272.             out_name (out_name'Last) = '\') 
  273.          then 
  274.             -- This is a directory name, so do not write anything (30 - Jan - 2012). 
  275.             skip_this_file := True; 
  276.          elsif actual_mode in Write_to_file then 
  277.             Set_outfile_interactive (out_name); 
  278.          else -- only informational, no need for interaction 
  279.             Set_outfile (out_name); 
  280.          end if; 
  281.       end if; 
  282.  
  283.       if skip_this_file then 
  284.          actual_mode := just_test; 
  285.       end if; 
  286.  
  287.       if skip_this_file and not data_descriptor_after_data then 
  288.          -- We can skip actually since sizes are known. 
  289.          if feedback /= null then 
  290.             feedback ( 
  291.                       percents_done => 0, 
  292.                       entry_skipped => True, 
  293.                       user_abort    => dummy_bool 
  294.                      ); 
  295.          end if; 
  296.       else 
  297.          begin 
  298.             Set_Index (zip_file, work_index); -- eventually skips the file name 
  299.          exception 
  300.             when others => raise Read_Error; 
  301.          end; 
  302.          UnZip.Decompress.Decompress_data ( 
  303.                                            zip_file             => zip_file, 
  304.                                            format               => method, 
  305.                                            mode                 => actual_mode, 
  306.                                            output_file_name     => To_String (the_output_name), 
  307.                                            output_memory_access => dummy, 
  308.                                            feedback             => actual_feedback, 
  309.                                            explode_literal_tree => (local_header.bit_flag and 4) /= 0, 
  310.                                            explode_slide_8KB    => (local_header.bit_flag and 2) /= 0, 
  311.                                            end_data_descriptor  => data_descriptor_after_data, 
  312.                                            encrypted            => encrypted, 
  313.                                            password             => password, 
  314.                                            get_new_password     => get_pwd, 
  315.                                            hint                 => local_header.dd 
  316.                                           ); 
  317.  
  318.          if actual_mode /= just_test then 
  319.             if file_system_routines.Set_Time_Stamp /= null then 
  320.                file_system_routines.Set_Time_Stamp ( 
  321.                                                     To_String (the_output_name), 
  322.                                                     Convert (local_header.file_timedate) 
  323.                                                    ); 
  324.             elsif file_system_routines.Set_ZTime_Stamp /= null then 
  325.                file_system_routines.Set_ZTime_Stamp ( 
  326.                                                      To_String (the_output_name), 
  327.                                                      local_header.file_timedate 
  328.                                                     ); 
  329.             end if; 
  330.          end if; 
  331.  
  332.          if data_descriptor_after_data then -- Sizes and CRC at the end 
  333.             -- Inform after decompression 
  334.             Inform_User ( 
  335.                          To_String (the_output_name), 
  336.                          local_header.dd.compressed_size, 
  337.                          local_header.dd.uncompressed_size 
  338.                         ); 
  339.          end if; 
  340.  
  341.       end if; -- not (skip_this_file and not data_descriptor) 
  342.  
  343.       -- Set the offset on the next zipped file 
  344.       header_index := header_index + Positive ( 
  345.                                                Ada.Streams.Stream_IO.Count ( 
  346.                                                  File_size_type ( 
  347.                                                    local_header.filename_length    + 
  348.                                                      local_header.extra_field_length + 
  349.                                                        Zip.Headers.local_header_length 
  350.                                                   ) + 
  351.                                                    local_header.dd.compressed_size 
  352.                                                 )); 
  353.  
  354.       if data_descriptor_after_data then 
  355.          header_index := 
  356.            header_index + Positive ( 
  357.                                     Ada.Streams.Stream_IO.Count (Zip.Headers.data_descriptor_length)); 
  358.       end if; 
  359.  
  360.    end UnZipFile; 
  361.  
  362.    ---------------------------------- 
  363.    -- Simple extraction procedures -- 
  364.    ---------------------------------- 
  365.  
  366.    -- Extract all files from an archive (from) 
  367.  
  368.    procedure Extract (from                  : String; 
  369.                       options               : Option_set := no_option; 
  370.                       password              : String := ""; 
  371.                       file_system_routines  : FS_routines_type := null_routines 
  372.                      ) is 
  373.    begin 
  374.       Extract (from, null, null, null, null, 
  375.                options, password, file_system_routines); 
  376.    end Extract; 
  377.  
  378.    procedure Extract (from                  : String; 
  379.                       what                  : String; 
  380.                       options               : Option_set := no_option; 
  381.                       password              : String := ""; 
  382.                       file_system_routines  : FS_routines_type := null_routines 
  383.                      ) is 
  384.    begin 
  385.       Extract (from, what, null, null, null, null, 
  386.                options, password, file_system_routines); 
  387.    end Extract; 
  388.  
  389.    procedure Extract (from                  : String; 
  390.                       what                  : String; 
  391.                       rename                : String; 
  392.                       options               : Option_set := no_option; 
  393.                       password              : String := ""; 
  394.                       file_system_routines  : FS_routines_type := null_routines 
  395.                      ) is 
  396.    begin 
  397.       Extract (from, what, rename, null, null, null, 
  398.                options, password, file_system_routines); 
  399.    end Extract; 
  400.  
  401.    procedure Extract (from                  : Zip.Zip_info; 
  402.                       options               : Option_set := no_option; 
  403.                       password              : String := ""; 
  404.                       file_system_routines  : FS_routines_type := null_routines 
  405.                      ) is 
  406.    begin 
  407.       Extract (from, null, null, null, null, 
  408.                options, password, file_system_routines); 
  409.    end Extract; 
  410.  
  411.    procedure Extract (from                  : Zip.Zip_info; 
  412.                       what                  : String; 
  413.                       options               : Option_set := no_option; 
  414.                       password              : String := ""; 
  415.                       file_system_routines  : FS_routines_type := null_routines 
  416.                      ) is 
  417.    begin 
  418.       Extract (from, what, null, null, null, null, 
  419.                options, password, file_system_routines); 
  420.    end Extract; 
  421.  
  422.    procedure Extract (from                  : Zip.Zip_info; 
  423.                       what                  : String; 
  424.                       rename                : String; 
  425.                       options               : Option_set := no_option; 
  426.                       password              : String := ""; 
  427.                       file_system_routines  : FS_routines_type := null_routines 
  428.                      ) is 
  429.    begin 
  430.       Extract (from, what, rename, null, null, null, 
  431.                options, password, file_system_routines); 
  432.    end Extract; 
  433.  
  434.    -- All previous extract call the following ones, with bogus UI arguments 
  435.  
  436.    ------------------------------------------------------------ 
  437.    -- All previous extraction procedures, for user interface -- 
  438.    ------------------------------------------------------------ 
  439.  
  440.    use Ada.Streams.Stream_IO; 
  441.  
  442.    -- Extract one precise file (what) from an archive (from) 
  443.  
  444.    procedure Extract (from                  : String; 
  445.                       what                  : String; 
  446.                       feedback              : Zip.Feedback_proc; 
  447.                       help_the_file_exists  : Resolve_conflict_proc; 
  448.                       tell_data             : Tell_data_proc; 
  449.                       get_pwd               : Get_password_proc; 
  450.                       options               : Option_set := no_option; 
  451.                       password              : String := ""; 
  452.                       file_system_routines  : FS_routines_type := null_routines) is 
  453.  
  454.       use Zip, Zip_Streams; 
  455.  
  456.       MyStream      : aliased File_Zipstream; 
  457.       -- was Unbounded_Stream & file - >buffer copy in v.26 
  458.       zip_file      : constant Zipstream_Class := MyStream'Unchecked_Access; 
  459.       header_index  : Positive; 
  460.       comp_size     : File_size_type; 
  461.       uncomp_size   : File_size_type; 
  462.       work_password : Unbounded_String := To_Unbounded_String (password); 
  463.  
  464.    begin 
  465.       if feedback = null then 
  466.          current_user_attitude := yes_to_all; -- non - interactive 
  467.       end if; 
  468.       Set_Name (zip_file, from); 
  469.       Open (MyStream, In_File); 
  470.       Zip.Find_offset (zip_file, 
  471.                        what, options (case_sensitive_match), 
  472.                        header_index, 
  473.                        comp_size, 
  474.                        uncomp_size); 
  475.       pragma Unreferenced (uncomp_size); 
  476.  
  477.       UnZipFile (zip_file, 
  478.                  what, False, 
  479.                  header_index, 
  480.                  comp_size, 
  481.                  feedback, help_the_file_exists, tell_data, get_pwd, 
  482.                  options, 
  483.                  work_password, 
  484.                  file_system_routines); 
  485.       pragma Unreferenced (header_index, work_password); 
  486.  
  487.       Close (MyStream); 
  488.    end Extract; 
  489.  
  490.    -- Extract one precise file (what) from an archive (from), 
  491.    -- but save under a new name (rename) 
  492.  
  493.    procedure Extract (from                  : String; 
  494.                       what                  : String; 
  495.                       rename                : String; 
  496.                       feedback              : Zip.Feedback_proc; 
  497.                       tell_data             : Tell_data_proc; 
  498.                       get_pwd               : Get_password_proc; 
  499.                       options               : Option_set := no_option; 
  500.                       password              : String := ""; 
  501.                       file_system_routines  : FS_routines_type := null_routines 
  502.                      ) 
  503.    is 
  504.       use Zip, Zip_Streams; 
  505.       MyStream      : aliased File_Zipstream; 
  506.       -- was Unbounded_Stream & file - >buffer copy in v.26 
  507.       zip_file      : constant Zipstream_Class := MyStream'Unchecked_Access; 
  508.       header_index  : Positive; 
  509.       comp_size     : File_size_type; 
  510.       uncomp_size   : File_size_type; 
  511.       work_password : Unbounded_String := To_Unbounded_String (password); 
  512.    begin 
  513.       if feedback = null then 
  514.          current_user_attitude := yes_to_all; -- non - interactive 
  515.       end if; 
  516.       Set_Name (zip_file, from); 
  517.       Open (MyStream, In_File); 
  518.       Zip.Find_offset (zip_file, 
  519.                        what, options (case_sensitive_match), 
  520.                        header_index, 
  521.                        comp_size, 
  522.                        uncomp_size); 
  523.       pragma Unreferenced (uncomp_size); 
  524.  
  525.       UnZipFile (zip_file, 
  526.                  rename, False, 
  527.                  header_index, 
  528.                  comp_size, 
  529.                  feedback, null, tell_data, get_pwd, 
  530.                  options, 
  531.                  work_password, 
  532.                  file_system_routines); 
  533.       pragma Unreferenced (header_index, work_password); 
  534.  
  535.       Close (MyStream); 
  536.    end Extract; 
  537.  
  538.    -- Extract all files from an archive (from) 
  539.  
  540.    procedure Extract (from                  : String; 
  541.                       feedback              : Zip.Feedback_proc; 
  542.                       help_the_file_exists  : Resolve_conflict_proc; 
  543.                       tell_data             : Tell_data_proc; 
  544.                       get_pwd               : Get_password_proc; 
  545.                       options               : Option_set := no_option; 
  546.                       password              : String := ""; 
  547.                       file_system_routines  : FS_routines_type := null_routines 
  548.                      ) 
  549.    is 
  550.       use Zip, Zip_Streams; 
  551.       MyStream      : aliased File_Zipstream; 
  552.       -- was Unbounded_Stream & file - >buffer copy in v.26 
  553.       zip_file      : constant Zipstream_Class := MyStream'Unchecked_Access; 
  554.       header_index  : Positive; 
  555.       work_password : Unbounded_String := To_Unbounded_String (password); 
  556.    begin 
  557.       if feedback = null then 
  558.          current_user_attitude := yes_to_all; -- non - interactive 
  559.       end if; 
  560.       Set_Name (zip_file, from); 
  561.       Open (MyStream, In_File); 
  562.       Zip.Find_first_offset (zip_file, header_index); -- >= 13 - May - 2001 
  563.       -- We simply unzip everything sequentially, until the end: 
  564.       all_files : loop 
  565.          UnZipFile ( 
  566.                     zip_file, 
  567.                     "", True, 
  568.                     header_index, 
  569.                     File_size_type'Last, 
  570.                     -- ^ no better hint available if comp_size is 0 in local header 
  571.                     feedback, help_the_file_exists, tell_data, get_pwd, 
  572.                     options, 
  573.                     work_password, 
  574.                     file_system_routines 
  575.                    ); 
  576.       end loop all_files; 
  577.    exception 
  578.       when Zip.Headers.bad_local_header => 
  579.          Close (MyStream); -- normal case : end was hit 
  580.       when Zip.Zip_file_open_Error => 
  581.          raise;    -- couldn't open zip file 
  582.       when others => 
  583.          Close (MyStream); 
  584.          raise;    -- something else wrong 
  585.    end Extract; 
  586.  
  587.    -- Extract all files from an archive (from) 
  588.    -- Needs Zip.Load (from, . .. ) prior to the extraction 
  589.  
  590.    procedure Extract (from                  : Zip.Zip_info; 
  591.                       feedback              : Zip.Feedback_proc; 
  592.                       help_the_file_exists  : Resolve_conflict_proc; 
  593.                       tell_data             : Tell_data_proc; 
  594.                       get_pwd               : Get_password_proc; 
  595.                       options               : Option_set := no_option; 
  596.                       password              : String := ""; 
  597.                       file_system_routines  : FS_routines_type := null_routines 
  598.                      ) 
  599.    is 
  600.       procedure Extract_1_file (name : String) is 
  601.       begin 
  602.          Extract (from => from, 
  603.                   what => name, 
  604.                   feedback => feedback, 
  605.                   help_the_file_exists => help_the_file_exists, 
  606.                   tell_data => tell_data, 
  607.                   get_pwd => get_pwd, 
  608.                   options => options, 
  609.                   password => password, 
  610.                   file_system_routines => file_system_routines 
  611.                  ); 
  612.       end Extract_1_file; 
  613.       -- 
  614.       procedure Extract_all_files is new Zip.Traverse (Extract_1_file); 
  615.       -- 
  616.    begin 
  617.       Extract_all_files (from); 
  618.    end Extract; 
  619.  
  620.    -- Extract one precise file (what) from an archive (from) 
  621.    -- Needs Zip.Load (from, . .. ) prior to the extraction 
  622.  
  623.    procedure Extract (from                  : Zip.Zip_info; 
  624.                       what                  : String; 
  625.                       feedback              : Zip.Feedback_proc; 
  626.                       help_the_file_exists  : Resolve_conflict_proc; 
  627.                       tell_data             : Tell_data_proc; 
  628.                       get_pwd               : Get_password_proc; 
  629.                       options               : Option_set := no_option; 
  630.                       password              : String := ""; 
  631.                       file_system_routines  : FS_routines_type := null_routines 
  632.                      ) is 
  633.  
  634.       header_index  : Positive; 
  635.       comp_size     : File_size_type; 
  636.       uncomp_size   : File_size_type; 
  637.       work_password : Unbounded_String := To_Unbounded_String (password); 
  638.       use Zip, Zip_Streams; 
  639.       MyStream      : aliased File_Zipstream; 
  640.       input_stream  : Zipstream_Class; 
  641.       use_a_file    : constant Boolean := Zip.Zip_Stream (from) = null; 
  642.    begin 
  643.       if use_a_file then 
  644.          input_stream := MyStream'Unchecked_Access; 
  645.          Set_Name (input_stream, Zip.Zip_name (from)); 
  646.          Open (MyStream, Ada.Streams.Stream_IO.In_File); 
  647.       else -- use the given stream 
  648.          input_stream := Zip.Zip_Stream (from); 
  649.       end if; 
  650.       if feedback = null then 
  651.          current_user_attitude := yes_to_all; -- non - interactive 
  652.       end if; 
  653.       Zip.Find_offset (from, what, options (case_sensitive_match), 
  654.                        Ada.Streams.Stream_IO.Positive_Count (header_index), 
  655.                        comp_size, 
  656.                        uncomp_size); 
  657.       pragma Unreferenced (uncomp_size); 
  658.  
  659.       UnZipFile (input_stream, 
  660.                  what, False, 
  661.                  header_index, 
  662.                  comp_size, 
  663.                  feedback, help_the_file_exists, tell_data, get_pwd, 
  664.                  options, 
  665.                  work_password, 
  666.                  file_system_routines); 
  667.       pragma Unreferenced (header_index, work_password); 
  668.  
  669.       if use_a_file then 
  670.          Close (MyStream); 
  671.       end if; 
  672.    end Extract; 
  673.  
  674.    -- Extract one precise file (what) from an archive (from) 
  675.    -- but save under a new name (rename) 
  676.    -- Needs Zip.Load (from, . .. ) prior to the extraction 
  677.  
  678.    procedure Extract (from                  : Zip.Zip_info; 
  679.                       what                  : String; 
  680.                       rename                : String; 
  681.                       feedback              : Zip.Feedback_proc; 
  682.                       tell_data             : Tell_data_proc; 
  683.                       get_pwd               : Get_password_proc; 
  684.                       options               : Option_set := no_option; 
  685.                       password              : String := ""; 
  686.                       file_system_routines  : FS_routines_type := null_routines 
  687.                      ) is 
  688.  
  689.       header_index  : Positive; 
  690.       comp_size     : File_size_type; 
  691.       uncomp_size   : File_size_type; 
  692.       work_password : Unbounded_String := To_Unbounded_String (password); 
  693.       use Zip, Zip_Streams; 
  694.       MyStream      : aliased File_Zipstream; 
  695.       input_stream  : Zipstream_Class; 
  696.       use_a_file    : constant Boolean := Zip.Zip_Stream (from) = null; 
  697.    begin 
  698.       if use_a_file then 
  699.          input_stream := MyStream'Unchecked_Access; 
  700.          Set_Name (input_stream, Zip.Zip_name (from)); 
  701.          Open (MyStream, Ada.Streams.Stream_IO.In_File); 
  702.       else -- use the given stream 
  703.          input_stream := Zip.Zip_Stream (from); 
  704.       end if; 
  705.       if feedback = null then 
  706.          current_user_attitude := yes_to_all; -- non - interactive 
  707.       end if; 
  708.       Zip.Find_offset (from, what, options (case_sensitive_match), 
  709.                        Ada.Streams.Stream_IO.Positive_Count (header_index), 
  710.                        comp_size, 
  711.                        uncomp_size); 
  712.       pragma Unreferenced (uncomp_size); 
  713.  
  714.       UnZipFile (input_stream, 
  715.                  rename, 
  716.                  False, 
  717.                  header_index, 
  718.                  comp_size, 
  719.                  feedback, null, tell_data, get_pwd, 
  720.                  options, 
  721.                  work_password, 
  722.                  file_system_routines); 
  723.       pragma Unreferenced (header_index, work_password); 
  724.  
  725.       if use_a_file then 
  726.          Close (MyStream); 
  727.       end if; 
  728.    end Extract; 
  729.  
  730. end UnZip;