Subversion Repositories decoder

Rev

Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. {*******************************************************}
  2. {                                                       }
  3. {     BZIP2 Data Compression Interface Unit             }
  4. {                                                       }
  5. {     Similar to ZLIB Data Compression Interface Unit   }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit BZip2;
  10.  
  11. interface
  12.  
  13. uses Sysutils, Classes;
  14.  
  15. type
  16.   TAlloc = function(opaque: Pointer; Items, Size: Integer): Pointer; cdecl;
  17.   TFree = procedure(opaque, Block: Pointer); cdecl;
  18.  
  19.   // Internal structure.  Ignore.
  20.   TBZStreamRec = packed record
  21.     next_in: PChar; // next input byte
  22.     avail_in: Integer; // number of bytes available at next_in
  23.     total_in_lo32: Integer; // total nb of input bytes read so far
  24.     total_in_hi32: Integer;
  25.  
  26.     next_out: PChar; // next output byte should be put here
  27.     avail_out: Integer; // remaining free space at next_out
  28.     total_out_lo32: Integer; // total nb of bytes output so far
  29.     total_out_hi32: Integer;
  30.  
  31.     state: Pointer;
  32.  
  33.     bzalloc: TAlloc; // used to allocate the internal state
  34.     bzfree: TFree; // used to free the internal state
  35.     opaque: Pointer;
  36.   end;
  37.  
  38.   // Abstract ancestor class
  39.   TCustomBZip2Stream = class(TStream)
  40.   private
  41.     FStrm: TStream;
  42.     FStrmPos: Integer;
  43.     FOnProgress: TNotifyEvent;
  44.     FBZRec: TBZStreamRec;
  45.     FBuffer: array[Word] of Char;
  46.   protected
  47.     procedure Progress(Sender: TObject); dynamic;
  48.     property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
  49.     constructor Create(Strm: TStream);
  50.   end;
  51.  
  52. { TBZCompressionStream compresses data on the fly as data is written to it, and
  53.   stores the compressed data to another stream.
  54.  
  55.   TBZCompressionStream is write-only and strictly sequential. Reading from the
  56.   stream will raise an exception. Using Seek to move the stream pointer
  57.   will raise an exception.
  58.  
  59.   Output data is cached internally, written to the output stream only when
  60.   the internal output buffer is full.  All pending output data is flushed
  61.   when the stream is destroyed.
  62.  
  63.   The Position property returns the number of uncompressed bytes of
  64.   data that have been written to the stream so far.
  65.  
  66.   CompressionRate returns the on-the-fly percentage by which the original
  67.   data has been compressed:  (1 - (CompressedBytes / UncompressedBytes)) * 100
  68.   If raw data size = 100 and compressed data size = 25, the CompressionRate
  69.   is 75%
  70.  
  71.   The OnProgress event is called each time the output buffer is filled and
  72.   written to the output stream.  This is useful for updating a progress
  73.   indicator when you are writing a large chunk of data to the compression
  74.   stream in a single call.}
  75.  
  76.  
  77.   TBlockSize100k = (bs1, bs2, bs3, bs4, bs5, bs6, bs7, bs8, bs9);
  78.  
  79.   TBZCompressionStream = class(TCustomBZip2Stream)
  80.   private
  81.     function GetCompressionRate: Single;
  82.   public
  83.     constructor Create(BlockSize100k: TBlockSize100k; Dest: TStream);
  84.     destructor Destroy; override;
  85.     function Read(var Buffer; Count: Longint): Longint; override;
  86.     function Write(const Buffer; Count: Longint): Longint; override;
  87.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  88.     property CompressionRate: Single read GetCompressionRate;
  89.     property OnProgress;
  90.   end;
  91.  
  92. { TDecompressionStream decompresses data on the fly as data is read from it.
  93.  
  94.   Compressed data comes from a separate source stream.  TDecompressionStream
  95.   is read-only and unidirectional; you can seek forward in the stream, but not
  96.   backwards.  The special case of setting the stream position to zero is
  97.   allowed.  Seeking forward decompresses data until the requested position in
  98.   the uncompressed data has been reached.  Seeking backwards, seeking relative
  99.   to the end of the stream, requesting the size of the stream, and writing to
  100.   the stream will raise an exception.
  101.  
  102.   The Position property returns the number of bytes of uncompressed data that
  103.   have been read from the stream so far.
  104.  
  105.   The OnProgress event is called each time the internal input buffer of
  106.   compressed data is exhausted and the next block is read from the input stream.
  107.   This is useful for updating a progress indicator when you are reading a
  108.   large chunk of data from the decompression stream in a single call.}
  109.  
  110.   TBZDecompressionStream = class(TCustomBZip2Stream)
  111.   public
  112.     constructor Create(Source: TStream);
  113.     destructor Destroy; override;
  114.     function Read(var Buffer; Count: Longint): Longint; override;
  115.     function Write(const Buffer; Count: Longint): Longint; override;
  116.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  117.     property OnProgress;
  118.   end;
  119.  
  120. { CompressBuf compresses data, buffer to buffer, in one call.
  121.    In: InBuf = ptr to compressed data
  122.        InBytes = number of bytes in InBuf
  123.   Out: OutBuf = ptr to newly allocated buffer containing decompressed data
  124.        OutBytes = number of bytes in OutBuf   }
  125. procedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer;
  126.   out OutBuf: Pointer; out OutBytes: Integer);
  127.  
  128.  
  129. { DecompressBuf decompresses data, buffer to buffer, in one call.
  130.    In: InBuf = ptr to compressed data
  131.        InBytes = number of bytes in InBuf
  132.        OutEstimate = zero, or est. size of the decompressed data
  133.   Out: OutBuf = ptr to newly allocated buffer containing decompressed data
  134.        OutBytes = number of bytes in OutBuf   }
  135. procedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;
  136.   OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
  137.  
  138. type
  139.   EBZip2Error = class(Exception);
  140.   EBZCompressionError = class(EBZip2Error);
  141.   EBZDecompressionError = class(EBZip2Error);
  142.  
  143. implementation
  144.  
  145. {$L blocks~1.obj} //blocksort
  146. {$L huffman.obj}
  147. {$L compress.obj}
  148. {$L decomp~1.obj} //decompress
  149. {$L bzlib.obj}
  150. { $L crctable.obj}
  151. { $L randtable.obj}
  152.  
  153. procedure _BZ2_hbMakeCodeLengths; external;
  154. procedure _BZ2_blockSort; external;
  155. procedure _BZ2_hbCreateDecodeTables; external;
  156. procedure _BZ2_hbAssignCodes; external;
  157. procedure _BZ2_compressBlock; external;
  158. procedure _BZ2_decompress; external;
  159.  
  160. const
  161.   BZ_RUN = 0;
  162.   BZ_FLUSH = 1;
  163.   BZ_FINISH = 2;
  164.   BZ_OK = 0;
  165.   BZ_RUN_OK = 1;
  166.   BZ_FLUSH_OK = 2;
  167.   BZ_FINISH_OK = 3;
  168.   BZ_STREAM_END = 4;
  169.   BZ_SEQUENCE_ERROR = (-1);
  170.   BZ_PARAM_ERROR = (-2);
  171.   BZ_MEM_ERROR = (-3);
  172.   BZ_DATA_ERROR = (-4);
  173.   BZ_DATA_ERROR_MAGIC = (-5);
  174.   BZ_IO_ERROR = (-6);
  175.   BZ_UNEXPECTED_EOF = (-7);
  176.   BZ_OUTBUFF_FULL = (-8);
  177.  
  178.   BZ_BLOCK_SIZE_100K = 9;
  179.  
  180.   _BZ2_rNums: array[0..511] of Longint = (
  181.     619, 720, 127, 481, 931, 816, 813, 233, 566, 247,
  182.     985, 724, 205, 454, 863, 491, 741, 242, 949, 214,
  183.     733, 859, 335, 708, 621, 574, 73, 654, 730, 472,
  184.     419, 436, 278, 496, 867, 210, 399, 680, 480, 51,
  185.     878, 465, 811, 169, 869, 675, 611, 697, 867, 561,
  186.     862, 687, 507, 283, 482, 129, 807, 591, 733, 623,
  187.     150, 238, 59, 379, 684, 877, 625, 169, 643, 105,
  188.     170, 607, 520, 932, 727, 476, 693, 425, 174, 647,
  189.     73, 122, 335, 530, 442, 853, 695, 249, 445, 515,
  190.     909, 545, 703, 919, 874, 474, 882, 500, 594, 612,
  191.     641, 801, 220, 162, 819, 984, 589, 513, 495, 799,
  192.     161, 604, 958, 533, 221, 400, 386, 867, 600, 782,
  193.     382, 596, 414, 171, 516, 375, 682, 485, 911, 276,
  194.     98, 553, 163, 354, 666, 933, 424, 341, 533, 870,
  195.     227, 730, 475, 186, 263, 647, 537, 686, 600, 224,
  196.     469, 68, 770, 919, 190, 373, 294, 822, 808, 206,
  197.     184, 943, 795, 384, 383, 461, 404, 758, 839, 887,
  198.     715, 67, 618, 276, 204, 918, 873, 777, 604, 560,
  199.     951, 160, 578, 722, 79, 804, 96, 409, 713, 940,
  200.     652, 934, 970, 447, 318, 353, 859, 672, 112, 785,
  201.     645, 863, 803, 350, 139, 93, 354, 99, 820, 908,
  202.     609, 772, 154, 274, 580, 184, 79, 626, 630, 742,
  203.     653, 282, 762, 623, 680, 81, 927, 626, 789, 125,
  204.     411, 521, 938, 300, 821, 78, 343, 175, 128, 250,
  205.     170, 774, 972, 275, 999, 639, 495, 78, 352, 126,
  206.     857, 956, 358, 619, 580, 124, 737, 594, 701, 612,
  207.     669, 112, 134, 694, 363, 992, 809, 743, 168, 974,
  208.     944, 375, 748, 52, 600, 747, 642, 182, 862, 81,
  209.     344, 805, 988, 739, 511, 655, 814, 334, 249, 515,
  210.     897, 955, 664, 981, 649, 113, 974, 459, 893, 228,
  211.     433, 837, 553, 268, 926, 240, 102, 654, 459, 51,
  212.     686, 754, 806, 760, 493, 403, 415, 394, 687, 700,
  213.     946, 670, 656, 610, 738, 392, 760, 799, 887, 653,
  214.     978, 321, 576, 617, 626, 502, 894, 679, 243, 440,
  215.     680, 879, 194, 572, 640, 724, 926, 56, 204, 700,
  216.     707, 151, 457, 449, 797, 195, 791, 558, 945, 679,
  217.     297, 59, 87, 824, 713, 663, 412, 693, 342, 606,
  218.     134, 108, 571, 364, 631, 212, 174, 643, 304, 329,
  219.     343, 97, 430, 751, 497, 314, 983, 374, 822, 928,
  220.     140, 206, 73, 263, 980, 736, 876, 478, 430, 305,
  221.     170, 514, 364, 692, 829, 82, 855, 953, 676, 246,
  222.     369, 970, 294, 750, 807, 827, 150, 790, 288, 923,
  223.     804, 378, 215, 828, 592, 281, 565, 555, 710, 82,
  224.     896, 831, 547, 261, 524, 462, 293, 465, 502, 56,
  225.     661, 821, 976, 991, 658, 869, 905, 758, 745, 193,
  226.     768, 550, 608, 933, 378, 286, 215, 979, 792, 961,
  227.     61, 688, 793, 644, 986, 403, 106, 366, 905, 644,
  228.     372, 567, 466, 434, 645, 210, 389, 550, 919, 135,
  229.     780, 773, 635, 389, 707, 100, 626, 958, 165, 504,
  230.     920, 176, 193, 713, 857, 265, 203, 50, 668, 108,
  231.     645, 990, 626, 197, 510, 357, 358, 850, 858, 364,
  232.     936, 638
  233.     );
  234.  
  235.   _BZ2_crc32Table: array[0..255] of Longint = (
  236.     $00000000, $04C11DB7, $09823B6E, $0D4326D9,
  237.     $130476DC, $17C56B6B, $1A864DB2, $1E475005,
  238.     $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61,
  239.     $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD,
  240.     $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9,
  241.     $5F15ADAC, $5BD4B01B, $569796C2, $52568B75,
  242.     $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011,
  243.     $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD,
  244.     -$67DC4920, -$631D54A9, -$6E5E7272, -$6A9F6FC7,
  245.     -$74D83FC4, -$70192275, -$7D5A04AE, -$799B191B,
  246.     -$41D4A4A8, -$4515B911, -$48569FCA, -$4C97827F,
  247.     -$52D0D27C, -$5611CFCD, -$5B52E916, -$5F93F4A3,
  248.     -$2BCD9270, -$2F0C8FD9, -$224FA902, -$268EB4B7,
  249.     -$38C9E4B4, -$3C08F905, -$314BDFDE, -$358AC26B,
  250.     -$0DC57FD8, -$09046261, -$044744BA, -$0086590F,
  251.     -$1EC1090C, -$1A0014BD, -$17433266, -$13822FD3,
  252.     $34867077, $30476DC0, $3D044B19, $39C556AE,
  253.     $278206AB, $23431B1C, $2E003DC5, $2AC12072,
  254.     $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16,
  255.     $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA,
  256.     $7897AB07, $7C56B6B0, $71159069, $75D48DDE,
  257.     $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02,
  258.     $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066,
  259.     $4D9B3063, $495A2DD4, $44190B0D, $40D816BA,
  260.     -$535A3969, -$579B24E0, -$5AD80207, -$5E191FB2,
  261.     -$405E4FB5, -$449F5204, -$49DC74DB, -$4D1D696E,
  262.     -$7552D4D1, -$7193C968, -$7CD0EFBF, -$7811F20A,
  263.     -$6656A20D, -$6297BFBC, -$6FD49963, -$6B1584D6,
  264.     -$1F4BE219, -$1B8AFFB0, -$16C9D977, -$1208C4C2,
  265.     -$0C4F94C5, -$088E8974, -$05CDAFAB, -$010CB21E,
  266.     -$39430FA1, -$3D821218, -$30C134CF, -$3400297A,
  267.     -$2A47797D, -$2E8664CC, -$23C54213, -$27045FA6,
  268.     $690CE0EE, $6DCDFD59, $608EDB80, $644FC637,
  269.     $7A089632, $7EC98B85, $738AAD5C, $774BB0EB,
  270.     $4F040D56, $4BC510E1, $46863638, $42472B8F,
  271.     $5C007B8A, $58C1663D, $558240E4, $51435D53,
  272.     $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47,
  273.     $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B,
  274.     $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF,
  275.     $1011A0FA, $14D0BD4D, $19939B94, $1D528623,
  276.     -$0ED0A9F2, -$0A11B447, -$075292A0, -$03938F29,
  277.     -$1DD4DF2E, -$1915C29B, -$1456E444, -$1097F9F5,
  278.     -$28D8444A, -$2C1959FF, -$215A7F28, -$259B6291,
  279.     -$3BDC3296, -$3F1D2F23, -$325E09FC, -$369F144D,
  280.     -$42C17282, -$46006F37, -$4B4349F0, -$4F825459,
  281.     -$51C5045E, -$550419EB, -$58473F34, -$5C862285,
  282.     -$64C99F3A, -$6008828F, -$6D4BA458, -$698AB9E1,
  283.     -$77CDE9E6, -$730CF453, -$7E4FD28C, -$7A8ECF3D,
  284.     $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640,
  285.     $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C,
  286.     $7B827D21, $7F436096, $7200464F, $76C15BF8,
  287.     $68860BFD, $6C47164A, $61043093, $65C52D24,
  288.     $119B4BE9, $155A565E, $18197087, $1CD86D30,
  289.     $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC,
  290.     $3793A651, $3352BBE6, $3E119D3F, $3AD08088,
  291.     $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654,
  292.     -$3A56D987, -$3E97C432, -$33D4E2E9, -$3715FF60,
  293.     -$2952AF5B, -$2D93B2EE, -$20D09435, -$24118984,
  294.     -$1C5E343F, -$189F298A, -$15DC0F51, -$111D12E8,
  295.     -$0F5A42E3, -$0B9B5F56, -$06D8798D, -$0219643C,
  296.     -$764702F7, -$72861F42, -$7FC53999, -$7B042430,
  297.     -$6543742B, -$6182699E, -$6CC14F45, -$680052F4,
  298.     -$504FEF4F, -$548EF2FA, -$59CDD421, -$5D0CC998,
  299.     -$434B9993, -$478A8426, -$4AC9A2FD, -$4E08BF4C
  300.     );
  301.  
  302. procedure _bz_internal_error(errcode: Integer); cdecl;
  303. begin
  304.   raise EBZip2Error.CreateFmt('Compression Error %d', [errcode]);
  305. end;
  306.  
  307. function _malloc(size: Integer): Pointer; cdecl;
  308. begin
  309.   GetMem(Result, Size);
  310. end;
  311.  
  312. procedure _free(block: Pointer); cdecl;
  313. begin
  314.   FreeMem(block);
  315. end;
  316.  
  317. // deflate compresses data
  318.  
  319. function BZ2_bzCompressInit(var strm: TBZStreamRec; blockSize100k: Integer;
  320.   verbosity: Integer; workFactor: Integer): Integer; stdcall; external;
  321.  
  322. function BZ2_bzCompress(var strm: TBZStreamRec; action: Integer): Integer; stdcall; external;
  323.  
  324. function BZ2_bzCompressEnd(var strm: TBZStreamRec): Integer; stdcall; external;
  325.  
  326. function BZ2_bzBuffToBuffCompress(dest: Pointer; var destLen: Integer; source: Pointer;
  327.   sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer; stdcall; external;
  328.  
  329. // inflate decompresses data
  330.  
  331. function BZ2_bzDecompressInit(var strm: TBZStreamRec; verbosity: Integer;
  332.   small: Integer): Integer; stdcall; external;
  333.  
  334. function BZ2_bzDecompress(var strm: TBZStreamRec): Integer; stdcall; external;
  335.  
  336. function BZ2_bzDecompressEnd(var strm: TBZStreamRec): Integer; stdcall; external;
  337.  
  338. function BZ2_bzBuffToBuffDecompress(dest: Pointer; var destLen: Integer; source: Pointer;
  339.   sourceLen, small, verbosity: Integer): Integer; stdcall; external;
  340.  
  341.  
  342. function bzip2AllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
  343. begin
  344.   GetMem(Result, Items * Size);
  345. end;
  346.  
  347. procedure bzip2FreeMem(AppData, Block: Pointer); cdecl;
  348. begin
  349.   FreeMem(Block);
  350. end;
  351.  
  352. {
  353. function zlibCheck(code: Integer): Integer;
  354. begin
  355.   Result := code;
  356.   if code < 0 then
  357.     raise EZlibError.Create('error');    //!!
  358. end;
  359. }
  360.  
  361. function CCheck(code: Integer): Integer;
  362. begin
  363.   Result := code;
  364.   if code < 0 then
  365.     raise EBZCompressionError.CreateFmt('error %d', [code]); //!!
  366. end;
  367.  
  368. function DCheck(code: Integer): Integer;
  369. begin
  370.   Result := code;
  371.   if code < 0 then
  372.     raise EBZDecompressionError.CreateFmt('error %d', [code]); //!!
  373. end;
  374.  
  375.  
  376. procedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer;
  377.   out OutBuf: Pointer; out OutBytes: Integer);
  378. var
  379.   strm: TBZStreamRec;
  380.   P: Pointer;
  381. begin
  382.   FillChar(strm, sizeof(strm), 0);
  383.   strm.bzalloc := bzip2AllocMem;
  384.   strm.bzfree := bzip2FreeMem;
  385.   OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
  386.   GetMem(OutBuf, OutBytes);
  387.   try
  388.     strm.next_in := InBuf;
  389.     strm.avail_in := InBytes;
  390.     strm.next_out := OutBuf;
  391.     strm.avail_out := OutBytes;
  392.     CCheck(BZ2_bzCompressInit(strm, 9, 0, 0));
  393.     try
  394.       while CCheck(BZ2_bzCompress(strm, BZ_FINISH)) <> BZ_STREAM_END do
  395.       begin
  396.         P := OutBuf;
  397.         Inc(OutBytes, 256);
  398.         ReallocMem(OutBuf, OutBytes);
  399.         strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
  400.         strm.avail_out := 256;
  401.       end;
  402.     finally
  403.       CCheck(BZ2_bzCompressEnd(strm));
  404.     end;
  405.     ReallocMem(OutBuf, strm.total_out_lo32);
  406.     OutBytes := strm.total_out_lo32;
  407.   except
  408.     FreeMem(OutBuf);
  409.     raise
  410.   end;
  411. end;
  412.  
  413.  
  414. procedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;
  415.   OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
  416. var
  417.   strm: TBZStreamRec;
  418.   P: Pointer;
  419.   BufInc: Integer;
  420. begin
  421.   FillChar(strm, sizeof(strm), 0);
  422.   strm.bzalloc := bzip2AllocMem;
  423.   strm.bzfree := bzip2FreeMem;
  424.   BufInc := (InBytes + 255) and not 255;
  425.   if OutEstimate = 0 then
  426.     OutBytes := BufInc
  427.   else
  428.     OutBytes := OutEstimate;
  429.   GetMem(OutBuf, OutBytes);
  430.   try
  431.     strm.next_in := InBuf;
  432.     strm.avail_in := InBytes;
  433.     strm.next_out := OutBuf;
  434.     strm.avail_out := OutBytes;
  435.     DCheck(BZ2_bzDecompressInit(strm, 0, 0));
  436.     try
  437.       while DCheck(BZ2_bzDecompress(strm)) <> BZ_STREAM_END do
  438.       begin
  439.         P := OutBuf;
  440.         Inc(OutBytes, BufInc);
  441.         ReallocMem(OutBuf, OutBytes);
  442.         strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
  443.         strm.avail_out := BufInc;
  444.       end;
  445.     finally
  446.       DCheck(BZ2_bzDecompressEnd(strm));
  447.     end;
  448.     ReallocMem(OutBuf, strm.total_out_lo32);
  449.     OutBytes := strm.total_out_lo32;
  450.   except
  451.     FreeMem(OutBuf);
  452.     raise
  453.   end;
  454. end;
  455.  
  456. // TCustomBZip2Stream
  457.  
  458. constructor TCustomBZip2Stream.Create(Strm: TStream);
  459. begin
  460.   inherited Create;
  461.   FStrm := Strm;
  462.   FStrmPos := Strm.Position;
  463.   FBZRec.bzalloc := bzip2AllocMem;
  464.   FBZRec.bzfree := bzip2FreeMem;
  465. end;
  466.  
  467. procedure TCustomBZip2Stream.Progress(Sender: TObject);
  468. begin
  469.   if Assigned(FOnProgress) then FOnProgress(Sender);
  470. end;
  471.  
  472.  
  473. // TBZCompressionStream
  474.  
  475. constructor TBZCompressionStream.Create(BlockSize100k: TBlockSize100k; Dest: TStream);
  476. const
  477.   BlockSizes: array[TBlockSize100k] of ShortInt = (1, 2, 3, 4, 5, 6, 7, 8, 9);
  478. begin
  479.   inherited Create(Dest);
  480.   FBZRec.next_out := FBuffer;
  481.   FBZRec.avail_out := sizeof(FBuffer);
  482.   CCheck(BZ2_bzCompressInit(FBZRec, BlockSizes[BlockSize100k], 0, 0));
  483. end;
  484.  
  485. destructor TBZCompressionStream.Destroy;
  486. begin
  487.   FBZRec.next_in := nil;
  488.   FBZRec.avail_in := 0;
  489.   try
  490.     if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  491.     while (CCheck(BZ2_bzCompress(FBZRec, BZ_FINISH)) <> BZ_STREAM_END)
  492.       and (FBZRec.avail_out = 0) do
  493.     begin
  494.       FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
  495.       FBZRec.next_out := FBuffer;
  496.       FBZRec.avail_out := sizeof(FBuffer);
  497.     end;
  498.     if FBZRec.avail_out < sizeof(FBuffer) then
  499.       FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FBZRec.avail_out);
  500.   finally
  501.     BZ2_bzCompressEnd(FBZRec);
  502.   end;
  503.   inherited Destroy;
  504. end;
  505.  
  506. function TBZCompressionStream.Read(var Buffer; Count: Longint): Longint;
  507. begin
  508.   raise EBZCompressionError.Create('Invalid stream operation');
  509. end;
  510.  
  511. function TBZCompressionStream.Write(const Buffer; Count: Longint): Longint;
  512. begin
  513.   FBZRec.next_in := @Buffer;
  514.   FBZRec.avail_in := Count;
  515.   if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  516.   while (FBZRec.avail_in > 0) do
  517.   begin
  518.     CCheck(BZ2_bzCompress(FBZRec, BZ_RUN));
  519.     if FBZRec.avail_out = 0 then
  520.     begin
  521.       FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
  522.       FBZRec.next_out := FBuffer;
  523.       FBZRec.avail_out := sizeof(FBuffer);
  524.       FStrmPos := FStrm.Position;
  525.     end;
  526.     Progress(Self);
  527.   end;
  528.   Result := Count;
  529. end;
  530.  
  531. function TBZCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
  532. begin
  533.   if (Offset = 0) and (Origin = soFromCurrent) then
  534.     Result := FBZRec.total_in_lo32
  535.   else
  536.     raise EBZCompressionError.Create('Invalid stream operation');
  537. end;
  538.  
  539. function TBZCompressionStream.GetCompressionRate: Single;
  540. begin
  541.   if FBZRec.total_in_lo32 = 0 then
  542.     Result := 0
  543.   else
  544.     Result := (1.0 - (FBZRec.total_out_lo32 / FBZRec.total_in_lo32)) * 100.0;
  545. end;
  546.  
  547.  
  548. // TDecompressionStream
  549.  
  550. constructor TBZDecompressionStream.Create(Source: TStream);
  551. begin
  552.   inherited Create(Source);
  553.   FBZRec.next_in := FBuffer;
  554.   FBZRec.avail_in := 0;
  555.   DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));
  556. end;
  557.  
  558. destructor TBZDecompressionStream.Destroy;
  559. begin
  560.   BZ2_bzDecompressEnd(FBZRec);
  561.   inherited Destroy;
  562. end;
  563.  
  564. function TBZDecompressionStream.Read(var Buffer; Count: Longint): Longint;
  565. begin
  566.   FBZRec.next_out := @Buffer;
  567.   FBZRec.avail_out := Count;
  568.   if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  569.   while (FBZRec.avail_out > 0) do
  570.   begin
  571.     if FBZRec.avail_in = 0 then
  572.     begin
  573.       FBZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
  574.       if FBZRec.avail_in = 0 then
  575.       begin
  576.         Result := Count - FBZRec.avail_out;
  577.         Exit;
  578.       end;
  579.       FBZRec.next_in := FBuffer;
  580.       FStrmPos := FStrm.Position;
  581.     end;
  582.     CCheck(BZ2_bzDecompress(FBZRec));
  583.     Progress(Self);
  584.   end;
  585.   Result := Count;
  586. end;
  587.  
  588. function TBZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
  589. begin
  590.   raise EBZDecompressionError.Create('Invalid stream operation');
  591. end;
  592.  
  593. function TBZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
  594. var
  595.   I: Integer;
  596.   Buf: array[0..4095] of Char;
  597. begin
  598.   if (Offset = 0) and (Origin = soFromBeginning) then
  599.   begin
  600.     DCheck(BZ2_bzDecompressEnd(FBZRec));
  601.     DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));
  602.     FBZRec.next_in := FBuffer;
  603.     FBZRec.avail_in := 0;
  604.     FStrm.Position := 0;
  605.     FStrmPos := 0;
  606.   end
  607.   else if ((Offset >= 0) and (Origin = soFromCurrent)) or
  608.     (((Offset - FBZRec.total_out_lo32) > 0) and (Origin = soFromBeginning)) then
  609.   begin
  610.     if Origin = soFromBeginning then Dec(Offset, FBZRec.total_out_lo32);
  611.     if Offset > 0 then
  612.     begin
  613.       for I := 1 to Offset div sizeof(Buf) do
  614.         ReadBuffer(Buf, sizeof(Buf));
  615.       ReadBuffer(Buf, Offset mod sizeof(Buf));
  616.     end;
  617.   end
  618.   else
  619.     raise EBZDecompressionError.Create('Invalid stream operation');
  620.   Result := FBZRec.total_out_lo32;
  621. end;
  622.  
  623. end.
  624.  
  625.  
  626.