abdfenc.pas

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

        if (PrevMatch.maLen <> 0) then begin
          LZStrmIsFull :=
             LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);
          SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 2);
          PrevMatch.maLen := 0;
        end

        {otherwise there was no previous match or it's already been
         output, so output this literal}
        else begin
          LZStrmIsFull := LZ77Stream.AddLiteral(Match.maLit);
          SlideWin.AdvanceByOne;
          PrevMatch.maLen := 0;
        end;
      end;

      {get the next key}
      KeyLen := SlideWin.GetNextKeyLength;
    end;

    {if the last key read were one or two characters in length, save
     them as literal character encodings}
    if (KeyLen > 0) then begin
      {if there's a match pending, it'll be of length 3: output it}
      if (PrevMatch.maLen <> 0) then begin
        Assert(PrevMatch.maLen = 3,
               'DeflateStaticDynamic: previous match should be length 3');
        LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);
      end
      {otherwise, output the one or two final literals}
      else
        for i := 1 to KeyLen do
          LZ77Stream.AddLiteral(SlideWin.GetNextChar);
    end;

    {empty the LZ77 stream}
    if aStatic then
      EncodeLZStreamStatic(true, UseDeflate64,
                           LZ77Stream, BitStrm, aLog)
    else
      EncodeLZStreamDynamic(true, UseDeflate64, aUseBest,
                            LZ77Stream, BitStrm, aLog);

    {calculate the checksum of the input stream}
    Result := SlideWin.Checksum;
  finally
    {free the objects}
    SlideWin.Free;
    BitStrm.Free;
    LZ77Stream.Free;
  end;{try..finally}

  {$IFDEF UseLogging}
  {log it}
  if (aLog <> nil) then
    aLog.WriteLine(Format('..checksum: %8x', [Result]))
  {$ENDIF}
end;
{====================================================================}


{===Simple storing===================================================}
function DeflateStored(aSource : TStream; aDest : TStream;
                       aHelper : TAbDeflateHelper;
                       aLog    : TAbLogger) : longint;
const
  StoredBlockSize = $FFFF;
var
  Buffer    : PAnsiChar;
  BytesRead : longint;
  ByteCount : longint;
  BytesToGo : longint;
  CurPos    : longint;
  Size      : longint;
  Percent   : longint;
  CheckSum  : longint;
  UseCRC32  : boolean;
  BlockHeader : packed record
    bhInfo    : byte;
    bhSize    : word;
    bhNotSize : word;
  end;
begin
  {note: this routine merely stores the aSource stream data, no
         compression is attempted or done}
  {$IFDEF UseLogging}
  if (aLog <> nil) then
    aLog.WriteLine('..storing source data to destination, no compression');
  {$ENDIF}

  {initialize}
  ByteCount := 0;
  UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0;
  if UseCRC32 then
    Checksum := -1  { CRC32 starts off with all bits set}
  else
    CheckSum := 1;  { Adler32 starts off with a value of 1}
  if (aHelper.StreamSize > 0) then
    BytesToGo := aHelper.StreamSize
  else begin
    CurPos := aSource.Seek(0, soFromCurrent);
    Size := aSource.Seek(0, soFromEnd);
    aSource.Seek(CurPos, soFromBeginning);
    BytesToGo := Size - CurPos;
  end;

  {get a buffer}
  GetMem(Buffer, StoredBlockSize);
  try

    {while there is still data to be stored...}
    while (BytesToGo <> 0) do begin

      {read the next block}
      BytesRead := aSource.Read(Buffer^, StoredBlockSize);

      {fire the progress event}
      if Assigned(aHelper.OnProgressStep) then begin
        inc(ByteCount, BytesRead);
        Percent := Round((100.0 * ByteCount) / aHelper.StreamSize);
        aHelper.OnProgressStep(Percent);
      end;

      {update the checksum}
      if UseCRC32 then
        AbUpdateCRCBuffer(Checksum, Buffer^, BytesRead)
      else
        AbUpdateAdlerBuffer(Checksum, Buffer^, BytesRead);

      {write the block header}
      if (BytesRead = BytesToGo) then
        BlockHeader.bhInfo := 1  {ie, final block, stored}
      else
        BlockHeader.bhInfo := 0; {ie, not final block, stored}
      BlockHeader.bhSize := BytesRead;
      BlockHeader.bhNotSize := not BlockHeader.bhSize;
      aDest.WriteBuffer(BlockHeader, sizeof(BlockHeader));

      {write the block of data}
      aDest.WriteBuffer(Buffer^, BytesRead);

      {$IFDEF UseLogging}
      {log it}
      if (aLog <> nil) then begin
        if (BlockHeader.bhInfo = 0) then
          aLog.WriteLine(Format('..block size: %d', [BytesRead]))
        else
          aLog.WriteLine(Format('..block size: %d (final block)',
                                [BytesRead]));
      end;
      {$ENDIF}

      {decrement the number of bytes to go}
      dec(BytesToGo, BytesRead);
    end;
  finally
    FreeMem(Buffer);
  end;

  {return the checksum}
  {note: the CRC32 checksum algorithm requires a post-conditioning
         step after being calculated (the result is NOTted), whereas
         Adler32 does not}
  if UseCRC32 then
    Result := not Checksum
  else
    Result := Checksum;

  {$IFDEF UseLogging}
  {log it}
  if (aLog <> nil) then
    aLog.WriteLine(Format('..checksum: %8x', [Result]))
  {$ENDIF}
end;
{====================================================================}


{===Interfaced routine===============================================}
function Deflate(aSource : TStream; aDest : TStream;
                 aHelper : TAbDeflateHelper) : longint;
var
  Helper   : TAbDeflateHelper;
  Log      : TAbLogger;
  DestStrm : TStream;
  SourceStartPos : longint;
  DestStartPos   : longint;
begin
  {pre-conditions: streams are allocated,
                   options enable some kind of archiving}
  Assert(aSource <> nil, 'Deflate: aSource stream cannot be nil');
  Assert(aDest <> nil, 'Deflate: aDest stream cannot be nil');
  Assert((aHelper = nil) or ((aHelper.Options and $07) <> 0),
         'Deflate: aHelper.Options must enable some kind of archiving');

  {$IFDEF DefeatWarnings}
  Result := 0;
  {$ENDIF}

  {prepare for the try..finally}
  Helper := nil;
  Log := nil;
  DestStrm := nil;

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

      {save the current 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;

      {if lazy matching is not requested, ensure the maximum lazy
       match length is zero: this make the LZ77 code a little easier
       to understand}
      if ((Helper.Options and dfc_UseLazyMatch) = 0) then
        Helper.MaxLazyLength := 0;

      {patch up the various lengths in the helper if they specify the
       maximum (that is, are equal to -1)}
      if (Helper.AmpleLength = -1) then
        Helper.AmpleLength := MaxLongInt;
      if (Helper.MaxLazyLength = -1) then
        Helper.MaxLazyLength := MaxLongInt;
      if (Helper.ChainLength = -1) then
        Helper.ChainLength := MaxLongInt;

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

      {if a passphrase was specified, create an encryption stream
       wrapping the destination}
      if (Helper.Passphrase <> '') then begin
        {$IFDEF UseLogging}
        Log.WriteLine('(passphrase is set: stream is encrypted)');
        {$ENDIF}
        DestStrm := TAbDfEncryptStream.Create(
                         aDest, Helper.CheckValue, Helper.Passphrase);
      end
      {otherwise, just use the destination stream without wrapping}
      else
        DestStrm := aDest;

      {use the helper's options property to decide what to do}
      case (Helper.Options and $07) of
        dfc_CanUseStored :
          Result := DeflateStored(aSource, DestStrm, Helper, Log);
        dfc_CanUseStatic :
          Result := DeflateStaticDynamic(true, false, aSource, DestStrm, Helper, Log);
        dfc_CanUseDynamic :
          Result := DeflateStaticDynamic(false, false, aSource, DestStrm, Helper, Log);
      else
        Result := DeflateStaticDynamic(false, true, aSource, DestStrm, Helper, Log);
      end;

      {save the uncompressed and compressed sizes}
      if (aHelper <> nil) then begin
        aHelper.NormalSize := aSource.Position - SourceStartPos;
        aHelper.CompressedSize := aDest.Position - DestStartPos;
      end;
    except
      on E : EAbInternalDeflateError do begin
        {$IFDEF UseLogging}
        if (Log <> nil) then
          Log.WriteLine(Format('Internal exception raised: %s',
                                [E.Message]));
        {$ENDIF}
        raise EAbDeflateError.Create(E.Message);
      end;
    end;
  finally
    if (Helper.Passphrase <> '') then
      DestStrm.Free;
    Helper.Free;
    Log.Free;
  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.