abdfdec.pas

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

  end;

  {discard the bits for the end-of-block marker}
  {$IFOPT C+}
  aInStrm.DiscardBits(SymbolCodeLen);
  {$ELSE}
  if (aInStrm.BitsLeft < SymbolCodeLen) then
    aInStrm.DiscardMoreBits(SymbolCodeLen)
  else begin
    aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen;
    aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen;
  end;
  {$ENDIF}
end;
{--------}
procedure InflateStoredBlock(aInStrm    : TAbDfInBitStream;
                             aOutWindow : TAbDfOutputWindow;
                             aLog       : TAbLogger);
const
  BufferSize = 16 * 1024;
var
  LenNotLen : packed record
    Len    : word;
    NotLen : word;
  end;
  BytesToGo    : integer;
  BytesToWrite : integer;
  Buffer       : pointer;
begin
  {$IFDEF UseLogging}
  {log it}
  if (aLog <> nil) then
    aLog.WriteLine('....a stored block');
  {$ENDIF}

  {align the input bit stream to the nearest byte boundary}
  aInStrm.AlignToByte;

  {read the length of the stored data and the notted length}
  aInStrm.ReadBuffer(LenNotLen, sizeof(LenNotLen));

  {$IFDEF UseLogging}
  {log it}
  if (aLog <> nil) then
    aLog.WriteLine(Format('..block length: %d (%-4x, NOT %-4x)',
                          [LenNotLen.Len, LenNotLen.Len, LenNotLen.NotLen]));
  {$ENDIF}

  {check that NOT of the length equals the notted length}
  if ((not LenNotLen.Len) <> LenNotLen.NotLen) then
    raise EAbInternalInflateError.Create(
       'invalid stored block (length and NOT length do not match) [InflateStoredBlock]');

  {calculate the number of bytes to copy from the stored block}
  BytesToGo := LenNotLen.Len;

  {allocate a large buffer}
  GetMem(Buffer, BufferSize);

  {copy all the data in the stored block to the output window}
  try
    {while there are still some bytes to copy...}
    while (BytesToGo <> 0) do begin
      {calculate the number of bytes this time}
      if (BytesToGo > BufferSize) then
        BytesToWrite := BufferSize
      else
        BytesToWrite := BytesToGo;

      {read that many bytes and write them to the output window}
      aInStrm.ReadBuffer(Buffer^, BytesToWrite);
      aOutWindow.AddBuffer(Buffer^, BytesToWrite);

      {calculate the number of bytes still to copy}
      dec(BytesToGo, BytesToWrite);
    end;
  finally
    FreeMem(Buffer);
  end;
end;
{--------}
procedure InflateStaticBlock(aInStrm    : TAbDfInBitStream;
                             aOutWindow : TAbDfOutputWindow;
                             aLog       : TAbLogger;
                             aDeflate64 : boolean);
begin
  {$IFDEF UseLogging}
  {log it}
  if (aLog <> nil) then
    aLog.WriteLine('....a static huffman tree block');
  {$ENDIF}

  {decode the data with the static trees}
  DecodeData(aInStrm, aOutWindow,
             AbStaticLiteralTree, AbStaticDistanceTree, aDeflate64);
end;
{--------}
procedure InflateDynamicBlock(aInStrm    : TAbDfInBitStream;
                              aOutWindow : TAbDfOutputWindow;
                              aLog       : TAbLogger;
                              aDeflate64 : boolean);
var
  i : integer;
  LitCount      : integer;
  DistCount     : integer;
  CodeLenCount  : integer;
  CodeLens      : array [0..285+32] of integer;
  CodeLenTree   : TAbDfDecodeHuffmanTree;
  LiteralTree   : TAbDfDecodeHuffmanTree;
  DistanceTree  : TAbDfDecodeHuffmanTree;
  TotalBits     : integer;
begin
  {$IFDEF UseLogging}
  {log it}
  if (aLog <> nil) then
    aLog.WriteLine('....a dynamic huffman tree block');
  {$ENDIF}

  {prepare for the try..finally}
  CodeLenTree := nil;
  LiteralTree := nil;
  DistanceTree := nil;

  try
    {decode the number of literal, distance and codelength codes}
    LitCount := aInStrm.ReadBits(5) + 257;
    DistCount := aInStrm.ReadBits(5) + 1;
    CodeLenCount := aInStrm.ReadBits(4) + 4;

    {$IFDEF UseLogging}
    {log it}
    if (aLog <> nil) then begin
      aLog.WriteLine(Format('Count of literals:     %d', [LitCount]));
      aLog.WriteLine(Format('Count of distances:    %d', [DistCount]));
      aLog.WriteLine(Format('Count of code lengths: %d', [CodeLenCount]));
    end;
    {$ENDIF}

    {verify that the counts are valid}
    if (LitCount > 286) then
      raise EAbInternalInflateError.Create(
         'count of literal codes in dynamic block is greater than 286 [InflateDynamicBlock]');
    if (not aDeflate64) and (DistCount > 30) then
      raise EAbInternalInflateError.Create(
         'count of distance codes in dynamic block is greater than 30 [InflateDynamicBlock]');

    {read the codelengths}
    FillChar(CodeLens, 19 * sizeof(integer), 0);
    for i := 0 to pred(CodeLenCount) do
      CodeLens[dfc_CodeLengthIndex[i]] := aInStrm.ReadBits(3);

    {$IFDEF UseLogging}
    {log them}
    if (aLog <> nil) then begin
      aLog.WriteLine('CodeLength Huffman tree: code lengths');
      for i := 0 to 18 do
        aLog.WriteStr(Format('%-3d', [CodeLens[i]]));
      aLog.WriteLine('');
      aLog.WriteLine(Format('..total bits: %d', [CodeLenCount * 3]));
    end;
    {$ENDIF}

    {create the codelength huffman tree}
    CodeLenTree := TAbDfDecodeHuffmanTree.Create(19, 7, huDecoding);
    CodeLenTree.Build(CodeLens, 0, 19, [0], $FFFF);

    {$IFDEF UseLogging}
    {log the tree}
    if (aLog <> nil) then begin
      aLog.WriteLine('Code lengths tree');
      CodeLenTree.DebugPrint(aLog);
    end;
    {$ENDIF}

    {read the codelengths for both the literal/length and distance
     huffman trees}
    ReadLitDistCodeLengths(aInStrm, CodeLenTree, CodeLens,
                           LitCount + DistCount, TotalBits);

    {$IFDEF UseLoggingx}
    {log them}
    if (aLog <> nil) then begin
      aLog.WriteLine('Literal/length & Dist Huffman trees: code lengths');
      for i := 0 to pred(LitCount + DistCount) do
        aLog.WriteLine(Format('%3d: %3d', [i, CodeLens[i]]));
      aLog.WriteLine('');
      aLog.WriteLine(Format('..total bits: %d', [TotalBits]));
    end;
    {$ENDIF}

    {create the literal huffman tree}
    LiteralTree := TAbDfDecodeHuffmanTree.Create(286, 15, huDecoding);
    LiteralTree.Build(CodeLens, 0, LitCount,
                      dfc_LitExtraBits, dfc_LitExtraOffset);

    {$IFDEF UseLogging}
    {log the tree}
    if (aLog <> nil) then begin
      aLog.WriteLine('Literal/length tree');
      LiteralTree.DebugPrint(aLog);
    end;
    {$ENDIF}

    {create the distance huffman tree}
    if aDeflate64 then
      DistanceTree := TAbDfDecodeHuffmanTree.Create(32, 15, huDecoding)
    else
      DistanceTree := TAbDfDecodeHuffmanTree.Create(30, 15, huDecoding);
    DistanceTree.Build(CodeLens, LitCount, DistCount,
                       dfc_DistExtraBits, dfc_DistExtraOffset);

    {$IFDEF UseLogging}
    {log the tree}
    if (aLog <> nil) then begin
      aLog.WriteLine('Distance tree');
      DistanceTree.DebugPrint(aLog);
    end;
    {$ENDIF}

    {using the literal and distance trees, decode the bit stream}
    DecodeData(aInStrm, aOutWindow,
               LiteralTree, DistanceTree, aDeflate64);
  finally
    CodeLenTree.Free;
    LiteralTree.Free;
    DistanceTree.Free;
  end;
end;
{====================================================================}


{===Interfaced routine===============================================}
function Inflate(aSource : TStream; aDest : TStream;
                 aHelper : TAbDeflateHelper) : longint;
var
  Helper       : TAbDeflateHelper;
  InBitStrm    : TAbDfInBitStream;
  DecryptStrm  : TAbDfDecryptStream;
  OutWindow    : TAbDfOutputWindow;
  Log          : TAbLogger;
  UseDeflate64 : boolean;
  UseCRC32     : boolean;
  IsFinalBlock : boolean;
  BlockType    : integer;
  TestOnly     : boolean;
  SourceStartPos : longint;
  DestStartPos   : longint;
  {$IFDEF UseLogging}
  StartPosn    : longint;
  {$ENDIF}
begin
  {$IFDEF DefeatWarnings}
  Result := 0;
  SourceStartPos := 0;
  DestStartPos := 0;
  TestOnly := False;
  {$ENDIF}

  {$IFDEF UseLogging}
  StartPosn := 0;
  {$ENDIF}

  {pre-conditions: streams must be allocated of course}
  Assert(aSource <> nil, 'Deflate: aSource stream cannot be nil');
  Assert(aDest <> nil, 'Deflate: aDest stream cannot be nil');

  {prepare for the try..finally}
  Helper := nil;
  InBitStrm := nil;
  OutWindow := nil;
  Log := nil;
  DecryptStrm := nil;                                          {!!.02}

  try {finally}
    try {except}
      {create our helper; assign the passed one to it}
      Helper := TAbDeflateHelper.Create;
      if (aHelper <> nil) then
        Helper.Assign(aHelper);

      {get the initial start positions of both streams}
      SourceStartPos := aSource.Position;
      DestStartPos := aDest.Position;

      {if the helper's stream size is -1, and it has a progress event
       handler, calculate the stream size from the stream itself}
      if Assigned(Helper.OnProgressStep) then begin
        if (Helper.StreamSize = -1) then
          Helper.StreamSize := aSource.Size;
      end
      
      {otherwise we certainly can't do any progress reporting}
      else begin
        Helper.OnProgressStep := nil;
        Helper.StreamSize := 0;
      end;

      {create the logger, if requested}
      if (Helper.LogFile <> '') then begin
        Log := TAbLogger.Create(Helper.LogFile);
        Log.WriteLine('INFLATING STREAM...');
        {$IFNDEF UseLogging}
        Log.WriteLine('Need to recompile the app with UseLogging turned on');
        {$ENDIF}
      end;

      {if a passphrase was specified, create a decryption stream
       wrapping the source and a bit stream over that}
      if (Helper.Passphrase <> '') then begin
        {$IFDEF UseLogging}
        Log.WriteLine('(passphrase is set: stream is encrypted)');
        {$ENDIF}
        DecryptStrm :=
           TAbDfDecryptStream.Create(
                       aSource, Helper.CheckValue, Helper.Passphrase);
        if not DecryptStrm.IsValid then
          raise EAbInflatePasswordError.Create(
                  'Inflate: stream is encrypted but passphrase is wrong');
        InBitStrm := TAbDfInBitStream.Create(DecryptStrm,
                                             Helper.OnProgressStep,
                                             Helper.StreamSize);
      end
      {otherwise, just create the input bit stream}
      else
        InBitStrm := TAbDfInBitStream.Create(aSource,
                                             Helper.OnProgressStep,
                                             Helper.StreamSize);

      {create the output sliding window}
      UseDeflate64 := (Helper.Options and dfc_UseDeflate64) <> 0;
      UseCRC32 := (Helper.Options and dfc_UseAdler32) = 0;
      TestOnly := (Helper.Options and dfc_TestOnly) <> 0;
      OutWindow := TAbDfOutputWindow.Create(
              aDest, UseDeflate64, UseCRC32, Helper.PartialSize,
              TestOnly, Log);

      {start decoding the deflated stream}
      repeat
        {read the final block flag and the block type}
        IsFinalBlock := InBitStrm.ReadBit;
        BlockType := InBitStrm.ReadBits(2);

        {$IFDEF UseLogging}
        {log it}
        if (Log <> nil) then begin
          Log.WriteLine('');
          Log.WriteLine('Starting new block');
          Log.WriteLine(Format('..final block? %d', [ord(IsFinalBlock)]));
          Log.WriteLine(Format('..block type? %d', [BlockType]));
          StartPosn := OutWindow.Position;
        end;
        {$ENDIF}

        case BlockType of
          0 : InflateStoredBlock(InBitStrm, OutWindow, Log);
          1 : InflateStaticBlock(InBitStrm, OutWindow, Log, UseDeflate64);
          2 : InflateDynamicBlock(InBitStrm, OutWindow, Log, UseDeflate64);
        else
          raise EAbInternalInflateError.Create(
             'starting new block, but invalid block type [Inflate]');
        end;

        {$IFDEF UseLogging}
        {log it}
        if (Log <> nil) then
          Log.WriteLine(Format('---block end---  (decoded size %d bytes)',
                               [OutWindow.Position - StartPosn]));
        {$ENDIF}
      until IsFinalBlock;

      {get the uncompressed stream's checksum}
      Result := OutWindow.Checksum;
      if TestOnly and (aHelper <> nil) then
        aHelper.NormalSize := OutWindow.Position;
      {$IFDEF UseLogging}
      {log it}
      if (Log <> nil) then
        Log.WriteLine(Format('End of compressed stream, checksum %-8x',
                             [Result]));
      {$ENDIF}
    except
      on E : EAbPartSizedInflate do begin
        {nothing, just swallow the exception}
        Result := 0;
      end;
      on E : EAbAbortProgress do begin
        {nothing, just swallow the exception}
        Result := 0;
      end;
      on E : EAbInternalInflateError do begin
        if (Log <> nil) then
          Log.WriteLine(Format('Internal exception raised: %s',
                                [E.Message]));
        raise EAbInflateError.Create(E.Message);
      end;
    end;
  finally
    Helper.Free;
    OutWindow.Free;
    InBitStrm.Free;
    DecryptStrm.Free;                                          {!!.02}
    Log.Free;
  end;

  {if there's a helper return the compressed and uncompressed sizes}
  if (aHelper <> nil) then begin
    if not TestOnly then
      aHelper.NormalSize := aDest.Position - DestStartPos;
    aHelper.CompressedSize := aSource.Position - SourceStartPos;
  end;

  {WARNING NOTE: the compiler will warn that the return value of this
                 function might be undefined. However, it is wrong: it
                 has been fooled by the code. If you don't want to see
                 this warning again, enable the DefeatWarnings
                 compiler define in AbDefine.inc.}
end;
{====================================================================}

end.