abscompression.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

//------------------------------------------------------------------------------
// load  block headers
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.LoadHeaders;
var CHeader:    TABSCompressedStreamBlockHeader;
    Pos,NewPos: Int64;
    i,OldPos:   Int64;
begin
 FCompressedSize := 0;
 FUncompressedSize := 0;
 // always restore StartPosition as blob stream can be stored at the middle of the file
 if (FCompressedStream.Position <> FBLOBDescriptor.StartPosition) then
  raise EABSException.Create(10080,ErrorLCannotSetPosition,
    [FBLOBDescriptor.StartPosition,FCompressedStream.Position,
     FCompressedStream.Size]);
 FHeaders.SetSize(0);

 i := 0;
 while (i < FBLOBDescriptor.NumBlocks) do
  begin
   // store position of the current block
   Pos := FCompressedStream.Position;
   // check if we can read block header from current position
   if (
       (FCompressedStream.Size - FCompressedStream.Position) <
       sizeof(TABSCompressedStreamBlockHeader)
      ) then
    begin
     // stream too small
     if (FRepair) then
      begin
       // cut compressed file (end of file was cut)
       // repair this error
       FBLOBDescriptor.NumBlocks := i;
       FHeaders.SetSize(i);
       break;
      end
     else
      raise EABSException.Create(10082,ErrorLStreamSizeTooSmall,
        [FCompressedStream.Size,
        FCompressedStream.Position + sizeof(TABSCompressedStreamBlockHeader)]);
    end; // check if we can read block header from current position
   FCompressedStream.ReadBuffer(CHeader,sizeof(TABSCompressedStreamBlockHeader));
   Inc(FUncompressedSize,CHeader.UncompressedSize);
   Inc(FCompressedSize,CHeader.CompressedSize);
   FHeaders.AppendItem(CHeader,Pos);
// Commented By Leo Martin - changed from absolute to relative offset
//   NewPos := CHeader.OffsetToNextHeader;
   NewPos := Pos + CHeader.OffsetToNextHeader;
   OldPos := FCompressedStream.Position;
   FCompressedStream.Position := NewPos;
   if (FCompressedStream.Position <> NewPos) then
    raise EABSException.Create(10083,ErrorLCannotSetPosition,
      [NewPos,OldPos,FCompressedStream.Size]);
   Inc(i);
  end; //  while (i < FBLOBDescriptor.NumBlocks)
end; // LoadHeaders


//------------------------------------------------------------------------------
// prepare buffer for writing
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.PrepareBufferForWriting
                                     (
                                      InBuf:        PChar;
                                      InSize:       Integer;
                                      var OutBuf:   PChar;
                                      var Header:   TABSCompressedStreamBlockHeader
                                     );
begin
  OutBuf := nil;
  Header.UncompressedSize := inSize;
  Header.Crc32 := CRC32(0,InBuf,InSize);
  if (not ABSInternalCompressBuffer(FCompressionAlgorithm,FCompressionMode,
          InBuf,InSize,OutBuf,Header.CompressedSize)) then
   begin
    if (OutBuf <> nil) then
     FreeMem(OutBuf);
    raise EABSException.Create(10085,ErrorLCompressBufferFailed,
      [Byte(FCompressionAlgorithm),FCompressionMode,InSize,Header.CompressedSize]);
   end;
end; //PrepareBuffer;


//------------------------------------------------------------------------------
// load block from file, decompress it and checks crc
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.LoadBlock(
                                      CurHeader:  Int64;
                                      var OutBuf: PChar
                                            );

var UncompSize,CompSize:  Integer;
    BytesRead:            Integer;
    CheckSum:             LongWord;
    InBuf:                PChar;
begin
  CompSize := FHeaders.Items[curHeader].CompressedSize;
  InBuf := MemoryManager.GetMem(CompSize);
  try
   FCompressedStream.Position := FHeaders.Positions[CurHeader] +
    sizeof(TABSCompressedStreamBlockHeader);

   BytesRead := FCompressedStream.Read(InBuf^,CompSize);
   if (BytesRead <> CompSize) then
    begin
     raise EABSException.Create(10086,ErrorLCannotReadFromStream,
      [FHeaders.Positions[CurHeader] + sizeof(TABSCompressedStreamBlockHeader),
      FCompressedStream.Size,CompSize,BytesRead]);
    end;

   UncompSize := FHeaders.Items[CurHeader].UncompressedSize;
   if (not ABSInternalDecompressBuffer(FCompressionalgorithm,
           InBuf,CompSize,OutBuf,UncompSize)) then
    begin
     // decompression error
     raise EABSException.Create(10087,ErrorLDecompressBufferFailed,
      [Byte(FCompressionAlgorithm),CompSize,UncompSize]);
    end;
   if (FHeaders.Items[CurHeader].UncompressedSize <> UncompSize) then
    begin
     FreeMem(outBuf);
     OutBuf := nil;
     raise EABSException.Create(10088,ErrorLDecompressBufferFailedInvalidSize,
      [UncompSize,FHeaders.Items[CurHeader].UncompressedSize]);
    end;
   // check crc
   CheckSum := CRC32(0,OutBuf,UncompSize);
   if (FHeaders.Items[CurHeader].Crc32 <> CheckSum) then
    begin
    // decompression crc error
     FreeMem(outBuf);
     OutBuf := nil;
     raise EABSException.Create(10089,ErrorLDecompressBufferFailedInvalidCRC,
      [CheckSum,FHeaders.Items[CurHeader].Crc32]);
    end;
  finally
   MemoryManager.FreeAndNillMem(inBuf);
  end;
end; // LoadBlock


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.InternalIncreaseSize(NewSize: Int64);
var Buf:                  PChar;
    ExtensionSize,Count:  Int64;
    OldPos:               Int64;
    WriteBytes,WriteSize: Integer;
begin
 Position := FUncompressedSize;
 ExtensionSize := NewSize - FUncompressedSize;
 if (ExtensionSize <= 0) then
  raise EABSException.Create(10098,ErrorLInvalidExtensionSize,
    [NewSize,FUncompressedSize,ExtensionSize]);
 Buf := MemoryManager.AllocMem(FBlockSize);
 try
  Count := 0;
  while (Count < ExtensionSize) do
   begin
    if ((ExtensionSize - Count) < FBlockSize) then
     WriteSize := ExtensionSize - Count
    else
     WriteSize := FBlockSize;
    OldPos := Self.Position;
    // write empty block
    WriteBytes := Self.Write(Buf^,WriteSize);
    if (WriteBytes <> WriteSize) then
      raise EABSException.Create(10097,ErrorLCannotWriteToStream,
        [OldPos,Self.Size,WriteSize,WriteBytes]);
    Inc(Count,WriteSize);
   end; // while
 finally
  MemoryManager.FreeAndNillMem(Buf);
 end;
end; // InternalIncreaseSize


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.InternalDecreaseSize(NewSize: Int64);
var Buf,OutBuf:           PChar;
    ExtensionSize,OldPos: Int64;
    CurHdr,NumBlocks:     Int64;
    BytesWrite:           Integer;
begin
  CurHdr := NewSize div FBlockSize;
  NumBlocks := CurHdr;
  ExtensionSize := NewSize mod FBlockSize;
  OutBuf := nil;
  Buf := nil;
  try
    if (ExtensionSize > 0) then
     begin
      Inc(NumBlocks);
      LoadBlock(CurHdr,Buf);
      try
       PrepareBufferForWriting(Buf,ExtensionSize,OutBuf,FHeaders.Items[CurHdr]);
      finally
       if (Buf <> nil) then
        MemoryManager.FreeAndNillMem(Buf);
      end;
     end;
    FBLOBDescriptor.NumBlocks := NumBlocks;
    FHeaders.SetSize(NumBlocks);
    if (ExtensionSize > 0) then
     begin
      FCompressedStream.Size := FHeaders.Positions[CurHdr];
      if (FCompressedStream.Size <> FHeaders.Positions[CurHdr]) then
       raise EABSException.Create(10093,ErrorLInvalidStreamSize,
        [FCompressedStream.Size,FHeaders.Positions[CurHdr]]);
      FCompressedStream.Position := FCompressedStream.Size;
      if (FCompressedStream.Position <> FCompressedStream.Size) then
       raise EABSException.Create(10094,ErrorLCannotSetPosition,
        [FCompressedStream.Size,FCompressedStream.Position,
         FCompressedStream.Size]);
      FHeaders.Items[CurHdr].OffsetToNextHeader := FCompressedStream.Position +
        Int64(FHeaders.Items[CurHdr].CompressedSize) +
        sizeof(TABSCompressedStreamBlockHeader);
      FHeaders.Positions[CurHdr] := FCompressedStream.Position;
      OldPos := FCompressedStream.Position;
      BytesWrite := FCompressedStream.Write(FHeaders.Items[curHdr],
          sizeof(TABSCompressedStreamBlockHeader));
      if (BytesWrite <> sizeof(TABSCompressedStreamBlockHeader)) then
       raise EABSException.Create(10095,ErrorLWriteToStream,
        [OldPos,FCompressedStream.Size,sizeof(TABSCompressedStreamBlockHeader),BytesWrite]);
      OldPos := FCompressedStream.Position;
      BytesWrite := FCompressedStream.Write(OutBuf^,FHeaders.Items[CurHdr].CompressedSize);
      if (BytesWrite <> sizeof(TABSCompressedStreamBlockHeader)) then
       raise EABSException.Create(10096,ErrorLWriteToStream,
        [OldPos,FCompressedStream.Size,sizeof(TABSCompressedStreamBlockHeader),BytesWrite]);
     end;
  finally
   if (OutBuf <> nil) then
    MemoryManager.FreeAndNillMem(OutBuf);
  end;
end; // InternalDecreaseSize


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.InternalSetSize(NewSize: Int64);
begin
 if (FCompressionAlgorithm = acaNone) then
  begin
   FCompressedStream.Size := FStartPosition + NewSize;
  end
 else
 if (NewSize > FUncompressedSize) then
  begin
    // go to last block
    InternalIncreaseSize(NewSize);
  end // NewSize > FUncompressedSize
 else
 if (NewSize < FUncompressedSize) then
  begin
    InternalDecreaseSize(NewSize);
  end; // NewSize < FUncompressedSize
 FUncompressedSize := NewSize;
 FBLOBDescriptor.UncompressedSize := NewSize;
 CalculateRate;
 if (FPosition > FUncompressedSize) then
  Position := FUncompressedSize;
end; // InternalSetSize


//------------------------------------------------------------------------------
// internal seek
//------------------------------------------------------------------------------
function TABSCompressedBLOBStream.InternalSeek(NewPosition: Int64): Int64;
begin
 if (FCompressionAlgorithm = acaNone) then
  begin
   FCompressedStream.Position := FStartPosition + NewPosition;
   Result := FCompressedStream.Position - FStartPosition;
   FPosition := Result;
  end // no compression
 else
  begin
   // compression
   FPosition := NewPosition;
   if (FPosition <= 0) then
    begin
     FPosition := 0;
     FCurrentHeader := 0;
    end
   else
    begin
     if (FUncompressedSize = 0) then
      FCurrentHeader := 0
     else
      FCurrentHeader := FHeaders.FindPosition(FPosition);
    end;
   Result := FPosition;
  end; // compression
end; // InternalSeek


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.SetSize(NewSize: Longint);
begin
 InternalSetSize(NewSize);
end; // SetSize


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
{$IFDEF D6H}
procedure TABSCompressedBLOBStream.SetSize(const NewSize: Int64);
begin
 InternalSetSize(NewSize);
end; // SetSize
{$ENDIF}


//------------------------------------------------------------------------------
// gets compressed size
//------------------------------------------------------------------------------
function TABSCompressedBLOBStream.GetCompressedSize: Int64;
begin
 Result := FCompressedStream.Size;
end; // GetCompressedSize


//------------------------------------------------------------------------------
// returns compression rate (100.0 if there is no compression)
//------------------------------------------------------------------------------
function TABSCompressedBLOBStream.GetCompressionRate: Double;
begin
 CalculateRate;
 Result := FCompressionRate;
end; // GetCompressionRate


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TABSCompressedBLOBStream.Create(
						           Stream:                TStream;
                       BLOBDescriptor:        TABSBLOBDescriptor;
                       ToCreate:              Boolean = false;
                       ToRepair:              Boolean = false
                      );
begin
 FCompressedStream := Stream;
 FHeaders := nil;
 FRepair := ToRepair;
 FBLOBDescriptor := BLOBDescriptor;
 FCompressionAlgorithm := TABSCompressionAlgorithm(
    FBLOBDescriptor.CompressionAlgorithm);
 FCompressionMode := FBLOBDescriptor.CompressionMode;
 FCompressedStream.Position := FBLOBDescriptor.StartPosition;
 if (FCompressedStream.Position <> FBLOBDescriptor.StartPosition) then
  raise EABSException.Create(10103,ErrorLCannotSetPosition,
    [FBLOBDescriptor.StartPosition,FCompressedStream.Position,
    FCompressedStream.Size]);
 FBlockSize := BLOBDescriptor.BlockSize;
 FStartPosition := BLOBDescriptor.StartPosition;
 if (FCompressionAlgorithm = acaNone) then
  begin
   // no compression
   // try to set start position in source "compressed" stream
   if (FCompressedStream.Position <> FBLOBDescriptor.StartPosition) then
    raise EABSException.Create(10079,ErrorLCannotSetPosition,
      [FBLOBDescriptor.StartPosition,FCompressedStream.Position,
       FCompressedStream.Size]);
   // default block size
   if (ToCreate) then
    begin
     // create new stream
     FCompressedSize := 0;
     FUncompressedSize := 0;
    end
   else
    begin
     // open existing stream
     FUncompressedSize := FBLOBDescriptor.UncompressedSize;
     FCompressedSize := FUncompressedSize;
     // check if stream size is too small
     if (not FRepair) then
      if (FCompressedStream.Size - FCompressedStream.Position <