abunzprc.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* ABBREVIA: AbUnzPrc.pas 3.05                           *}
{*********************************************************}
{* ABBREVIA: UnZip procedures                            *}
{*********************************************************}

{$I AbDefine.inc}

unit AbUnzPrc;

interface

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  AbArcTyp,
  AbZipTyp,
  AbUtils,
  AbDfBase,
  AbDfDec,
  AbDfCryS,
  AbZipCry,
  AbSWStm,
  AbSpanSt,
  Classes;

type
  TAbUnzipHelper = class( TObject )
  protected {private}
    {internal variables}
    FOutWriter : TStream;
    FOutStream : TStream;
    FUnCompressedSize : LongInt;
    FCRC32 : LongInt;
    FCompressedSize : LongInt;
    FCompressionMethod : TAbZipCompressionMethod;
    FDecoder : TAbZDecoder;
    FDictionarySize : TAbZipDictionarySize;
    FShannonFanoTreeCount : Byte;
    FOnProgress : TAbProgressEvent;
    FOnRequestNthDisk : TAbRequestNthDiskEvent;
    FCurrentProgress : Byte;
    {spanning variables}
    FSpanned : Boolean;
    FArchiveName : string;
    FArchive : TAbArchive;
    FCurrentDisk : Word;
    FMode : Word;

    FOutBuf : PAbByteArray;          {output buffer}
    FOutSent : LongInt;              {number of bytes sent to output buffer}
    FOutPos : Cardinal;              {current position in output buffer}
    FBitSValid : Byte;               {Number of valid bits}

    FInBuf : TAbByteArray4K;
    FInPos : Integer;                {current position in input buffer}
    FInCnt : Integer;                {number of bytes in input buffer}
    FInLeft : LongInt;               {bytes remaining in compressed input file}
    FInEof  : Boolean;               {set when FInLeft = 0}
    FCurByte : Byte;                 {current input byte}
    FBitsLeft : Byte;                {bits left to process in FCurByte}
    FdBitStrBuf : Word;              {Bit string output buffer}
    {cannot change FdBitStrBuf to a Cardinal}
    FiOverflowBuf : Cardinal;        {Bit overflow holding buffer}


    FiSlide : PAbiSlide;             {Sliding window buffer}
    FiSlidePos : Cardinal;               {Current position in Slide}


    FZStream : TStream;
  protected
    procedure DoProgress( Progress : Byte; var Abort : Boolean );
      virtual;
    procedure DoRequestNthDisk( DiskNumber : Byte; var Abort : Boolean );
      virtual;
    procedure uzFlushOutBuf;
      {-Flushes the output buffer}

    function uzReadBits(Bits : Byte) : Integer;
      {-Read the specified number of bits}
    procedure uzReadNextPrim;
      {-does less likely part of uzReadNext}

    {$IFDEF UnzipImplodeSupport}
    procedure uzUnImplode;
      {-Extract an imploded file}
    {$ENDIF}

    {$IFDEF UnzipReduceSupport}
    procedure uzUnReduce;
      {-Extract a reduced file}
    {$ENDIF}

    {$IFDEF UnzipShrinkSupport}
    procedure uzUnShrink;
      {-Extract a shrunk file}
    {$ENDIF}
    procedure uzWriteByte(B : Byte);
      {write to output}
  public
    constructor Create( var InputStream : TStream; OutputStream : TStream;
                        aDecoder : TObject );
    destructor Destroy;
      override;

    property Archive : TAbArchive
      read FArchive write FArchive;
    property ArchiveName : string
      read FArchiveName
      write FArchiveName;
    property CurrentDisk : Word
      read FCurrentDisk
      write FCurrentDisk;
    function Execute : LongInt;
      {returns the CRC}
    property Mode : Word
      read FMode
      write FMode;
    property OnProgress : TAbProgressEvent
      read FOnProgress
      write FOnProgress;
    property OnRequestNthDisk : TAbRequestNthDiskEvent
      read FOnRequestNthDisk
      write FOnRequestNthDisk;
    property Spanned : Boolean
      read FSpanned
      write FSpanned;
    property CompressedSize : LongInt
      read FCompressedSize
      write FCompressedSize;
    property UnCompressedSize : LongInt
      read FUncompressedSize
      write FUncompressedSize;
    property CompressionMethod : TAbZipCompressionMethod
      read FCompressionMethod
      write FCompressionMethod;
    property DictionarySize : TAbZipDictionarySize
      read FDictionarySize
      write FDictionarySize;
    property ShannonFanoTreeCount : Byte
      read FShannonFanoTreeCount
      write FShannonFanoTreeCount;
  end;



  procedure AbUnzipToStream( Sender : TObject; Item : TAbZipItem;
    OutStream : TStream);

  procedure AbUnzip(Sender : TObject; Item : TAbZipItem; NewName : string);

  procedure AbTestZipItem(Sender : TObject; Item : TAbZipItem);

  procedure InflateStream(CompressedStream, UnCompressedStream : TStream);
  {-Inflates everything in CompressedStream to UncompressedStream
    no encryption is tried, no check on CRC is done, uses the whole
    compressedstream - no Progress events - no Frills!}

implementation

uses
  AbConst,
  AbExcept,
  AbBitBkt,
  {$IFNDEF NoQt}
  {$IFDEF LINUX}
  QControls,
  QDialogs,
  {$ENDIF}
  {$ENDIF}
  SysUtils;

{ -------------------------------------------------------------------------- }
procedure AbReverseBits(var W : Word);assembler;
  {-Reverse the order of the bits in W}
register;
const
  RevTable : array[0..255] of Byte = ($00, $80, $40, $C0, $20, $A0, $60,
   $E0, $10, $90, $50, $D0, $30, $B0, $70, $F0, $08, $88, $48, $C8, $28,
   $A8, $68, $E8, $18, $98, $58, $D8, $38, $B8, $78, $F8, $04, $84, $44,
   $C4, $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4, $0C,
   $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC, $3C, $BC, $7C,
   $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2, $12, $92, $52, $D2, $32,
   $B2, $72, $F2, $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA, $1A, $9A, $5A,
   $DA, $3A, $BA, $7A, $FA, $06, $86, $46, $C6, $26, $A6, $66, $E6, $16,
   $96, $56, $D6, $36, $B6, $76, $F6, $0E, $8E, $4E, $CE, $2E, $AE, $6E,
   $EE, $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81, $41, $C1, $21,
   $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1, $09, $89, $49,
   $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9, $39, $B9, $79, $F9, $05,
   $85, $45, $C5, $25, $A5, $65, $E5, $15, $95, $55, $D5, $35, $B5, $75,
   $F5, $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D,
   $BD, $7D, $FD, $03, $83, $43, $C3, $23, $A3, $63, $E3, $13, $93, $53,
   $D3, $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB, $1B,
   $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7, $27, $A7, $67,
   $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7, $0F, $8F, $4F, $CF, $2F,
   $AF, $6F, $EF, $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF);
asm
  push eax                 // save EAX
  mov  eax, [eax]          // read value into EAX
  xor  ecx, ecx            // zero ECX
  mov  cl, al              // prepare for table lookup
  lea  edx, RevTable       // get address to table
  mov  al, [edx+ecx]       // table lookup for low byte
  mov  cl, ah              // prepare high byte for table lookup
  mov  ah, al              // reverse bytes
  mov  al, [edx+ecx]       // table lookup for high (now low) byte
  pop  edx                 // restore address to W
  mov  [edx], eax          // move value to W
end;


{ TAbUnzipHelper implementation ============================================ }

{ -------------------------------------------------------------------------- }
constructor TAbUnzipHelper.Create( var InputStream : TStream;
                                   OutputStream : TStream;
                                   aDecoder : TObject );
begin
  inherited Create;
  FOutBuf := AllocMem( AbBufferSize );                                 
  FOutPos := 0;                                                        
  FZStream := InputStream;
  FOutStream := OutputStream;
  FDecoder := TAbZDecoder( aDecoder );
  FCompressedSize := FZStream.Size;
  FUncompressedSize := 0;
  FDictionarySize := dsInvalid;
  FShannonFanoTreeCount := 0;
  FCompressionMethod := cmDeflated;
  {starting value for output CRC}
  FCRC32 := -1;
  FCurrentProgress := 0;
  FSpanned := False;
  FMode := 0;
  FArchiveName := '';
  FCurrentDisk := 0;
end;
{ -------------------------------------------------------------------------- }
destructor TAbUnzipHelper.Destroy;
begin
  FreeMem( FOutBuf, AbBufferSize );                                    
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
function TAbUnzipHelper.Execute : LongInt;
begin
  {parent class handles exceptions via OnExtractFailure}
  FBitsLeft := 0;
  FCurByte := 0;
  FInCnt := 0;
  FOutSent := 0;
  FOutPos := 0;
  FInEof := False;

  {set the output stream; for Imploded/Reduced files this has to be
   buffered, for all other types of compression, the code buffers the
   output data nicely and so the given output stream can be used.}
  {$IFDEF UnzipImplodeSupport}
  if (FCompressionMethod = cmImploded) then
    FOutWriter := TabSlidingWindowStream.Create(FOutStream)
  else
  {$ENDIF}
  {$IFDEF UnzipReduceSupport}
  if (FCompressionMethod >= cmReduced1) and
     (FCompressionMethod <= cmReduced4) then
    FOutWriter := TabSlidingWindowStream.Create(FOutStream)
  else
  {$ENDIF}
    FOutWriter := FOutStream;
  FInLeft := FCompressedSize;
  FInPos := 1+SizeOf(FInBuf);

{  GetMem( FInBuf, SizeOf(FInBuf^) );}
  try
    if Assigned( FDecoder ) then begin
      FDecoder.ReadEncryptionHeader;
      Dec( FInLeft, 12 );
    end;

    {uncompress it with the appropriate method}
    case FCompressionMethod of
      {$IFDEF UnzipShrinkSupport}
      cmShrunk               : uzUnshrink;
      {$ENDIF}
      {$IFDEF UnzipReduceSupport}
      cmReduced1..cmReduced4 : uzUnReduce;
      {$ENDIF}
      {$IFDEF UnzipImplodeSupport}
      cmImploded             : uzUnImplode;
      {$ENDIF}
      {cmTokenized}
      {cmEnhancedDeflated}
      {cmDCLImploded}
    else
      raise EAbZipInvalidMethod.Create;
    end;

  finally
    uzFlushOutBuf;
    {free any memory}
    if (FOutWriter <> FOutStream) then
      FOutWriter.Free;
  end;
  Result := not FCRC32;
end;
{ -------------------------------------------------------------------------- }
procedure TAbUnzipHelper.uzReadNextPrim;
var
  L : LongInt;
  {i : Integer;}
  NeedDisk : Boolean;
  Abort : Boolean;
begin
  if (FInLeft = 0) then begin
    {we're done}
    FInEof := True;
    FInPos := FInCnt+1;
  end
  else begin
      {spanning stuff}
    if Spanned and (FZStream.Size = FZStream.Position) then begin
      {need the next disk!}
      CurrentDisk := CurrentDisk + 1;
      if not (FZStream is TFileStream) then                           
        raise EAbZipBadSpanStream.Create;
      TAbZipArchive(FArchive).DoRequestNthImage(CurrentDisk, FZStream, Abort );
    end;
    NeedDisk := False;
    if FInLeft > sizeof( FInBuf ) then
      L := sizeOf( FInBuf )
    else
      L := FInLeft;
    if L >= ( FZStream.Size - FZStream.Position ) then begin
      NeedDisk := True;
      L := FZStream.Size - FZStream.Position;
    end;
    FInCnt := FZStream.Read( FInBuf, L );
    if (FInCnt = 0) then                                               
      raise EAbReadError.Create;
    if FDecoder <> nil then
      FDecoder.DecodeBuffer( FInBuf[1], FInCnt );                      

    {decrement count of bytes left to go}
    Dec(FInLeft, FInCnt);
    FInEof :=  ( not NeedDisk ) and ( FZStream.Position = FZStream.Size );

    {load first byte in buffer and set position counter}
    FCurByte := FInBuf[1];
    FInPos := 2;
  end;
end;