msgcompression.pas

Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl

unit MsgCompression;

interface

{$I MsgVer.inc}

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

uses
 SysUtils,Classes,
{$IFDEF LINUX}
  Types,
  Libc,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}

// MsgCommunicator units

    {$IFDEF DEBUG_LOG}
     MsgDebug,
    {$ENDIF}

     MsgTypes,
     MsgMemory,
     MsgConst,
     MsgExcept
{$IFDEF ZLIB}
     ,MsgZlib
{$ENDIF}
{$IFDEF BZIP}

  {$IFDEF LINUX}
    ,MsgBzip2
  {$ENDIF}
  {$IFDEF MSWINDOWS}
    ,MsgBzip2D      
  {$ENDIF}
{$ENDIF}
;

type

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

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

 TMsgCompression = packed record
  CompressionAlgorithm: TMsgCompressionAlgorithm1;
  CompressionMode:      TMsgCompressionMode;
  CompressionLevel:     TMsgCompressionLevel;
 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
 TMsgNoCancelProgressEvent = procedure(
                                        Sender:       TObject;
                                        PercentDone:  Double
                             		) of object;


////////////////////////////////////////////////////////////////////////////////
//
// TMsgStream
//
////////////////////////////////////////////////////////////////////////////////


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


////////////////////////////////////////////////////////////////////////////////
//
// TMsgMemoryStream
//
////////////////////////////////////////////////////////////////////////////////


  TMsgMemoryStream = class (TMsgStream)
   private
    FBuffer:        PChar;
    FBufferSize:    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; BufferSize: Integer = -1);
    destructor Destroy; override;
   public
    property Buffer: PChar read FBuffer write FBuffer;
  end; // TMsgStream


////////////////////////////////////////////////////////////////////////////////
//
// TMsgFileStream
//
////////////////////////////////////////////////////////////////////////////////


  TMsgFileStream = class (TMsgStream)
   private
    FHandle:    Integer;
    FFileName:  String;
    FMode:      Word;
   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(const FileName: string; Mode: Word);
    destructor Destroy; override;
   public
    property Handle: Integer read FHandle;
    property FileName: String read FFileName;
    property Mode: Word read FMode;
  end; // TMsgStream


////////////////////////////////////////////////////////////////////////////////
//
// TMsgTemporaryStream
//
////////////////////////////////////////////////////////////////////////////////


  TMsgTemporaryStream = class (TMsgStream)
   private
    FMemoryLimit:        Integer;
    FMemoryStream:       TMsgMemoryStream;
    FFileStream:         TMsgFileStream;
    FFileName:           String;
    FInMemory:           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;
    destructor Destroy; override;
   public
    property FileStream: TMsgFileStream read FFileStream;
    property MemoryStream: TMsgMemoryStream read FMemoryStream;
    property FileName: String read FFileName;
    property InMemory: Boolean read FInMemory;
    property MemoryLimit: Integer read FMemoryLimit write FMemoryLimit;
  end; // TMsgTemporaryStream


 //------------------------------------------------------------------------------
 // compresses buffer
 // returns true if successful
 // outBuf - pointer to compressed data
 // outSize - size of compressed data
 //------------------------------------------------------------------------------
 function MsgInternalCompressBuffer(
                          CompressionAlgorithm:   TMsgCompressionAlgorithm1;
                          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 MsgInternalDecompressBuffer(
                          CompressionAlgorithm:   TMsgCompressionAlgorithm1;
                          InBuf:                  PChar;
                          InSize:                 Integer;
                          out OutBuf:             PChar;
                          var OutSize:            Integer
                          ): Boolean;

 function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord;
 procedure GetDefaultTempFileName;
 function GetTempFileName: String;
 procedure SaveDataToStream(var Data; DataSize: Integer; Stream: TStream; ErrorCode: Integer);
 procedure LoadDataFromStream(var Data; DataSize: Integer; Stream: TStream; ErrorCode: Integer);
 procedure SaveShortStringToStream(var Value: ShortString; Stream: TStream; ErrorCode: Integer);
 procedure LoadShortStringFromStream(var Value: ShortString; Stream: TStream; ErrorCode: Integer);
 procedure SaveStringToStream(var Value: String; Stream: TStream; ErrorCode: Integer);
 procedure LoadStringFromStream(var Value: String; Stream: TStream; ErrorCode: Integer);
 procedure SaveWideStringToStream(var Value: WideString; Stream: TStream; ErrorCode: Integer);
 procedure LoadWideStringFromStream(var Value: WideString; Stream: TStream; ErrorCode: Integer);
 procedure SaveBooleanToStream(var Value: Boolean; Stream: TStream; ErrorCode: Integer);
 procedure LoadBooleanFromStream(var Value: Boolean; Stream: TStream; ErrorCode: Integer);
{
 procedure SaveCryptoParamsToStream(var CryptoParams: TMsgCryptoParams; Stream: TStream; ErrorCode: Integer; DoNotSaveKeyAndPassword: Boolean = false);
 procedure LoadCryptoParamsFromStream(var CryptoParams: TMsgCryptoParams; Stream: TStream; ErrorCode: Integer; DoNotSaveKeyAndPassword: Boolean = false);
}
 procedure SetStreamPosition(Stream: TStream; NewPosition: Int64; ErrorCode: Integer);

 function GeTMsgCompressionAlgorithm(Name: String): TMsgCompressionAlgorithm1;

implementation

{$IFDEF PPMD}
 {$IFDEF LINUX}
const ppmso = 'libppmd.so.1.0.0';

function PPMCompressBuffer(inBuf  : pChar;
                           inSize : Cardinal;
                           outBuf : pChar;
										       Max_Order:integer;
                           SASize:integer
                          ) : Cardinal;
                          cdecl; external ppmso name 'PPMCompressBuffer__FPcUiT0ii';

function PPMDecompressBuffer(
                            inBuf  : pChar;
                            inSize : Cardinal;
                            outBuf : pChar
                            ) : Cardinal;
                            cdecl; external ppmso name 'PPMDecompressBuffer__FPcUiT0';
 {$ENDIF}
 {$IFDEF MSWINDOWS}
{$L ppmd.OBJ}
function PPMCompressBuffer(inBuf  : pChar;
                           inSize : Integer;
                           outBuf : pChar;
										       Max_Order:integer = 6;
                           SASize:integer = 10
                          ) : Integer; external;

function PPMDecompressBuffer(
                            inBuf  : pChar;
                            inSize : Integer;
                            outBuf : pChar
                            ) : Integer; external;
 {$ENDIF}
{$ENDIF}

procedure memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
  FillChar(P^, count, B);
end;

procedure memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
  Move(source^, dest^, count);
end;


function aa_malloc(count : integer) : pChar;cdecl;
begin
 result := AllocMem(count);
end;

procedure aa_free(buffer : pChar);cdecl;
begin
 FreeMem(buffer);
end;


////////////////////////////////////////////////////////////////////////////////
//
// TMsgStream
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// on progress
//------------------------------------------------------------------------------
procedure TMsgStream.DoOnProgress(Progress: Double);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self,Progress);
end; // on progress


//------------------------------------------------------------------------------