(* ***** BEGIN LICENSE BLOCK *****
 * This program, "bzip2", the associated library "libbzip2", and all
 * documentation, are copyright (C) 1996-2007 Julian R Seward.  All
 * rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 *
 * 2. The origin of this software must not be misrepresented; you must
 *    not claim that you wrote the original software.  If you use this
 *    software in a product, an acknowledgment in the product
 *    documentation would be appreciated but is not required.
 *
 * 3. Altered source versions must be plainly marked as such, and must
 *    not be misrepresented as being the original software.
 *
 * 4. The name of the author may not be used to endorse or promote
 *    products derived from this software without specific prior written
 *    permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
 * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
 * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
 * GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * Julian Seward, jseward@bzip.org
 * bzip2/libbzip2 version 1.0.5 of 10 December 2007
 *
 * Pascal wrapper created by Edison Mera, version 1.04
 * http://edisonlife.homelinux.com/
 *
 * Dynamic and runtime linking and Win64/OS X/Linux support by Craig Peterson
 * http://tpabbrevia.sourceforge.net/
 * ***** END LICENSE BLOCK ***** *)

unit AbBzip2;

{$I AbDefine.inc}

interface

uses
  SysUtils, Classes;

type
  TAlloc = function(opaque: Pointer; Items, Size: Integer): Pointer; cdecl;
  TFree = procedure(opaque, Block: Pointer); cdecl;

  // Internal structure.  Ignore.
  TBZStreamRec = record
    next_in: PByte; // next input byte
    avail_in: Integer; // number of bytes available at next_in
    total_in_lo32: Integer; // total nb of input bytes read so far
    total_in_hi32: Integer;

    next_out: PByte; // next output byte should be put here
    avail_out: Integer; // remaining free space at next_out
    total_out_lo32: Integer; // total nb of bytes output so far
    total_out_hi32: Integer;

    state: Pointer;

    bzalloc: TAlloc; // used to allocate the internal state
    bzfree: TFree; // used to free the internal state
    opaque: Pointer;
  end;

  // Abstract ancestor class
  TCustomBZip2Stream = class(TStream)
  private
    FStrm: TStream;
    FStrmPos: Int64;
    FOnProgress: TNotifyEvent;
    FBZRec: TBZStreamRec;
    FBuffer: array[Word] of Byte;
  protected
    procedure Progress(Sender: TObject); dynamic;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    constructor Create(Strm: TStream);
  end;

{ TBZCompressionStream compresses data on the fly as data is written to it, and
  stores the compressed data to another stream.

  TBZCompressionStream is write-only and strictly sequential. Reading from the
  stream will raise an exception. Using Seek to move the stream pointer
  will raise an exception.

  Output data is cached internally, written to the output stream only when
  the internal output buffer is full.  All pending output data is flushed
  when the stream is destroyed.

  The Position property returns the number of uncompressed bytes of
  data that have been written to the stream so far.

  CompressionRate returns the on-the-fly percentage by which the original
  data has been compressed:  (1 - (CompressedBytes / UncompressedBytes)) * 100
  If raw data size = 100 and compressed data size = 25, the CompressionRate
  is 75%

  The OnProgress event is called each time the output buffer is filled and
  written to the output stream.  This is useful for updating a progress
  indicator when you are writing a large chunk of data to the compression
  stream in a single call.}


  TBlockSize100k = (bs1, bs2, bs3, bs4, bs5, bs6, bs7, bs8, bs9);

  TBZCompressionStream = class(TCustomBZip2Stream)
  private
    function GetCompressionRate: Single;
  public
    constructor Create(BlockSize100k: TBlockSize100k; Dest: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    property CompressionRate: Single read GetCompressionRate;
    property OnProgress;
  end;

{ TDecompressionStream decompresses data on the fly as data is read from it.

  Compressed data comes from a separate source stream.  TDecompressionStream
  is read-only and unidirectional; you can seek forward in the stream, but not
  backwards.  The special case of setting the stream position to zero is
  allowed.  Seeking forward decompresses data until the requested position in
  the uncompressed data has been reached.  Seeking backwards, seeking relative
  to the end of the stream, requesting the size of the stream, and writing to
  the stream will raise an exception.

  The Position property returns the number of bytes of uncompressed data that
  have been read from the stream so far.

  The OnProgress event is called each time the internal input buffer of
  compressed data is exhausted and the next block is read from the input stream.
  This is useful for updating a progress indicator when you are reading a
  large chunk of data from the decompression stream in a single call.}

  TBZDecompressionStream = class(TCustomBZip2Stream)
  public
    constructor Create(Source: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    property OnProgress;
  end;

{ CompressBuf compresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer;
  out OutBuf: Pointer; out OutBytes: Integer);


{ DecompressBuf decompresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
       OutEstimate = zero, or est. size of the decompressed data
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;
  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);


type
  EBZip2Error = class(Exception);
  EBZCompressionError = class(EBZip2Error);
  EBZDecompressionError = class(EBZip2Error);

implementation

// Compile for Win64 using MSVC
//   <Path To MSVC>\bin\x86_amd64\cl.exe -c -nologo -GS- -Z7 -wd4086 -Gs32768
//      -DBZ_NO_STDIO blocksort.c huffman.c compress.c decompress.c bzlib.c

uses
{$IFDEF Bzip2Runtime}
{$IF DEFINED(FPC)}
  dynlibs,
{$ELSEIF DEFINED(MSWINDOWS)}
  Windows,
{$IFEND}
{$ENDIF}
  AbUtils;

{$IFDEF Bzip2Static}
{$IF DEFINED(WIN32)}
  {$L Win32\blocksort.obj}
  {$L Win32\huffman.obj}
  {$L Win32\compress.obj}
  {$L Win32\decompress.obj}
  {$L Win32\bzlib.obj}
{$ELSEIF DEFINED(WIN64)}
  {$L Win64\blocksort.obj}
  {$L Win64\huffman.obj}
  {$L Win64\compress.obj}
  {$L Win64\decompress.obj}
  {$L Win64\bzlib.obj}
{$IFEND}

procedure BZ2_hbMakeCodeLengths; external;
procedure BZ2_blockSort; external;
procedure BZ2_hbCreateDecodeTables; external;
procedure BZ2_hbAssignCodes; external;
procedure BZ2_compressBlock; external;
procedure BZ2_decompress; external;
{$ENDIF}

type
  TLargeInteger = record
    case Integer of
    0: (
      LowPart: LongWord;
      HighPart: LongWord);
    1: (
      QuadPart: Int64);
  end;

const
  BZ_RUN = 0;
  BZ_FLUSH = 1;
  BZ_FINISH = 2;
  BZ_OK = 0;
  BZ_RUN_OK = 1;
  BZ_FLUSH_OK = 2;
  BZ_FINISH_OK = 3;
  BZ_STREAM_END = 4;
  BZ_SEQUENCE_ERROR = (-1);
  BZ_PARAM_ERROR = (-2);
  BZ_MEM_ERROR = (-3);
  BZ_DATA_ERROR = (-4);
  BZ_DATA_ERROR_MAGIC = (-5);
  BZ_IO_ERROR = (-6);
  BZ_UNEXPECTED_EOF = (-7);
  BZ_OUTBUFF_FULL = (-8);

  BZ_BLOCK_SIZE_100K = 9;

{$IFDEF Bzip2Static}
  BZ2_rNums: array[0..511] of Longint = (
    619, 720, 127, 481, 931, 816, 813, 233, 566, 247,
    985, 724, 205, 454, 863, 491, 741, 242, 949, 214,
    733, 859, 335, 708, 621, 574, 73, 654, 730, 472,
    419, 436, 278, 496, 867, 210, 399, 680, 480, 51,
    878, 465, 811, 169, 869, 675, 611, 697, 867, 561,
    862, 687, 507, 283, 482, 129, 807, 591, 733, 623,
    150, 238, 59, 379, 684, 877, 625, 169, 643, 105,
    170, 607, 520, 932, 727, 476, 693, 425, 174, 647,
    73, 122, 335, 530, 442, 853, 695, 249, 445, 515,
    909, 545, 703, 919, 874, 474, 882, 500, 594, 612,
    641, 801, 220, 162, 819, 984, 589, 513, 495, 799,
    161, 604, 958, 533, 221, 400, 386, 867, 600, 782,
    382, 596, 414, 171, 516, 375, 682, 485, 911, 276,
    98, 553, 163, 354, 666, 933, 424, 341, 533, 870,
    227, 730, 475, 186, 263, 647, 537, 686, 600, 224,
    469, 68, 770, 919, 190, 373, 294, 822, 808, 206,
    184, 943, 795, 384, 383, 461, 404, 758, 839, 887,
    715, 67, 618, 276, 204, 918, 873, 777, 604, 560,
    951, 160, 578, 722, 79, 804, 96, 409, 713, 940,
    652, 934, 970, 447, 318, 353, 859, 672, 112, 785,
    645, 863, 803, 350, 139, 93, 354, 99, 820, 908,
    609, 772, 154, 274, 580, 184, 79, 626, 630, 742,
    653, 282, 762, 623, 680, 81, 927, 626, 789, 125,
    411, 521, 938, 300, 821, 78, 343, 175, 128, 250,
    170, 774, 972, 275, 999, 639, 495, 78, 352, 126,
    857, 956, 358, 619, 580, 124, 737, 594, 701, 612,
    669, 112, 134, 694, 363, 992, 809, 743, 168, 974,
    944, 375, 748, 52, 600, 747, 642, 182, 862, 81,
    344, 805, 988, 739, 511, 655, 814, 334, 249, 515,
    897, 955, 664, 981, 649, 113, 974, 459, 893, 228,
    433, 837, 553, 268, 926, 240, 102, 654, 459, 51,
    686, 754, 806, 760, 493, 403, 415, 394, 687, 700,
    946, 670, 656, 610, 738, 392, 760, 799, 887, 653,
    978, 321, 576, 617, 626, 502, 894, 679, 243, 440,
    680, 879, 194, 572, 640, 724, 926, 56, 204, 700,
    707, 151, 457, 449, 797, 195, 791, 558, 945, 679,
    297, 59, 87, 824, 713, 663, 412, 693, 342, 606,
    134, 108, 571, 364, 631, 212, 174, 643, 304, 329,
    343, 97, 430, 751, 497, 314, 983, 374, 822, 928,
    140, 206, 73, 263, 980, 736, 876, 478, 430, 305,
    170, 514, 364, 692, 829, 82, 855, 953, 676, 246,
    369, 970, 294, 750, 807, 827, 150, 790, 288, 923,
    804, 378, 215, 828, 592, 281, 565, 555, 710, 82,
    896, 831, 547, 261, 524, 462, 293, 465, 502, 56,
    661, 821, 976, 991, 658, 869, 905, 758, 745, 193,
    768, 550, 608, 933, 378, 286, 215, 979, 792, 961,
    61, 688, 793, 644, 986, 403, 106, 366, 905, 644,
    372, 567, 466, 434, 645, 210, 389, 550, 919, 135,
    780, 773, 635, 389, 707, 100, 626, 958, 165, 504,
    920, 176, 193, 713, 857, 265, 203, 50, 668, 108,
    645, 990, 626, 197, 510, 357, 358, 850, 858, 364,
    936, 638
    );

  BZ2_crc32Table: array[0..255] of Longint = (
    $00000000, $04C11DB7, $09823B6E, $0D4326D9,
    $130476DC, $17C56B6B, $1A864DB2, $1E475005,
    $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61,
    $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD,
    $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9,
    $5F15ADAC, $5BD4B01B, $569796C2, $52568B75,
    $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011,
    $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD,
    -$67DC4920, -$631D54A9, -$6E5E7272, -$6A9F6FC7,
    -$74D83FC4, -$70192275, -$7D5A04AE, -$799B191B,
    -$41D4A4A8, -$4515B911, -$48569FCA, -$4C97827F,
    -$52D0D27C, -$5611CFCD, -$5B52E916, -$5F93F4A3,
    -$2BCD9270, -$2F0C8FD9, -$224FA902, -$268EB4B7,
    -$38C9E4B4, -$3C08F905, -$314BDFDE, -$358AC26B,
    -$0DC57FD8, -$09046261, -$044744BA, -$0086590F,
    -$1EC1090C, -$1A0014BD, -$17433266, -$13822FD3,
    $34867077, $30476DC0, $3D044B19, $39C556AE,
    $278206AB, $23431B1C, $2E003DC5, $2AC12072,
    $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16,
    $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA,
    $7897AB07, $7C56B6B0, $71159069, $75D48DDE,
    $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02,
    $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066,
    $4D9B3063, $495A2DD4, $44190B0D, $40D816BA,
    -$535A3969, -$579B24E0, -$5AD80207, -$5E191FB2,
    -$405E4FB5, -$449F5204, -$49DC74DB, -$4D1D696E,
    -$7552D4D1, -$7193C968, -$7CD0EFBF, -$7811F20A,
    -$6656A20D, -$6297BFBC, -$6FD49963, -$6B1584D6,
    -$1F4BE219, -$1B8AFFB0, -$16C9D977, -$1208C4C2,
    -$0C4F94C5, -$088E8974, -$05CDAFAB, -$010CB21E,
    -$39430FA1, -$3D821218, -$30C134CF, -$3400297A,
    -$2A47797D, -$2E8664CC, -$23C54213, -$27045FA6,
    $690CE0EE, $6DCDFD59, $608EDB80, $644FC637,
    $7A089632, $7EC98B85, $738AAD5C, $774BB0EB,
    $4F040D56, $4BC510E1, $46863638, $42472B8F,
    $5C007B8A, $58C1663D, $558240E4, $51435D53,
    $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47,
    $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B,
    $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF,
    $1011A0FA, $14D0BD4D, $19939B94, $1D528623,
    -$0ED0A9F2, -$0A11B447, -$075292A0, -$03938F29,
    -$1DD4DF2E, -$1915C29B, -$1456E444, -$1097F9F5,
    -$28D8444A, -$2C1959FF, -$215A7F28, -$259B6291,
    -$3BDC3296, -$3F1D2F23, -$325E09FC, -$369F144D,
    -$42C17282, -$46006F37, -$4B4349F0, -$4F825459,
    -$51C5045E, -$550419EB, -$58473F34, -$5C862285,
    -$64C99F3A, -$6008828F, -$6D4BA458, -$698AB9E1,
    -$77CDE9E6, -$730CF453, -$7E4FD28C, -$7A8ECF3D,
    $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640,
    $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C,
    $7B827D21, $7F436096, $7200464F, $76C15BF8,
    $68860BFD, $6C47164A, $61043093, $65C52D24,
    $119B4BE9, $155A565E, $18197087, $1CD86D30,
    $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC,
    $3793A651, $3352BBE6, $3E119D3F, $3AD08088,
    $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654,
    -$3A56D987, -$3E97C432, -$33D4E2E9, -$3715FF60,
    -$2952AF5B, -$2D93B2EE, -$20D09435, -$24118984,
    -$1C5E343F, -$189F298A, -$15DC0F51, -$111D12E8,
    -$0F5A42E3, -$0B9B5F56, -$06D8798D, -$0219643C,
    -$764702F7, -$72861F42, -$7FC53999, -$7B042430,
    -$6543742B, -$6182699E, -$6CC14F45, -$680052F4,
    -$504FEF4F, -$548EF2FA, -$59CDD421, -$5D0CC998,
    -$434B9993, -$478A8426, -$4AC9A2FD, -$4E08BF4C
    );

procedure bz_internal_error(errcode: Integer); cdecl;
begin
  raise EBZip2Error.CreateFmt('Compression Error %d', [errcode]);
end; { _bz_internal_error }

function malloc(size: Integer): Pointer; cdecl;
begin
  GetMem(Result, Size);
end; { _malloc }

procedure free(block: Pointer); cdecl;
begin
  FreeMem(block);
end; { _free }
{$ENDIF}

const
  libbz2 = {$IF DEFINED(MSWINDOWS)}'libbz2.dll'
           {$ELSEIF DEFINED(DARWIN)}'libbz2.dylib'
           {$ELSE}'libbz2.so.1'{$IFEND};

{$IFDEF Bzip2Runtime}
var
  hBzip2: HMODULE;
  // deflate compresses data
  BZ2_bzCompressInit: function(var strm: TBZStreamRec; blockSize100k: Integer;
    verbosity: Integer; workFactor: Integer): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  BZ2_bzCompress: function(var strm: TBZStreamRec; action: Integer): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  BZ2_bzCompressEnd: function (var strm: TBZStreamRec): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  BZ2_bzBuffToBuffCompress: function(dest: Pointer; var destLen: Integer;
    source: Pointer; sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  // inflate decompresses data
  BZ2_bzDecompressInit: function(var strm: TBZStreamRec; verbosity: Integer;
    small: Integer): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  BZ2_bzDecompress: function(var strm: TBZStreamRec): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  BZ2_bzDecompressEnd: function(var strm: TBZStreamRec): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  BZ2_bzBuffToBuffDecompress: function(dest: Pointer; var destLen: Integer;
    source: Pointer; sourceLen, small, verbosity: Integer): Integer;
    {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
{$ELSE}
// deflate compresses data
function BZ2_bzCompressInit(var strm: TBZStreamRec; blockSize100k: Integer;
  verbosity: Integer; workFactor: Integer): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzCompressInit'{$ENDIF};

function BZ2_bzCompress(var strm: TBZStreamRec; action: Integer): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzCompress'{$ENDIF};

function BZ2_bzCompressEnd(var strm: TBZStreamRec): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzCompressEnd'{$ENDIF};

function BZ2_bzBuffToBuffCompress(dest: Pointer; var destLen: Integer; source: Pointer;
  sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzBuffToBuffCompress'{$ENDIF};

// inflate decompresses data
function BZ2_bzDecompressInit(var strm: TBZStreamRec; verbosity: Integer;
  small: Integer): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzDecompressInit'{$ENDIF};

function BZ2_bzDecompress(var strm: TBZStreamRec): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzDecompress'{$ENDIF};

function BZ2_bzDecompressEnd(var strm: TBZStreamRec): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzDecompressEnd'{$ENDIF};

function BZ2_bzBuffToBuffDecompress(dest: Pointer; var destLen: Integer; source: Pointer;
  sourceLen, small, verbosity: Integer): Integer;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}
  {$IFDEF DARWIN}name '_BZ2_bzBuffToBuffDecompress'{$ENDIF};
{$ENDIF}

procedure LoadBzip2DLL;
begin
  {$IFDEF Bzip2Runtime}
  if hBzip2 <> 0 then
    Exit;
  hBzip2 := LoadLibrary(libbz2);
  if hBzip2 = 0 then
    raise EBZip2Error.Create('Bzip2 shared library not found');
  @BZ2_bzCompressInit := GetProcAddress(hBzip2, 'BZ2_bzCompressInit');
  @BZ2_bzCompress := GetProcAddress(hBzip2, 'BZ2_bzCompress');
  @BZ2_bzCompressEnd := GetProcAddress(hBzip2, 'BZ2_bzCompressEnd');
  @BZ2_bzBuffToBuffCompress := GetProcAddress(hBzip2, 'BZ2_bzBuffToBuffCompress');
  @BZ2_bzDecompressInit := GetProcAddress(hBzip2, 'BZ2_bzDecompressInit');
  @BZ2_bzDecompress := GetProcAddress(hBzip2, 'BZ2_bzDecompress');
  @BZ2_bzDecompressEnd := GetProcAddress(hBzip2, 'BZ2_bzDecompressEnd');
  @BZ2_bzBuffToBuffDecompress := GetProcAddress(hBzip2, 'BZ2_bzBuffToBuffDecompress');
  {$ENDIF}
end;

function bzip2AllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
begin
  GetMem(Result, Items * Size);
end; { bzip2AllocMem }

procedure bzip2FreeMem(AppData, Block: Pointer); cdecl;
begin
  FreeMem(Block);
end; { bzip2FreeMem }

function CCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EBZCompressionError.CreateFmt('error %d', [code]); //!!
end; { CCheck }

function DCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EBZDecompressionError.CreateFmt('error %d', [code]); //!!
end; { DCheck }

procedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer;
  out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TBZStreamRec;
  P: Pointer;
begin
  LoadBzip2DLL;
  FillChar(strm, sizeof(strm), 0);
  strm.bzalloc := bzip2AllocMem;
  strm.bzfree := bzip2FreeMem;
  OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    CCheck(BZ2_bzCompressInit(strm, 9, 0, 0));
    try
      while CCheck(BZ2_bzCompress(strm, BZ_FINISH)) <> BZ_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, 256);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PByte(PtrInt(OutBuf)
             + (PtrInt(strm.next_out) - PtrInt(P)));
        strm.avail_out := 256;
      end;
    finally
      CCheck(BZ2_bzCompressEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out_lo32);
    OutBytes := strm.total_out_lo32;
  except
    FreeMem(OutBuf);
    raise
  end;
end;

procedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;
  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TBZStreamRec;
  P: Pointer;
  BufInc: Integer;
begin
  LoadBzip2DLL;
  FillChar(strm, sizeof(strm), 0);
  strm.bzalloc := bzip2AllocMem;
  strm.bzfree := bzip2FreeMem;
  BufInc := (InBytes + 255) and not 255;
  if OutEstimate = 0 then
    OutBytes := BufInc
  else
    OutBytes := OutEstimate;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    DCheck(BZ2_bzDecompressInit(strm, 0, 0));
    try
      while DCheck(BZ2_bzDecompress(strm)) <> BZ_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, BufInc);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PByte(PtrInt(OutBuf) + (PtrInt(strm.next_out) - PtrInt(P)));
        strm.avail_out := BufInc;
      end;
    finally
      DCheck(BZ2_bzDecompressEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out_lo32);
    OutBytes := strm.total_out_lo32;
  except
    FreeMem(OutBuf);
    raise
  end;
end;

// TCustomBZip2Stream

constructor TCustomBZip2Stream.Create(Strm: TStream);
begin
  inherited Create;
  FStrm := Strm;
  FStrmPos := Strm.Position;
  FBZRec.bzalloc := bzip2AllocMem;
  FBZRec.bzfree := bzip2FreeMem;
end;

procedure TCustomBZip2Stream.Progress(Sender: TObject);
begin
  if Assigned(FOnProgress) then FOnProgress(Sender);
end; { TCustomBZip2Stream }


// TBZCompressionStream

constructor TBZCompressionStream.Create(BlockSize100k: TBlockSize100k; Dest: TStream);
const
  BlockSizes: array[TBlockSize100k] of ShortInt = (1, 2, 3, 4, 5, 6, 7, 8, 9);
begin
  inherited Create(Dest);
  LoadBzip2DLL;
  FBZRec.next_out := @FBuffer[0];
  FBZRec.avail_out := sizeof(FBuffer);
  CCheck(BZ2_bzCompressInit(FBZRec, BlockSizes[BlockSize100k], 0, 0));
end;

destructor TBZCompressionStream.Destroy;
begin
  if FBZRec.state <> nil then begin
    FBZRec.next_in := nil;
    FBZRec.avail_in := 0;
    try
      if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
      while (CCheck(BZ2_bzCompress(FBZRec, BZ_FINISH)) <> BZ_STREAM_END)
        and (FBZRec.avail_out = 0) do
      begin
        FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
        FBZRec.next_out := @FBuffer[0];
        FBZRec.avail_out := sizeof(FBuffer);
      end;
      if FBZRec.avail_out < sizeof(FBuffer) then
        FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FBZRec.avail_out);
    finally
      BZ2_bzCompressEnd(FBZRec);
    end;
  end;
  inherited Destroy;
end;

function TBZCompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  raise EBZCompressionError.Create('Invalid stream operation');
end; { TBZCompressionStream }

function TBZCompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  FBZRec.next_in := @Buffer;
  FBZRec.avail_in := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FBZRec.avail_in > 0) do
  begin
    CCheck(BZ2_bzCompress(FBZRec, BZ_RUN));
    if FBZRec.avail_out = 0 then
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FBZRec.next_out := @FBuffer[0];
      FBZRec.avail_out := sizeof(FBuffer);
      FStrmPos := FStrm.Position;
    end;
    Progress(Self);
  end;
  Result := Count;
end; { TBZCompressionStream }

function TBZCompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var
  conv64 : TLargeInteger;
begin
  if (Offset = 0) and (Origin = soCurrent) then begin
    conv64.LowPart  := FBZRec.total_in_lo32;
    conv64.HighPart := FBZRec.total_in_hi32;
    Result := conv64.QuadPart
    end
  else
    raise EBZCompressionError.Create('Invalid stream operation');
end; { TBZCompressionStream }

function TBZCompressionStream.GetCompressionRate: Single;
var
  conv64In : TLargeInteger;
  conv64Out: TLargeInteger;
begin
  conv64In.LowPart   := FBZRec.total_in_lo32;
  conv64In.HighPart  := FBZRec.total_in_hi32;
  conv64Out.LowPart  := FBZRec.total_out_lo32;
  conv64Out.HighPart := FBZRec.total_out_hi32;

  if conv64In.QuadPart = 0 then
    Result := 0
  else
    Result := (1.0 - (conv64Out.QuadPart / conv64In.QuadPart)) * 100.0;
end; { TBZCompressionStream }

// TDecompressionStream

constructor TBZDecompressionStream.Create(Source: TStream);
begin
  inherited Create(Source);
  LoadBzip2DLL;
  FBZRec.next_in := @FBuffer[0];
  FBZRec.avail_in := 0;
  DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));
end;

destructor TBZDecompressionStream.Destroy;
begin
  if FBZRec.state <> nil then
    BZ2_bzDecompressEnd(FBZRec);
  inherited Destroy;
end;

function TBZDecompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  FBZRec.next_out := @Buffer;
  FBZRec.avail_out := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FBZRec.avail_out > 0) do
  begin
    if FBZRec.avail_in = 0 then
    begin
      FBZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
      if FBZRec.avail_in = 0 then
      begin
        Result := Count - FBZRec.avail_out;
        Exit;
      end;
      FBZRec.next_in := @FBuffer[0];
      FStrmPos := FStrm.Position;
    end;
    CCheck(BZ2_bzDecompress(FBZRec));
    Progress(Self);
  end;
  Result := Count;
end; { TBZDecompressionStream }

function TBZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  raise EBZDecompressionError.Create('Invalid stream operation');
end; { TBZDecompressionStream }

function TBZDecompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var
  I     : Integer;
  Buf   : array[0..4095] of Char;
  conv64: TLargeInteger;
  NewOff: Int64;
begin
  conv64.LowPart  := FBZRec.total_out_lo32;
  conv64.HighPart := FBZRec.total_out_hi32;

  if (Offset = 0) and (Origin = soBeginning) then
  begin
    DCheck(BZ2_bzDecompressEnd(FBZRec));
    DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));
    FBZRec.next_in := @FBuffer[0];
    FBZRec.avail_in := 0;
    FStrm.Position := 0;
    FStrmPos := 0;
  end
  else if ((Offset >= 0) and (Origin = soCurrent)) or
    (((Offset - conv64.QuadPart) > 0) and (Origin = soBeginning)) then
  begin
    NewOff := Offset;
    if Origin = soBeginning then Dec(NewOff, conv64.QuadPart);
    if NewOff > 0 then
    begin
      for I := 1 to NewOff div sizeof(Buf) do
        ReadBuffer(Buf, sizeof(Buf));
      ReadBuffer(Buf, NewOff mod sizeof(Buf));
    end;
  end
  else
    raise EBZDecompressionError.Create('Invalid stream operation');
  Result := conv64.QuadPart;
end; { TBZDecompressionStream }

end.