zlib-streams.adb
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:6k
源码类别:

通讯编程

开发平台:

Visual C++

  1. ----------------------------------------------------------------
  2. --  ZLib for Ada thick binding.                               --
  3. --                                                            --
  4. --  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
  5. --                                                            --
  6. --  Open source license information is in the zlib.ads file.  --
  7. ----------------------------------------------------------------
  8. --  $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
  9. with Ada.Unchecked_Deallocation;
  10. package body ZLib.Streams is
  11.    -----------
  12.    -- Close --
  13.    -----------
  14.    procedure Close (Stream : in out Stream_Type) is
  15.       procedure Free is new Ada.Unchecked_Deallocation
  16.          (Stream_Element_Array, Buffer_Access);
  17.    begin
  18.       if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
  19.          --  We should flush the data written by the writer.
  20.          Flush (Stream, Finish);
  21.          Close (Stream.Writer);
  22.       end if;
  23.       if Stream.Mode = In_Stream or Stream.Mode = Duplex then
  24.          Close (Stream.Reader);
  25.          Free (Stream.Buffer);
  26.       end if;
  27.    end Close;
  28.    ------------
  29.    -- Create --
  30.    ------------
  31.    procedure Create
  32.      (Stream            :    out Stream_Type;
  33.       Mode              : in     Stream_Mode;
  34.       Back              : in     Stream_Access;
  35.       Back_Compressed   : in     Boolean;
  36.       Level             : in     Compression_Level := Default_Compression;
  37.       Strategy          : in     Strategy_Type     := Default_Strategy;
  38.       Header            : in     Header_Type       := Default;
  39.       Read_Buffer_Size  : in     Ada.Streams.Stream_Element_Offset
  40.                                     := Default_Buffer_Size;
  41.       Write_Buffer_Size : in     Ada.Streams.Stream_Element_Offset
  42.                                     := Default_Buffer_Size)
  43.    is
  44.       subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);
  45.       procedure Init_Filter
  46.          (Filter   : in out Filter_Type;
  47.           Compress : in     Boolean);
  48.       -----------------
  49.       -- Init_Filter --
  50.       -----------------
  51.       procedure Init_Filter
  52.          (Filter   : in out Filter_Type;
  53.           Compress : in     Boolean) is
  54.       begin
  55.          if Compress then
  56.             Deflate_Init
  57.               (Filter, Level, Strategy, Header => Header);
  58.          else
  59.             Inflate_Init (Filter, Header => Header);
  60.          end if;
  61.       end Init_Filter;
  62.    begin
  63.       Stream.Back := Back;
  64.       Stream.Mode := Mode;
  65.       if Mode = Out_Stream or Mode = Duplex then
  66.          Init_Filter (Stream.Writer, Back_Compressed);
  67.          Stream.Buffer_Size := Write_Buffer_Size;
  68.       else
  69.          Stream.Buffer_Size := 0;
  70.       end if;
  71.       if Mode = In_Stream or Mode = Duplex then
  72.          Init_Filter (Stream.Reader, not Back_Compressed);
  73.          Stream.Buffer     := new Buffer_Subtype;
  74.          Stream.Rest_First := Stream.Buffer'Last + 1;
  75.          Stream.Rest_Last  := Stream.Buffer'Last;
  76.       end if;
  77.    end Create;
  78.    -----------
  79.    -- Flush --
  80.    -----------
  81.    procedure Flush
  82.      (Stream : in out Stream_Type;
  83.       Mode   : in     Flush_Mode := Sync_Flush)
  84.    is
  85.       Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
  86.       Last   : Stream_Element_Offset;
  87.    begin
  88.       loop
  89.          Flush (Stream.Writer, Buffer, Last, Mode);
  90.          Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
  91.          exit when Last < Buffer'Last;
  92.       end loop;
  93.    end Flush;
  94.    -------------
  95.    -- Is_Open --
  96.    -------------
  97.    function Is_Open (Stream : Stream_Type) return Boolean is
  98.    begin
  99.       return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
  100.    end Is_Open;
  101.    ----------
  102.    -- Read --
  103.    ----------
  104.    procedure Read
  105.      (Stream : in out Stream_Type;
  106.       Item   :    out Stream_Element_Array;
  107.       Last   :    out Stream_Element_Offset)
  108.    is
  109.       procedure Read
  110.         (Item : out Stream_Element_Array;
  111.          Last : out Stream_Element_Offset);
  112.       ----------
  113.       -- Read --
  114.       ----------
  115.       procedure Read
  116.         (Item : out Stream_Element_Array;
  117.          Last : out Stream_Element_Offset) is
  118.       begin
  119.          Ada.Streams.Read (Stream.Back.all, Item, Last);
  120.       end Read;
  121.       procedure Read is new ZLib.Read
  122.          (Read       => Read,
  123.           Buffer     => Stream.Buffer.all,
  124.           Rest_First => Stream.Rest_First,
  125.           Rest_Last  => Stream.Rest_Last);
  126.    begin
  127.       Read (Stream.Reader, Item, Last);
  128.    end Read;
  129.    -------------------
  130.    -- Read_Total_In --
  131.    -------------------
  132.    function Read_Total_In (Stream : in Stream_Type) return Count is
  133.    begin
  134.       return Total_In (Stream.Reader);
  135.    end Read_Total_In;
  136.    --------------------
  137.    -- Read_Total_Out --
  138.    --------------------
  139.    function Read_Total_Out (Stream : in Stream_Type) return Count is
  140.    begin
  141.       return Total_Out (Stream.Reader);
  142.    end Read_Total_Out;
  143.    -----------
  144.    -- Write --
  145.    -----------
  146.    procedure Write
  147.      (Stream : in out Stream_Type;
  148.       Item   : in     Stream_Element_Array)
  149.    is
  150.       procedure Write (Item : in Stream_Element_Array);
  151.       -----------
  152.       -- Write --
  153.       -----------
  154.       procedure Write (Item : in Stream_Element_Array) is
  155.       begin
  156.          Ada.Streams.Write (Stream.Back.all, Item);
  157.       end Write;
  158.       procedure Write is new ZLib.Write
  159.          (Write       => Write,
  160.           Buffer_Size => Stream.Buffer_Size);
  161.    begin
  162.       Write (Stream.Writer, Item, No_Flush);
  163.    end Write;
  164.    --------------------
  165.    -- Write_Total_In --
  166.    --------------------
  167.    function Write_Total_In (Stream : in Stream_Type) return Count is
  168.    begin
  169.       return Total_In (Stream.Writer);
  170.    end Write_Total_In;
  171.    ---------------------
  172.    -- Write_Total_Out --
  173.    ---------------------
  174.    function Write_Total_Out (Stream : in Stream_Type) return Count is
  175.    begin
  176.       return Total_Out (Stream.Writer);
  177.    end Write_Total_Out;
  178. end ZLib.Streams;