abscompression.pas

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

//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
constructor TABSMemoryStream.Create(Buffer: PChar = nil; DefaultAllocatedSize: Integer = 0);
begin
 FBuffer := nil;
 FBufferSize := 0;
 FAllocatedBufferSize := 0;
 if (Buffer <> nil) then
  begin
   FBuffer := Buffer;
   FBufferSize := MemoryManager.GetMemoryBufferSize(Buffer);
   FAllocatedBufferSize := FBufferSize;
  end
 else
   if (DefaultAllocatedSize <> 0) then
     begin
       FBuffer := MemoryManager.GetMem(DefaultAllocatedSize);
       FAllocatedBufferSize := DefaultAllocatedSize;
     end;
 FPosition := 0;
 inherited Create;
end; // Create


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
destructor TABSMemoryStream.Destroy;
begin
 InternalSetSize(0);
 inherited;
end; // Destroy


////////////////////////////////////////////////////////////////////////////////
//
// TABSFileStream
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// InternalFileCreate
//------------------------------------------------------------------------------
function TABSFileStream.InternalFileCreate(const FileName: string): Integer;
var
  FlagsAndAttributes: DWORD;
begin
  if IsTemporary then
    FlagsAndAttributes := FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE
  else
    FlagsAndAttributes := FILE_ATTRIBUTE_NORMAL;

   //Result := FileCreate(FileName);
  Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
                               0, nil, CREATE_ALWAYS, FlagsAndAttributes,
                               0));
end;//InternalFileCreate

//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSFileStream.InternalSetSize(const NewSize: Int64);
var OldPos: Int64;
begin
 OldPos := Position;
 Position := NewSize;
 Win32Check(SetEndOfFile(FHandle));
 if (OldPos > NewSize) then
  Position := NewSize
 else
  Position := OldPos;
end; // InternalSetSize


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSFileStream.SetSize(NewSize: Longint);
begin
 InternalSetSize(NewSize);
end; // SetSize


{$IFDEF D6H}
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSFileStream.SetSize(const NewSize: Int64);
begin
 InternalSetSize(NewSize);
end; // SetSize
{$ENDIF}


//------------------------------------------------------------------------------
// read
//------------------------------------------------------------------------------
function TABSFileStream.Read(var Buffer; Count: Longint): Longint;
begin
 Result := FileRead(FHandle, Buffer, Count);
 if (Result = -1) then
  Result := 0;
end; // SetSize


//------------------------------------------------------------------------------
// write
//------------------------------------------------------------------------------
function TABSFileStream.Write(const Buffer; Count: Longint): Longint;
begin
 Result := FileWrite(FHandle, Buffer, Count);
 if (Result = -1) then
  Result := 0;
end; // SetSize


//------------------------------------------------------------------------------
// seek
//------------------------------------------------------------------------------
function TABSFileStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
 Result := FileSeek(FHandle, Offset, Origin);
end; // SetSize


{$IFDEF D6H}
//------------------------------------------------------------------------------
// seek
//------------------------------------------------------------------------------
function TABSFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
 Result := FileSeek(FHandle, Offset, Ord(Origin));
end; // Seek
{$ENDIF}


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TABSFileStream.Create(const FileName: string; Mode: Word; IsTemporary: Boolean = False);
begin
 FBlockSize := DefaultFileBlockSize;
 FMode := Mode;
 FFileName := FileName;
 FIsTemporary := IsTemporary; 
 if (Mode = fmCreate) then
  begin
   //FHandle := FileCreate(FileName);
     FHandle := InternalFileCreate(FileName);
   if (FHandle < 0) then
    raise EABSException.Create(10104,ErrorLCannotCreateFile,[FileName]);
  end
 else
  begin
   FHandle := FileOpen(FileName,Mode);
   if (FHandle < 0) then
    raise EABSException.Create(10105,ErrorLCannotOpenFile,[FileName,Mode]);
  end;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TABSFileStream.Destroy;
begin
 if FHandle >= 0 then
  FileClose(FHandle);
 inherited;
end; // Destroy




////////////////////////////////////////////////////////////////////////////////
//
// TABSTemporaryStream
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSTemporaryStream.InternalSetSize(const NewSize: Int64);
begin
 if (FInMemory) then
  FMemoryStream.Size := NewSize
 else
  FFileStream.Size := NewSize;
end; // InternalSetSize


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSTemporaryStream.SetSize(NewSize: Longint);
begin
 InternalSetSize(NewSize);
end; // SetSize


{$IFDEF D6H}
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSTemporaryStream.SetSize(const NewSize: Int64);
begin
 InternalSetSize(NewSize);
end; // SetSize
{$ENDIF}


//------------------------------------------------------------------------------
// read
//------------------------------------------------------------------------------
function TABSTemporaryStream.Read(var Buffer; Count: Longint): Longint;
begin
 if (FInMemory) then
  Result := FMemoryStream.Read(Buffer,Count)
 else
  Result := FFileStream.Read(Buffer,Count);
end; // Read


//------------------------------------------------------------------------------
// write
//------------------------------------------------------------------------------
function TABSTemporaryStream.Write(const Buffer; Count: Longint): Longint;
begin
 if (FInMemory) then
  begin
    if (FDisableTempFiles or (FMemoryStream.Size + Int64(Count) <= FMemoryLimit)) then
     Result := FMemoryStream.Write(Buffer,Count)
    else
     begin
      FFileName := GetTempFileName;
      FFileStream := TABSFileStream.Create(FFileName,fmCreate,True);
      FFileStream.LoadFromStream(FMemoryStream);
      FFileStream.Position := FMemoryStream.Position;
      FMemoryStream.Free;
      FMemoryStream := nil;
      FInMemory := false;
      Result := FFileStream.Write(Buffer,Count);
     end;
  end
 else
  begin
    Result := FFileStream.Write(Buffer,Count);
  end;
end; // Write


//------------------------------------------------------------------------------
// seek
//------------------------------------------------------------------------------
function TABSTemporaryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
 if (FInMemory) then
  Result := FMemoryStream.Seek(Offset,Origin)
 else
  Result := FFileStream.Seek(Offset,Origin);
end; // Seek


{$IFDEF D6H}
//------------------------------------------------------------------------------
// seek
//------------------------------------------------------------------------------
function TABSTemporaryStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
 if (FInMemory) then
  Result := FMemoryStream.Seek(Offset,Origin)
 else
  Result := FFileStream.Seek(Offset,Origin);
end; // Seek
{$ENDIF}


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TABSTemporaryStream.Create(DisableTempFiles: Boolean);
begin
 FDisableTempFiles := DisableTempFiles;
 FBlockSize := DefaultTemporaryBlockSize;
 FMemoryLimit := DefaultTemporaryLimit;
 FFileName := '';
 FInMemory := True;
 FMemoryStream := TABSMemoryStream.Create;
 FFileStream := nil;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TABSTemporaryStream.Destroy;
begin
 if (FMemoryStream <> nil) then
  FMemoryStream.Free;
 if (FFileStream <> nil) then
  FFileStream.Free;
 inherited;
end; // Destroy


////////////////////////////////////////////////////////////////////////////////
//
// TABSCompressedBLOBStream
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// returns block size for creating a compressed blob stream with specified compression level
//------------------------------------------------------------------------------
function TABSCompressedBLOBStream.InternalGetBlockSize(CompressionMode: Byte): Integer;
begin
 if (CompressionMode = 0) then
  Result := DefaultBLOBBlockSize
 else
 if (CompressionMode <= 3) then
  Result := BlockSizeForFastest
 else
 if (CompressionMode <= 6) then
  Result := BlockSizeForNormal
 else
  Result := BlockSizeForMax;
end; // InternalGetBlockSize


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.CalculateRate;
var i: 		Integer;
    f,f1:	Extended;
begin
 FCompressedSize := 0;
 if (FCompressionAlgorithm = acaNone) then
  begin
   FCompressedSize := FUncompressedSize;
   FCompressionRate := 0;
  end
 else
 if (FUncompressedSize <= 0) then
  begin
   FCompressedSize := FUncompressedSize;
   FCompressionRate := 0;
  end
 else
  begin
   for i := 0 to FHeaders.ItemCount-1 do
    Inc(FCompressedSize,FHeaders.Items[i].CompressedSize);
   f1 := FUncompressedSize;
   f := FCompressedSize;
   FCompressionRate := (1 - f / f1) * 100.0;
  end;
end; //CalculateRate


//------------------------------------------------------------------------------
// create
//------------------------------------------------------------------------------
procedure TABSCompressedBLOBStream.InternalCreate(ToCreate: Boolean);
begin
 // compression
 FHeaders := TABSCompressedStreamBlockHeadersArray.Create;
 if (ToCreate) then
  begin
   if (FBLOBDescriptor.BlockSize = 0) then
    FBLOBDescriptor.BlockSize := InternalGetBlockSize(FCompressionMode);
   FBLOBDescriptor.NumBlocks := 0;
  end; // compression
 FBlockSize := FBLOBDescriptor.BlockSize;
 FUncompressedSize := 0;
 FCompressedSize := 0;
 LoadHeaders; // loading headers
 FCurrentHeader := 0;
 FPosition := 0;
end; // InternalCreate