msgcompression.pas

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

begin 
 InternalSetSize(NewSize); 
end; // SetSize 
 
	
{$IFDEF D6H}
//------------------------------------------------------------------------------ 
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TMsgFileStream.SetSize(const NewSize: Int64);
begin 
 InternalSetSize(NewSize); 
end; // SetSize
{$ENDIF} 
 
 
//------------------------------------------------------------------------------
// read
//------------------------------------------------------------------------------ 
function TMsgFileStream.Read(var Buffer; Count: Longint): Longint; 
begin 
 Result := FileRead(FHandle, Buffer, Count); 
 if (Result = -1) then 
  Result := 0; 
end; // SetSize
 
 
//------------------------------------------------------------------------------ 
// write 
//------------------------------------------------------------------------------ 
function TMsgFileStream.Write(const Buffer; Count: Longint): Longint; 
begin 
 Result := FileWrite(FHandle, Buffer, Count); 
 if (Result = -1) then 
  Result := 0;
end; // SetSize
	
	
//------------------------------------------------------------------------------ 
// seek
//------------------------------------------------------------------------------
function TMsgFileStream.Seek(Offset: Longint; Origin: Word): Longint; 
begin
 Result := FileSeek(FHandle, Offset, Origin);
end; // SetSize 
 
 
{$IFDEF D6H} 
//------------------------------------------------------------------------------ 
// seek 
//------------------------------------------------------------------------------ 
function TMsgFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
 Result := FileSeek(FHandle, Offset, Ord(Origin)); 
end; // Seek
{$ENDIF} 
 
	
//------------------------------------------------------------------------------ 
// Create
//------------------------------------------------------------------------------ 
constructor TMsgFileStream.Create(const FileName: string; Mode: Word); 
begin
 FBlockSize := DefaultFileBlockSize;
 FMode := Mode;
 FFileName := FileName;
 if (Mode = fmCreate) then
  begin
   FHandle := FileCreate(FileName);
   if (FHandle < 0) then
    raise EMsgException.Create(10104,ErrorLCannotCreateFile,[FileName]);
  end
 else
  begin
   FHandle := FileOpen(FileName,Mode);
   if (FHandle < 0) then
    raise EMsgException.Create(10105,ErrorLCannotOpenFile,[FileName,Mode]);
  end;
end; // Create


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




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


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


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


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


//------------------------------------------------------------------------------
// read
//------------------------------------------------------------------------------
function TMsgTemporaryStream.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 TMsgTemporaryStream.Write(const Buffer; Count: Longint): Longint;
begin
 if (FInMemory) then
  begin
    if (FMemoryStream.Size + Int64(Count) <= FMemoryLimit) then
     Result := FMemoryStream.Write(Buffer,Count)
    else
     begin
      FFileName := GetTempFileName;
      FFileStream := TMsgFileStream.Create(FFileName,fmCreate);
      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 TMsgTemporaryStream.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 TMsgTemporaryStream.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 TMsgTemporaryStream.Create;
begin
 FBlockSize := DefaultTemporaryBlockSize;
 FMemoryLimit := DefaultTemporaryLimit;
 FFileName := '';
 FInMemory := True;
 FMemoryStream := TMsgMemoryStream.Create;
 FFileStream := nil;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgTemporaryStream.Destroy;
begin
 if (FMemoryStream <> nil) then
  FMemoryStream.Free;
 if (FFileStream <> nil) then
  begin
   FFileStream.Free;
   SysUtils.DeleteFile(FFileName);
  end;
 inherited;
end; // Destroy


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


//------------------------------------------------------------------------------
// 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;
begin
 Result := false;
 if ((CompressionAlgorithm = acaNone) or (InSize = 0)) then Exit;
 Result := true;
 case CompressionAlgorithm of
{$IFDEF ZLIB}
  acaZLIB:
   begin
    try
     ZLIBDecompressBuf(InBuf,InSize,OutSize,Pointer(Outbuf),Integer(OutSize));
    except
     Result := false;
    end;
    if (OutSize <= 0) then
     Result := false;
   end
{$ENDIF}
{$IFDEF BZIP}
  {$IFDEF ZLIB}
  ;
  {$ENDIF}
  acaBZIP:
   begin
    try
     bzDecompressBuf(InBuf,InSize,OutSize,Pointer(Outbuf),Integer(OutSize));
    except
     Result := false;
    end;
    if (OutSize <= 0) then
     Result := false;
   end
{$ENDIF}
{$IFDEF PPMD}
  {$IFDEF ZLIB}
  ;
  {$ELSE}
    {$IFDEF ZLIB}
    ;
    {$ENDIF}
  {$ENDIF}
  acaPPM:
   begin
    try
     OutBuf := AllocMem(OutSize);
     OutSize := PPMDecompressBuffer(InBuf,InSize,OutBuf);
    except
     Result := false;
    end;
    if (OutSize <= 0) then
     Result := false;
   end
{$ENDIF}
;
  else
   Result := false;
 end; //case compression algorithm
end; // MsgInternalDecompressBuffer;


//------------------------------------------------------------------------------
// CRC32
//------------------------------------------------------------------------------
function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord; assembler;
asm