Source file : zip.ads
-- ________ ___ ______ ______ ___
-- /___..._/ |.| |.___.\ /. __ .\ __|.| ____
-- /../ |.| |.____/ |.|__|.| /....| __\..\
-- _/../___ |.| |.| === |..__..||. = .| | = ..|
-- /_______/ |_| /__| /__| |_| \__\_| \__\_|
-- Zip library
--------------
-- Library for manipulating archive files in the Zip format
--
-- Pure Ada 95+ code, 100% portable: OS-, CPU- and compiler- independent.
--
-- Version / date / download info: see the version, reference, web strings
-- defined at the end of the public part of this package.
-- Legal licensing note:
-- Copyright (c) 1999 .. 2016 Gautier de Montmollin
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.
-- NB: this is the MIT License, as found 12-Sep-2007 on the site
-- http://www.opensource.org/licenses/mit-license.php
with Zip_Streams;
with Ada.Calendar, Ada.Streams.Stream_IO, Ada.Text_IO;
with Interfaces;
with System;
package Zip is
--------------
-- Zip_info --
--------------
-- Zip_info contains the Zip file name or input stream,
-- and the archive's sorted directory
type Zip_info is private;
-----------------------------------------------------------------------
-- Load the whole .zip directory in archive (from) into a tree, for --
-- fast searching --
-----------------------------------------------------------------------
type Duplicate_name_policy is
( admit_duplicates, -- two entries in the Zip archive may have the same full name
error_on_duplicate -- raise exception on attempt to add twice the same entry name
);
-- Load from a file
procedure Load(
info : out Zip_info;
from : in String; -- Zip file name
case_sensitive : in Boolean:= False;
duplicate_names : in Duplicate_name_policy:= error_on_duplicate
);
-- Load from a stream
procedure Load(
info : out Zip_info;
from : in out Zip_Streams.Root_Zipstream_Type'Class;
case_sensitive : in Boolean:= False;
duplicate_names : in Duplicate_name_policy:= error_on_duplicate
);
Zip_file_Error,
Zip_file_open_Error,
Duplicate_name: exception;
function Is_loaded( info: in Zip_info ) return Boolean;
function Zip_name( info: in Zip_info ) return String;
function Zip_comment( info: in Zip_info ) return String;
function Zip_stream( info: in Zip_info ) return Zip_Streams.Zipstream_Class_Access;
function Entries( info: in Zip_info ) return Natural;
procedure Delete( info : in out Zip_info );
Forgot_to_load_zip_info: exception;
-- Data sizes in archive
subtype File_size_type is Interfaces.Unsigned_32;
---------
-- Compression methods or formats in the "official" PKWARE Zip format.
-- Details in appnote.txt, part V.J
-- C: supported by Zip-Ada for compressing
-- D: supported by Zip-Ada for decompressing
type PKZip_method is
( store, -- C,D
shrink, -- C,D
reduce_1, -- C,D
reduce_2, -- C,D
reduce_3, -- C,D
reduce_4, -- C,D
implode, -- D
tokenize,
deflate, -- C,D
deflate_e, -- D - Enhanced deflate
bzip2, -- D
lzma, -- D
ppmd,
unknown
);
subtype reduce is PKZip_method range reduce_1..reduce_4;
-- Technical: translates the method code as set in zip archives
function Method_from_code(x: Interfaces.Unsigned_16) return PKZip_method;
function Method_from_code(x: Natural) return PKZip_method;
-- Internal time definition
subtype Time is Zip_Streams.Time;
function Convert(date : in Ada.Calendar.Time) return Time
renames Zip_Streams.Calendar.Convert;
function Convert(date : in Time) return Ada.Calendar.Time
renames Zip_Streams.Calendar.Convert;
-- Entry names within Zip archives are encoded either with
-- * the IBM PC (the one with a monochrome screen, only text mode)'s
-- character set: IBM 437
-- or
-- * Unicode UTF-8
--
-- Documentation: PKWARE's Appnote.txt, APPENDIX D - Language Encoding (EFS)
type Zip_name_encoding is (IBM_437, UTF_8);
-- Traverse a whole Zip_info directory in sorted order, giving the
-- name for each entry to an user-defined "Action" procedure.
-- Concretely, you can process a whole Zip file that way, by extracting data
-- with Extract, or open a reader stream with UnZip.Streams.
-- See the Comp_Zip or Find_Zip tools as application examples.
generic
with procedure Action( name: String ); -- 'name' is compressed entry's name
procedure Traverse( z: Zip_info );
-- Same as Traverse, but Action gives also full name information.
-- The pair (name, name_encoding) allows for an unambiguous Unicode
-- name decoding. See the AZip project for an implementation.
generic
with procedure Action(
name : String; -- 'name' is compressed entry's name
name_encoding : Zip_name_encoding
);
procedure Traverse_Unicode( z: Zip_info );
-- Same as Traverse, but Action gives also full technical informations
-- about the compressed entry.
generic
with procedure Action(
name : String; -- 'name' is compressed entry's name
file_index : Zip_Streams.ZS_Index_Type;
comp_size : File_size_type;
uncomp_size : File_size_type;
crc_32 : Interfaces.Unsigned_32;
date_time : Time;
method : PKZip_method;
name_encoding : Zip_name_encoding;
read_only : Boolean;
encrypted_2_x : Boolean; -- PKZip 2.x encryption
user_code : in out Integer
);
procedure Traverse_verbose( z: Zip_info );
-- Academic: see how well the name tree is balanced
procedure Tree_stat(
z : in Zip_info;
total : out Natural;
max_depth: out Natural;
avg_depth: out Float
);
--------------------------------------------------------------------------
-- Offsets - various procedures giving 1-based indexes to local headers --
--------------------------------------------------------------------------
-- Find 1st offset in a Zip stream
procedure Find_first_offset(
file : in out Zip_Streams.Root_Zipstream_Type'Class;
file_index : out Zip_Streams.ZS_Index_Type );
-- Find offset of a certain compressed file
-- in a Zip file (file opened and kept open)
procedure Find_offset(
file : in out Zip_Streams.Root_Zipstream_Type'Class;
name : in String;
case_sensitive : in Boolean;
file_index : out Zip_Streams.ZS_Index_Type;
comp_size : out File_size_type;
uncomp_size : out File_size_type;
crc_32 : out Interfaces.Unsigned_32
);
-- Find offset of a certain compressed file in a Zip_info data
procedure Find_offset(
info : in Zip_info;
name : in String;
name_encoding : out Zip_name_encoding;
file_index : out Zip_Streams.ZS_Index_Type;
comp_size : out File_size_type;
uncomp_size : out File_size_type;
crc_32 : out Interfaces.Unsigned_32
);
File_name_not_found: exception;
function Exists(info: Zip_info; name: String) return Boolean;
-- User code: any information e.g. as a result of a string search,
-- archive comparison, archive update, recompression,...
procedure Set_user_code(
info : in Zip_info;
name : in String;
code : in Integer
);
function User_code(
info : in Zip_info;
name : in String
)
return Integer;
procedure Get_sizes(
info : in Zip_info;
name : in String;
comp_size : out File_size_type;
uncomp_size : out File_size_type
);
-- User-defined procedure for feedback occuring during
-- compression or decompression (entry_skipped meaningful
-- only for the latter)
type Feedback_proc is access
procedure (
percents_done: in Natural; -- %'s completed
entry_skipped: in Boolean; -- indicates one can show "skipped", no %'s
user_abort : out Boolean -- e.g. transmit a "click on Cancel" here
);
-------------------------------------------------------------------------
-- Goodies - things used internally by Zip-Ada but are not bound to --
-- Zip archive purposes and that might be generally useful. --
-------------------------------------------------------------------------
-- BlockRead: general-purpose procedure (nothing really specific to Zip /
-- UnZip): reads either the whole buffer from a file, or if the end of
-- the file lays inbetween, a part of the buffer.
--
-- The procedure's names and parameters match Borland Pascal / Delphi
subtype Byte is Interfaces.Unsigned_8;
type Byte_Buffer is array(Integer range <>) of aliased Byte;
type p_Byte_Buffer is access Byte_Buffer;
procedure BlockRead(
file : in Ada.Streams.Stream_IO.File_Type;
buffer : out Byte_Buffer;
actually_read: out Natural
-- = buffer'Length if no end of file before last buffer element
);
-- Same for general streams
--
procedure BlockRead(
stream : in out Zip_Streams.Root_Zipstream_Type'Class;
buffer : out Byte_Buffer;
actually_read: out Natural
-- = buffer'Length if no end of stream before last buffer element
);
-- Same, but instead of giving actually_read, raises End_Error if
-- the buffer cannot be fully read.
-- This mimics the 'Read stream attribute; can be a lot faster, depending
-- on the compiler's run-time library.
procedure BlockRead(
stream : in out Zip_Streams.Root_Zipstream_Type'Class;
buffer : out Byte_Buffer
);
-- This mimics the 'Write stream attribute; can be a lot faster, depending
-- on the compiler's run-time library.
-- NB: here we can use the root stream type: no question of size, index,...
procedure BlockWrite(
stream : in out Ada.Streams.Root_Stream_Type'Class;
buffer : in Byte_Buffer
);
-- Copy a chunk from a stream into another one, using a temporary buffer
procedure Copy_chunk (
from : in out Zip_Streams.Root_Zipstream_Type'Class;
into : in out Ada.Streams.Root_Stream_Type'Class;
bytes : Natural;
buffer_size: Positive:= 1024*1024;
Feedback : Feedback_proc:= null
);
-- Copy a whole file into a stream, using a temporary buffer
procedure Copy_file(
file_name : String;
into : in out Ada.Streams.Root_Stream_Type'Class;
buffer_size: Positive:= 1024*1024
);
-- This does the same as Ada 2005's Ada.Directories.Exists
-- Just there as helper for Ada 95 only systems
--
function Exists(name:String) return Boolean;
-- Write a string containing line endings (possibly from another system)
-- into a text file, with the "correct", native line endings.
-- Works for displaying/saving correctly
-- CR&LF (DOS/Win), LF (UNIX), CR (Mac OS < 9)
--
procedure Put_Multi_Line(
out_file : Ada.Text_IO.File_Type;
text : String
);
procedure Write_as_text(
out_file : Ada.Text_IO.File_Type;
buffer : Byte_Buffer;
last_char: in out Character -- track line-ending characters between writes
);
function Hexadecimal(x: Interfaces.Unsigned_32) return String;
-- In case you want to use the Zip.LZ77 compression procedure
-- separately, you need to pick an appropriate method
--
type LZ77_method is (LZHuf, IZ_4, IZ_5, IZ_6, IZ_7, IZ_8, IZ_9, IZ_10);
--------------------------------------------------------------
-- Information about this package - e.g. for an "about" box --
--------------------------------------------------------------
version : constant String:= "50_f1";
reference : constant String:= "27-Apr-2016";
web : constant String:= "http://unzip-ada.sf.net/";
-- hopefully the latest version is at that URL... ---^
-------------------
-- Private items --
-------------------
private
-- Zip_info, 23.VI.1999.
-- The PKZIP central directory is coded here as a binary tree
-- to allow a fast retrieval of the searched offset in zip file.
-- E.g. for a 1000-file archive, the offset will be found in less
-- than 11 moves: 2**10=1024 (balanced case), without any read
-- in the archive.
type Dir_node;
type p_Dir_node is access Dir_node;
type Dir_node(name_len: Natural) is record
left, right : p_Dir_node;
dico_name : String(1..name_len); -- UPPER if case-insensitive search
file_name : String(1..name_len);
file_index : Zip_Streams.ZS_Index_Type;
comp_size : File_size_type;
uncomp_size : File_size_type;
crc_32 : Interfaces.Unsigned_32;
date_time : Time;
method : PKZip_method;
name_encoding : Zip_name_encoding;
read_only : Boolean; -- TBD: attributes of most supported systems
encrypted_2_x : Boolean;
user_code : Integer;
end record;
type p_String is access String;
type Zip_info is record
loaded : Boolean:= False;
case_sensitive : Boolean;
zip_file_name : p_String; -- a file name...
zip_input_stream: Zip_Streams.Zipstream_Class_Access; -- ...or an input stream
-- ^ when not null, we use this and not zip_file_name
dir_binary_tree : p_Dir_node;
total_entries : Natural;
zip_file_comment: p_String;
end record;
-- System.Word_Size: 13.3(8): A word is the largest amount of storage
-- that can be conveniently and efficiently manipulated by the hardware,
-- given the implementation's run-time model.
--
min_bits_32: constant:= Integer'Max(32, System.Word_Size);
min_bits_16: constant:= Integer'Max(16, System.Word_Size);
-- We define an Integer type which is at least 32 bits, but n bits
-- on a native n (> 32) bits architecture (no performance hit on 64+
-- bits architectures).
-- Integer_M16 not needed: Integer already guarantees 16 bits
--
type Integer_M32 is range -2**(min_bits_32-1) .. 2**(min_bits_32-1) - 1;
subtype Natural_M32 is Integer_M32 range 0..Integer_M32'Last;
subtype Positive_M32 is Integer_M32 range 1..Integer_M32'Last;
type Unsigned_M16 is mod 2**min_bits_16;
type Unsigned_M32 is mod 2**min_bits_32;
end Zip;
GLOBE_3D: Ada library for real-time 3D rendering.
Ada programming.