unit MYLDBCompression;

interface

{$I MYLDBVer.inc}

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


uses SysUtils,Classes,Windows,

// MYLDBoluteDatabase units

    {$IFDEF DEBUG_LOG}
     MYLDBDebug,
    {$ENDIF}

     MYLDBTypes,
     MYLDBMemory,
     MYLDBConst,
     MYLDBExcept
{$IFDEF ZLIB}
     ,MYLDBZlib
{$ENDIF}
{$IFDEF BZIP}
    ,MYLDBBzip2
{$ENDIF}
;

type

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

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

 TMYLDBCompression = packed record
  CompressionAlgorithm: TMYLDBCompressionAlgorithm;
  CompressionMode:      TMYLDBCompressionMode;
  CompressionLevel:     TMYLDBCompressionLevel;
 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
 TMYLDBNoCancelProgressEvent = procedure(
                                        Sender:       TObject;
                                        PercentDone:  Double
                             		) of object;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBStream
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBStream = class (TStream)
  private
    FCSect:             TRTLCriticalSection;
    FBlockSize:         Integer;
    FOnProgress:        TMYLDBNoCancelProgressEvent; // 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: TMYLDBStream);
    procedure LoadFromStreamWithPosition(
                    Stream:       TMYLDBStream;
                    FromPosition: Int64;
                    StreamSize:   Int64
                    );
    procedure LoadFromStream(Stream: TMYLDBStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
   public
    property BlockSize: Integer read FBlockSize write FBlockSize;
    // Progress Event
    property OnProgress: TMYLDBNoCancelProgressEvent read FOnProgress write FOnProgress;
    property Modified: Boolean read FModified write FModified;
  end; // TMYLDBStream


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBMemoryStream
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBMemoryStream = class (TMYLDBStream)
   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; // TMYLDBStream


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBFileStream
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBFileStream = class (TMYLDBStream)
   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; // TMYLDBStream


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBTemporaryStream
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBTemporaryStream = class (TMYLDBStream)
   private
    FMemoryLimit:        Integer;
    FMemoryStream:       TMYLDBMemoryStream;
    FFileStream:         TMYLDBFileStream;
    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: TMYLDBFileStream read FFileStream;
    property MemoryStream: TMYLDBMemoryStream read FMemoryStream;
    property FileName: String read FFileName;
    property InMemory: Boolean read FInMemory;
    property MemoryLimit: Integer read FMemoryLimit write FMemoryLimit;
  end; // TMYLDBTemporaryStream


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBCompressedBLOBStream
//
////////////////////////////////////////////////////////////////////////////////


  // MYLDBoluteDatabase BLOB stream with optional compression
  // when compression algorithm <> acaNone Write allowed
  // only ot the end of stream
  TMYLDBCompressedBLOBStream = class (TMYLDBStream)
   private
    FRepair:                Boolean;
    FHeaders:               TMYLDBCompressedStreamBlockHeadersArray;
    FUncompressedSize:      Int64;
    FCompressedSize:        Int64;
    FStartPosition:         Int64;
    FCurrentHeader:         Integer;
    FPosition:              Int64;
    FCompressionMode:       TMYLDBCompressionMode;
    FCompressionAlgorithm:  TMYLDBCompressionAlgorithm;
    FCompressionRate:       Double;
    FCompressedStream:      TStream; // internal stream for storing compressed data
    FBLOBDescriptor:        TMYLDBBLOBDescriptor;
   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:   TMYLDBCompressedStreamBlockHeader
                                     );
    // 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:        TMYLDBBLOBDescriptor;
                       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: TMYLDBCompressionAlgorithm read FCompressionAlgorithm;
    // compression mode
    property CompressionMode: Byte read FCompressionMode;
    // compressed size
    property CompressedSize: Int64 read GetCompressedSize;
    property BLOBDescriptor: TMYLDBBLOBDescriptor read FBLOBDescriptor;
  end; // TMYLDBCompressedBLOBStream


 //------------------------------------------------------------------------------
 // compresses buffer
 // returns true if successful
 // outBuf - pointer to compressed data
 // outSize - size of compressed data
 //------------------------------------------------------------------------------
 function MYLDBInternalCompressBuffer(
                          CompressionAlgorithm:   TMYLDBCompressionAlgorithm;
                          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 MYLDBInternalDecompressBuffer(
                          CompressionAlgorithm:   TMYLDBCompressionAlgorithm;
                          InBuf:                  PChar;
                          InSize:                 Integer;