abscompression.pas

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

          FUncompressedSize) then
        raise EABSException.Create(10081,ErrorLStreamSizeTooSmall,
          [FCompressedStream.Size,
          (FUncompressedSize + FCompressedStream.Position)]);

    end;
  end // no compression
 else
  // create compressed stream, load headers
  InternalCreate(ToCreate);
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TABSCompressedBLOBStream.Destroy;
begin
 if (FHeaders <> nil) then
  FHeaders.Free;
 FHeaders := nil;
 inherited;
end; // Destroy


//------------------------------------------------------------------------------
// read from compressed stream
//------------------------------------------------------------------------------
function TABSCompressedBLOBStream.Read(var Buffer; Count: Longint): Longint;
var ReadSize:   Int64;
    OutBuf:     PChar;
begin
 if (FCompressionAlgorithm = acaNone) then
  begin
   Result := FCompressedStream.Read(Buffer,Count);
   FPosition := FCompressedStream.Position - FStartPosition;
  end // no compression
 else
  begin
   Result := 0;
   if ((Count > 0) and (FPosition >= 0) and (FPosition < FUncompressedSize)) then
    begin
     FCurrentHeader := FPosition div FBlockSize;
     while ((FPosition < FUncompressedSize) and (Result < Count)) do
      begin
       LoadBlock(FCurrentHeader,OutBuf);
       // read from current position to the end of the block
       ReadSize := FBlockSize -
        ((FPosition + FBlockSize) mod FBlockSize);
       // if we Result + ReadSize exceeds Count read only Count - Result
       if (Result + ReadSize > Count) then
        ReadSize := Count - Result;
       // reading only till EOF
       if (FPosition + ReadSize >= FUncompressedSize) then
        ReadSize := FUncompressedSize - FPosition;
       if (ReadSize <= 0) then
        raise EABSException.Create(10090,
          ErrorLCannotReadFromStreamInvalidReadSize,[ReadSize]);
       // move data from decompressed buffer to Buffer
       Move(PChar(OutBuf + ((FPosition + FBlockSize) mod FBlockSize))^,
        PChar(PChar(@Buffer) + Result)^,ReadSize);
       FreeMem(OutBuf);
       Inc(Result,ReadSize);
       if (Result < Count) then
        Inc(FCurrentHeader);
       Inc(FPosition,ReadSize);
      end; // reading loop
    end; // FPosition < FUncompressedSize
  end; // compression
end; // Read


//------------------------------------------------------------------------------
// write beyond EOF
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.InternalWriteBeyondEOF;
var OldPos: Int64;
begin
 OldPos := FPosition;
 Self.Position := 0;
 Self.SetSize(OldPos);
 Self.Position := OldPos;
 if (Self.Position <> OldPos) then
  raise EABSException.Create(10091,ErrorLCannotSetPosition,
    [OldPos,FPosition,FUncompressedSize]);
 if (FUncompressedSize <> OldPos) then
  raise EABSException.Create(10092,ErrorLInvalidStreamSize,
    [FUncompressedSize,OldPos]);
end; // InternalWriteBeyondEOF


//------------------------------------------------------------------------------
// write block
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.InternalWriteBlock(InBuf: PChar; InSize: Integer);
var OutBuf:         PChar;
    WriteBytes:     Integer;
    OldPos:         Int64;
begin
  PrepareBufferForWriting(InBuf,InSize,OutBuf,
    FHeaders.Items[FCurrentHeader]);
  try
// Commented By Leo Martin - changed from absolute to relative offset
    FHeaders.Items[FCurrentHeader].OffsetToNextHeader :=
//      FHeaders.Positions[FCurrentHeader] +
        sizeof(TABSCompressedStreamBlockHeader) +
        FHeaders.Items[FCurrentHeader].CompressedSize;

    FCompressedStream.Position := FHeaders.Positions[FCurrentHeader];
    if (FCompressedStream.Position <> FHeaders.Positions[FCurrentHeader]) then
     raise EABSException.Create(10099,ErrorLCannotSetPosition,
      [FHeaders.Positions[FCurrentHeader],
        FCompressedStream.Position,FCompressedStream.Size]);

    OldPos := FCompressedStream.Position;
    WriteBytes := FCompressedStream.Write(FHeaders.Items[FCurrentHeader],
      sizeof(TABSCompressedStreamBlockHeader));
    if (WriteBytes <> sizeof(TABSCompressedStreamBlockHeader)) then
     raise EABSException.Create(10100,ErrorLCannotWriteToStream,
      [OldPos,FCompressedStream.Size,sizeof(TABSCompressedStreamBlockHeader),WriteBytes]);

    OldPos := FCompressedStream.Position;
    WriteBytes := FCompressedStream.Write(OutBuf^,
      FHeaders.Items[FCurrentHeader].CompressedSize);
    if (WriteBytes <> FHeaders.Items[FCurrentHeader].CompressedSize) then
     raise EABSException.Create(10101,ErrorLCannotWriteToStream,
      [OldPos,FCompressedStream.Size,FHeaders.Items[FCurrentHeader].CompressedSize,WriteBytes]);
  finally
   if (OutBuf <> nil) then
    FreeMem(OutBuf);
  end;
end; // InternalWriteBlock


//------------------------------------------------------------------------------
// write prepare
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.InternalWritePrepare(Count, Result: Integer);
var
    NumBlocks,NewPos: Int64;
begin
  // calculate start position and current header number for next block
  if (FHeaders.ItemCount = 0) then
   begin
    NewPos := FBLOBDescriptor.StartPosition;
    FCurrentHeader := 0;
   end
  else
   begin
// Commented By Leo Martin - changed from absolute to relative offset
//    NewPos := FHeaders.Items[FCurrentHeader].OffsetToNextHeader;
    NewPos := FHeaders.Positions[FCurrentHeader] +
      FHeaders.Items[FCurrentHeader].OffsetToNextHeader;
    FCurrentHeader := FHeaders.ItemCount;
   end;
  NumBlocks := (Count - Result) div FBlockSize;
  if (((Count - Result) mod FBlockSize) > 0) then
   Inc(NumBlocks);
  FHeaders.SetSize(FHeaders.ItemCount + NumBlocks);
  // set new position
  FCompressedStream.Position := NewPos;
  if (FCompressedStream.Position <> NewPos) then
   raise EABSException.Create(10102,ErrorLCannotSetPosition,
    [NewPos,FCompressedStream.Position,FCompressedStream.Size]);
end; // InternalWritePrepare


//------------------------------------------------------------------------------
// write to compressed stream
//------------------------------------------------------------------------------
function TABSCompressedBLOBStream.Write(const Buffer; Count: Longint): Longint;
var WriteSize:        Integer;
    InBuf,TempBuf:    PChar;
    Offset:           Integer;
begin
 Result := 0;
 if (FCompressionAlgorithm = acaNone) then
  begin
   Result := FCompressedStream.Write(Buffer,Count);
   FUncompressedSize := FCompressedStream.Size - FStartPosition;
   FPosition := FCompressedStream.Position - FStartPosition;
  end // no compression
 else
  if ((Count > 0) and (FPosition >= FUncompressedSize)) then
   begin
    // write beyond end of the file
    if (FPosition > FUncompressedSize) then
      InternalWriteBeyondEOF;
    if (FHeaders.ItemCount > 0) then
     FCurrentHeader := FHeaders.ItemCount-1
    else
     FCurrentHeader := 0;
    Offset := FPosition mod FBlockSize;
    // rewrite last block
    if (Offset > 0) then
     begin
      // load last block
      InBuf := MemoryManager.GetMem(FBlockSize);
      try
        LoadBlock(FCurrentHeader,TempBuf);
        try
         Move(TempBuf^,InBuf^,FHeaders.Items[FCurrentHeader].UncompressedSize);
        finally
         FreeMem(TempBuf);
        end;

        if (Count < (FBlockSize - Offset)) then
         WriteSize := Count
        else
         WriteSize := FBlockSize - Offset;
        Move(PChar(@Buffer)^,PChar(InBuf + Offset)^,WriteSize);
        InternalWriteBlock(InBuf,Offset + WriteSize);
        Inc(Result,WriteSize);
        Inc(FCurrentHeader);
      finally
       MemoryManager.FreeAndNillMem(InBuf);
      end;
     end; // Offset > 0
    InBuf := nil;
    if (Result < Count) then
     begin
      InBuf := MemoryManager.GetMem(FBlockSize);
      if (Offset > 0) and (FCurrentHeader > 0) then
        Dec(FCurrentHeader);
      InternalWritePrepare(Count,Result);
     end; // Result < Count
    try
     while (Result < Count) do
      begin
        if ((Count - Result) < FBlockSize) then
         WriteSize := Count - Result
        else
         WriteSize := FBlockSize;
        Move(PChar(PChar(@Buffer) + Result)^,PChar(InBuf)^,WriteSize);
        FHeaders.Positions[FCurrentHeader] := FCompressedStream.Position;
        InternalWriteBlock(InBuf,WriteSize);
        // write nex block;
        Inc(Result,WriteSize);
        Inc(FCurrentHeader);
      end;
    finally
     if (InBuf <> nil) then
      MemoryManager.FreeAndNillMem(InBuf);
    end;
    Inc(FUncompressedSize,Result);
    Inc(FPosition,Result);
    FBLOBDescriptor.NumBlocks := FHeaders.ItemCount;
   end; // compression
 FBLOBDescriptor.UncompressedSize := FUncompressedSize;
 CalculateRate;
end; // Write


//------------------------------------------------------------------------------
// seek in compressed stream
//------------------------------------------------------------------------------
function TABSCompressedBLOBStream.Seek(Offset: Longint; Origin: Word): Longint;
var NewPosition: Int64;
begin
 NewPosition := FPosition;
 case (Origin) of
  soFromBeginning:
    NewPosition := Offset;
  soFromCurrent:
    NewPosition := Integer(FPosition) + Offset;
  soFromEnd:
    NewPosition := Integer(FUncompressedSize) + Offset;
  end;
 Result := InternalSeek(NewPosition);
end; // Seek


{$IFDEF D6H}
function TABSCompressedBLOBStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var NewPosition: Int64;
begin
 NewPosition := FPosition;
 case (Origin) of
  soBeginning:
    NewPosition := Offset;
  soCurrent:
    NewPosition := Integer(FPosition) + Offset;
  soEnd:
    NewPosition := Integer(FUncompressedSize) + Offset;
  end;
 Result := InternalSeek(NewPosition);
end; // Seek
{$ENDIF}


//------------------------------------------------------------------------------
// compresses buffer
// returns true if successful
// outBuf - pointer to compressed data
// outSize - size of compressed data
//------------------------------------------------------------------------------
function ABSInternalCompressBuffer(
                          CompressionAlgorithm:   TABSCompressionAlgorithm;
                          CompressionMode:        Byte;
                          InBuf:                  PChar;
                          InSize:                 Integer;
                          out OutBuf:             PChar;
                          out OutSize:            Integer
                          ): Boolean;
begin
 Result := false;
 OutSize := 0;
 // empty buffer cannot be compressed
 // none compression is not allowed
 if ((CompressionAlgorithm = acaNone) or (InSize = 0)) then Exit;
 Result := true;
 case CompressionAlgorithm of
{$IFDEF ZLIB}
  acaZLIB:
   begin
    try
     ZLIBCompressBuf(InBuf,InSize,Pointer(Outbuf),Integer(OutSize),CompressionMode);
    except
     Result := false;
    end;
    if (OutSize <= 0) then
     Result := false;
   end
{$ENDIF}
{$IFDEF BZIP}
  {$IFDEF ZLIB}
  ;
  {$ENDIF}
  acaBZIP:
   begin
    try
     bzCompressBuf(InBuf,InSize,Pointer(Outbuf),Integer(OutSize),CompressionMode)
    except
     Result := false;
    end;
    if (OutSize <= 0) then
     Result := false;
   end
{$ENDIF}
{$IFDEF PPMD}
  {$IFDEF ZLIB}
  ;
  {$ELSE}
    {$IFDEF ZLIB}
    ;
    {$ENDIF}
  {$ENDIF}
  acaPPM:
   begin
    try
     // some memory reserve for none-compressible data
     OutSize := InSize + InSize div 20 + 50;
     OutBuf := AllocMem(OutSize);
     OutSize := PPMCompressBuffer(
                InBuf,InSize,OutBuf,
                PPM_MO[CompressionMode],
                PPM_SA[CompressionMode]
                );
    except
     Result := false;
    end;
    if (OutSize <= 0) then
     Result := false;
   end
{$ENDIF}
;
  else
   Result := false;
 end; // case compression ?????????
end; // ABSInternalCompressBuffer;


//------------------------------------------------------------------------------
// decompresse buffer
// Outsize must be set to uncompressed size
// return true if successful
// OutBuf - pointer to compressed data
// OutSize - size of compressed data
//------------------------------------------------------------------------------
function ABSInternalDecompressBuffer(
                          CompressionAlgorithm:   TABSCompressionAlgorithm;
                          InBuf:                  PChar;
                          InSize:                 Integer;
                          out OutBuf:             PChar;
                          out OutSize:            Integer
                          ): Boolean;
be