abscompression.pas

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

unit ABSCompression;

interface

{$I ABSVer.inc}

{$DEFINE ZLIB}
{$DEFINE PPMD}
{$DEFINE BZIP}


uses SysUtils,Classes,Windows,

// AbsoluteDatabase units

    {$IFDEF DEBUG_LOG}
     ABSDebug,
    {$ENDIF}

     ABSTypes,
     ABSMemory,
     ABSConst,
     ABSExcept
{$IFDEF ZLIB}
     ,ABSZlib
{$ENDIF}
{$IFDEF BZIP}
    ,ABSBzip2
{$ENDIF}
;

type

 TABSCompressionAlgorithm = (acaNone,acaZLIB,acaBZIP,acaPPM);
 // SQL Names of CompressionAlgorithm
const ABSCompressionAlgorithmNames:array[0..3] of String = ('NONE', 'ZLIB','BZIP','PPM');

type
 TABSCompressionMode = Byte; // 0-9
 TABSCompressionLevel = (aclNone,aclFastest,aclNormal,aclMaximum); // 0,1,5,9

 TABSCompression = packed record
  CompressionAlgorithm: TABSCompressionAlgorithm;
  CompressionMode:      TABSCompressionMode;
  CompressionLevel:     TABSCompressionLevel;
 end;

var
 // block sizes for stream classes, LoadFromStream / SaveToStream
 DefaultTemporaryBlockSize: Integer = 100 * 1024;
 // size of maximum temporary stream that stores in memory
 DefaultTemporaryLimit: Integer = 1024 * 1024;
 DefaultMemoryBlockSize: Integer = 100 * 1024; // for memory stream
 DefaultFileBlockSize: Integer = 100 * 1024; // for memory stream
 DefaultBLOBBlockSize: Integer = 100 * 1024; // for BLOB stream
 BlockSizeForFastest: Integer = 512 * 1024; // 0.5 Mb for fastest modes
 BlockSizeForNormal: Integer = 1024 * 1024; // 1.0 Mb for normal modes
 BlockSizeForMax: Integer = 1536 * 1024; // 1.5 Mb for max modes
 
const

 PPM_MO: array [1..9] of Byte = (2,3,4, 5, 7, 8,10, 13, 16); // Model Order
 PPM_SA: array [1..9] of Byte = (2,3,7,16,22,25,40,100,100); // MBytes RAM

type
 // Events
 TABSNoCancelProgressEvent = procedure(
                                        Sender:       TObject;
                                        PercentDone:  Double
                             		) of object;


////////////////////////////////////////////////////////////////////////////////
//
// TABSStream
//
////////////////////////////////////////////////////////////////////////////////


  TABSStream = class (TStream)
  private
    FCSect:             TRTLCriticalSection;
    FBlockSize:         Integer;
    FOnProgress:        TABSNoCancelProgressEvent; // progress for bulk operations
    FModified:   Boolean;
   protected
    // on progress
    procedure DoOnProgress(Progress: Double);
   public
    // lock
    procedure Lock; virtual;
    // unlock
    procedure Unlock; virtual;
    constructor Create;
    procedure SaveToStream(Stream: TABSStream);
    procedure LoadFromStreamWithPosition(
                    Stream:       TABSStream;
                    FromPosition: Int64;
                    StreamSize:   Int64
                    );
    procedure LoadFromStream(Stream: TABSStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
   public
    property BlockSize: Integer read FBlockSize write FBlockSize;
    // Progress Event
    property OnProgress: TABSNoCancelProgressEvent read FOnProgress write FOnProgress;
    property Modified: Boolean read FModified write FModified;
  end; // TABSStream


////////////////////////////////////////////////////////////////////////////////
//
// TABSMemoryStream
//
////////////////////////////////////////////////////////////////////////////////


  TABSMemoryStream = class (TABSStream)
   private
    FBuffer:        PChar;
    FBufferSize:    Integer;
    FAllocatedBufferSize: Integer;
    FPosition:      Integer;
   protected
    // sets new size of the stream
    procedure InternalSetSize(const NewSize: Int64);
    // seek
    function InternalSeek(NewPosition: Integer): Integer;
    // sets new size of the stream
    procedure SetSize(NewSize: Longint);
    {$IFDEF D6H}
      overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    procedure SetSize(const NewSize: Int64); overload; override;
    {$ENDIF}
   public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint;
    {$IFDEF D6H}
            overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    {$ENDIF}
    constructor Create(Buffer: PChar = nil; DefaultAllocatedSize: Integer = 0);
    destructor Destroy; override;
   public
    property Buffer: PChar read FBuffer;
  end; // TABSStream


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


  TABSFileStream = class (TABSStream)
   private
    FHandle:      Integer;
    FFileName:    String;
    FMode:        Word;
    FIsTemporary: Boolean;
   protected
    function InternalFileCreate(const FileName: string): Integer;
    // sets new size of the stream
    procedure InternalSetSize(const NewSize: Int64);
    // sets new size of the stream
    procedure SetSize(NewSize: Longint);
    {$IFDEF D6H}
      overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    // sets new size of the stream
    procedure SetSize(const NewSize: Int64); overload; override;
    {$ENDIF}
   public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint;
    {$IFDEF D6H}
            overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    {$ENDIF}
    constructor Create(const FileName: string; Mode: Word; IsTemporary: Boolean = False);
    destructor Destroy; override;
   public
    property Handle: Integer read FHandle;
    property FileName: String read FFileName;
    property Mode: Word read FMode;
    property IsTemporary: Boolean read FIsTemporary;
  end; // TABSStream


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


  TABSTemporaryStream = class (TABSStream)
   private
    FMemoryLimit:        Integer;
    FMemoryStream:       TABSMemoryStream;
    FFileStream:         TABSFileStream;
    FFileName:           String;
    FInMemory:           Boolean;
    FDisableTempFiles:   Boolean;
   protected
    // sets new size of the stream
    procedure InternalSetSize(const NewSize: Int64);
    // sets new size of the stream
    procedure SetSize(NewSize: Longint);
    {$IFDEF D6H}
      overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    // sets new size of the stream
    procedure SetSize(const NewSize: Int64); overload; override;
    {$ENDIF}
   public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint;
    {$IFDEF D6H}
            overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    {$ENDIF}
    constructor Create(DisableTempFiles: Boolean);
    destructor Destroy; override;
   public
    property FileStream: TABSFileStream read FFileStream;
    property MemoryStream: TABSMemoryStream read FMemoryStream;
    property FileName: String read FFileName;
    property InMemory: Boolean read FInMemory;
    property MemoryLimit: Integer read FMemoryLimit write FMemoryLimit;
  end; // TABSTemporaryStream


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


  // AbsoluteDatabase BLOB stream with optional compression
  // when compression algorithm <> acaNone Write allowed
  // only ot the end of stream
  TABSCompressedBLOBStream = class (TABSStream)
   private
    FRepair:                Boolean;
    FHeaders:               TABSCompressedStreamBlockHeadersArray;
    FUncompressedSize:      Int64;
    FCompressedSize:        Int64;
    FStartPosition:         Int64;
    FCurrentHeader:         Integer;
    FPosition:              Int64;
    FCompressionMode:       TABSCompressionMode;
    FCompressionAlgorithm:  TABSCompressionAlgorithm;
    FCompressionRate:       Double;
    FCompressedStream:      TStream; // internal stream for storing compressed data
    FBLOBDescriptor:        TABSBLOBDescriptor;
   private
    // returns block size for creating a compressed blob stream with specified compression level
    function InternalGetBlockSize(CompressionMode: Byte): Integer;
    // calculates rate
    procedure CalculateRate;
    // create
    procedure InternalCreate(ToCreate: Boolean);
    // load all headers
    procedure LoadHeaders;
    // prepares buffer for writing (compresses, fills header structure, calculates crc)
    procedure PrepareBufferForWriting(
                                      InBuf:        PChar;
                                      InSize:       Integer;
                                      var OutBuf:   PChar;
                                      var Header:   TABSCompressedStreamBlockHeader
                                     );
    // load block from file, decompress it and checks crc
    procedure LoadBlock(
                        CurHeader:  Int64;
                        var OutBuf: PChar
                       );
    procedure InternalIncreaseSize(NewSize: Int64);
    procedure InternalDecreaseSize(NewSize: Int64);
    procedure InternalSetSize(NewSize: Int64);
    // internal seek
    function InternalSeek(NewPosition: Int64): Int64;
   protected
    // sets new size of the stream
    procedure SetSize(NewSize: Longint);
    {$IFDEF D6H}
      overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    procedure SetSize(const NewSize: Int64); overload; override;
    {$ENDIF}
    // gets compressed size
    function GetCompressedSize: Int64;
    // returns compression rate (100.0 if there is no compression)
    function GetCompressionRate: Double;
   public
    // Create
    constructor Create(
						           Stream:                TStream;
                       BLOBDescriptor:        TABSBLOBDescriptor;
                       ToCreate:              Boolean = false;
                       ToRepair:              Boolean = false
                      );
    // Destroy
    destructor Destroy; override;

    function Read(var Buffer; Count: Longint): Longint; override;
   private
    // write beyond EOF
    procedure InternalWriteBeyondEOF;
    // write block
    procedure InternalWriteBlock(InBuf: PChar; InSize: Integer);
    // write prepare
    procedure InternalWritePrepare(Count, Result: Integer);
   public
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint;
    {$IFDEF D6H}
     overload;
    {$ENDIF}
     override;
    {$IFDEF D6H}
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    {$ENDIF}

   public
    property CompressedStream: TStream read FCompressedStream;
    // compression rate
    property CompressionRate: Double read GetCompressionRate;
    // compression algorithm
    property CompressionAlgorithm: TABSCompressionAlgorithm read FCompressionAlgorithm;
    // compression mode
    property CompressionMode: Byte read FCompressionMode;
    // compressed size
    property CompressedSize: Int64 read GetCompressedSize;
    property BLOBDescriptor: TABSBLOBDescriptor read FBLOBDescriptor;
  end; // TABSCompressedBLOBStream


 //------------------------------------------------------------------------------
 // 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;

 // 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;