msgcompression.pas

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

// lock
//------------------------------------------------------------------------------
procedure TMsgStream.Lock;
begin
 EnterCriticalSection(FCSect);
end; // Lock


//------------------------------------------------------------------------------
// unlock
//------------------------------------------------------------------------------
procedure TMsgStream.Unlock;
begin
  LeaveCriticalSection(FCSect);
end; // Unlock


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgStream.Create;
begin
 FBlockSize := DefaultMemoryBlockSize;
 FModified := False;
end; // Create


//------------------------------------------------------------------------------
// save all data to another stream
//------------------------------------------------------------------------------
procedure TMsgStream.SaveToStream(Stream: TStream);
var OutBytes,OldPos,OldPos1,InSize:	Int64;
    OutSize:					              Integer;
    Buf:            	              PChar;
    FProgress:      	              Extended;
    FProgressMax:   	              Extended;
    ReadBytes,WriteBytes:           Integer;
    Pos:                            Int64;
begin
 if (FBlockSize = 0) then
  raise EMsgException.Create(10418,ErrorLZeroBlockSizeIsNotAllowed);
 OldPos := Position;
 OldPos1 := Stream.Position;
 Position := 0;
 OutBytes := 0;
 DoOnProgress(0);
 InSize := Size;
 Buf := AllocMem(FBlockSize);
 while OutBytes < InSize do
  begin
   if (InSize - OutBytes > FBlockSize) then
    OutSize := FBlockSize
   else
    OutSize := Size - OutBytes;

   Pos := Self.Position;
   ReadBytes := Self.Read(Buf^,OutSize);
   if (ReadBytes <> OutSize) then
    raise EMsgException.Create(10146,ErrorLCannotReadFromStream,
      [Pos,Self.Size,OutSize,ReadBytes]);

   Pos := Stream.Position;
   WriteBytes := Stream.Write(Buf^,OutSize);
   if (WriteBytes <> OutSize) then
    raise EMsgException.Create(10147,ErrorLCannotWriteToStream,
      [Pos,Stream.Size,OutSize,WriteBytes]);

   Inc(OutBytes,OutSize);
   FProgressMax := Size;
   FProgress := OutBytes;
   DoOnProgress(FProgress/FProgressMax*100.0);
  end;
 FreeMem(Buf);
 Position := OldPos;
 Stream.Position := OldPos1;
 DoOnProgress(100.0);
end; // SaveToStream


//------------------------------------------------------------------------------
// load all data from another stream
//------------------------------------------------------------------------------
procedure TMsgStream.LoadFromStream(Stream: TStream);
begin
 LoadFromStreamWithPosition(Stream,0,Stream.Size);
end; // LoadFromStream


//------------------------------------------------------------------------------
// load from stream
//------------------------------------------------------------------------------
procedure TMsgStream.LoadFromStreamWithPosition(
                    Stream:       TStream;
                    FromPosition: Int64;
                    StreamSize:   Int64
                    );
var OldPos,OldPos1:	                Int64;
    OutSize:					              Integer;
    Buf:            	              PChar;
    FProgress:      	              Extended;
    FProgressMax:   	              Extended;
    ReadBytes,WriteBytes:           Integer;
    Pos:                            Int64;
begin
 if (FBlockSize = 0) then
  raise EMsgException.Create(10419,ErrorLZeroBlockSizeIsNotAllowed);
 OldPos := Position;
 OldPos1 := Stream.Position;
 Stream.Position := FromPosition;
 Size := 0;
 Position := 0;
 DoOnProgress(0);
 Buf := AllocMem(FBlockSize);
 while (Stream.Position < FromPosition + StreamSize) do
  begin
   if ((FromPosition + StreamSize) - Stream.Position > FBlockSize) then
    OutSize := FBlockSize
   else
    OutSize := (FromPosition + StreamSize) - Stream.Position;

   Pos := Stream.Position;
   ReadBytes := Stream.Read(Buf^,OutSize);
   if (ReadBytes <> OutSize) then
    raise EMsgException.Create(10148,ErrorLCannotReadFromStream,
      [Pos,Stream.Size,OutSize,ReadBytes]);

   Pos := Self.Position;
   WriteBytes := Self.Write(Buf^,OutSize);
   if (WriteBytes <> OutSize) then
    raise EMsgException.Create(10149,ErrorLCannotWriteToStream,
      [Pos,Self.Size,OutSize,WriteBytes]);

   FProgressMax := Stream.Size;
   FProgress := Stream.Position;
   DoOnProgress(FProgress/FProgressMax*100.0);
  end;
 FreeMem(buf);
 Position := OldPos;
 Stream.Position := OldPos1;
 DoOnProgress(100.0);
end;


//------------------------------------------------------------------------------
// load all data from file
//------------------------------------------------------------------------------
procedure TMsgStream.LoadFromFile(const FileName: string);
var
  Stream: TMsgStream;
begin
  Stream := TMsgFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end; // LoadFromFile


//------------------------------------------------------------------------------
// save all data to file
//------------------------------------------------------------------------------
procedure TMsgStream.SaveToFile(const FileName: string);
var
  Stream: TMsgStream;
begin
  Stream := TMsgFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end; // SaveToFile


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


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TMsgMemoryStream.InternalSetSize(const NewSize: Int64);
begin
 if (NewSize <= 0) then
  begin
   FBufferSize := 0;
   if (FBuffer <> nil) then
     MemoryManager.FreeAndNilMem(FBuffer);
  end
 else
 if (FBufferSize = 0) then
  begin
   FBuffer := MemoryManager.GetMem(NewSize);
   FBufferSize := NewSize;
  end
 else
  begin
   FBufferSize := NewSize;
   MemoryManager.ReallocMem(FBuffer,FBufferSize);
  end;
 if (FPosition > FBufferSize) then
  FPosition := FBufferSize; 
end; // InternalSetSize


//------------------------------------------------------------------------------
// seek
//------------------------------------------------------------------------------
function TMsgMemoryStream.InternalSeek(NewPosition: Integer): Integer;
begin
 FPosition := NewPosition;
 result := FPosition;
end; // InternalSeek


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


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


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMsgMemoryStream.Read(var Buffer; Count: Longint): Longint;
var NewCount: Integer;
begin
 Result := 0;
 if ((FPosition < FBufferSize) and (Count > 0)) then
  begin
   // count more than size of the buffer minus position
   if (Count > FBufferSize - FPosition) then
    NewCount := FBufferSize - FPosition
   else
    NewCount := Count;
   Move(PChar(FBuffer + FPosition)^,Buffer,NewCount);
   Result := NewCount;
   Inc(FPosition,NewCount);
  end;
end; // Read


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMsgMemoryStream.Write(const Buffer; Count: Longint): Longint;
begin
 if (FBufferSize < FPosition + Count) then
  InternalSetSize(FPosition + Count);
 Result := Count;
 System.Move(Buffer,PChar(FBuffer + FPosition)^,Count);
 Inc(FPosition,Count);
end; // Write


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMsgMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
var NewPosition: Integer;
begin
 NewPosition := FPosition;
 case (Origin) of
  soFromBeginning:
    NewPosition := Offset;
  soFromCurrent:
    NewPosition := Integer(FPosition) + Offset;
  soFromEnd:
    NewPosition := Integer(FBufferSize) + Offset;
 end;
 Result := InternalSeek(NewPosition);
end; // Seek


{$IFDEF D6H}
//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMsgMemoryStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var NewPosition: Integer;
begin
 NewPosition := 0;
 case (Origin) of
  soBeginning:
    NewPosition := Offset;
  soCurrent:
    NewPosition := FPosition + Offset;
  soEnd:
    NewPosition := FBufferSize + Offset;
 end;
 Result := InternalSeek(NewPosition);
end; // Seek
{$ENDIF}


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
constructor TMsgMemoryStream.Create(Buffer: PChar = nil; BufferSize: Integer = -1);
begin
 FBuffer := nil;
 FBufferSize := 0;
 if (Buffer <> nil) then
  begin
   FBuffer := Buffer;
   if BufferSize >= 0 then
     FBufferSize := BufferSize
   else 
     FBufferSize := MemoryManager.GetMemoryBufferSize(Buffer);
  end; 
 FPosition := 0;
 inherited Create; 
end; // Create
	
	
//------------------------------------------------------------------------------
// set size of compressed stream 
//------------------------------------------------------------------------------
destructor TMsgMemoryStream.Destroy;
begin
 InternalSetSize(0); 
 inherited;
end; // Destroy 
 
	
//////////////////////////////////////////////////////////////////////////////// 
// 
// TMsgFileStream 
//
////////////////////////////////////////////////////////////////////////////////
	
 
//------------------------------------------------------------------------------
// sets new size of the stream 
//------------------------------------------------------------------------------ 
procedure TMsgFileStream.InternalSetSize(const NewSize: Int64); 
var OldPos: Int64;
{$IFDEF LINUX}
  SysErrorCode: DWORD; 
{$ENDIF} 
begin
 OldPos := Position;
 Position := NewSize;
{$IFDEF MSWINDOWS}
 Win32Check(SetEndOfFile(FHandle));
{$ENDIF} 
{$IFDEF LINUX} 
 if (lseek64(FHandle, NewSize, SEEK_SET) <> NewSize) then
   begin
     SysErrorCode := GetLastError;
     raise EMsgException.Create(40019, ErrorRCannotSetNewSize,
            [FHandle, Size, NewSize, SysErrorCode, SysErrorMessage(SysErrorCode)]); 
   end; 
 if ftruncate(FHandle, Position) = -1 then 
   begin 
     SysErrorCode := GetLastError; 
     raise EMsgException.Create(40019, ErrorRCannotSetNewSize,
            [FHandle, Size, NewSize, SysErrorCode, SysErrorMessage(SysErrorCode)]);
   end;
{$ENDIF} 
 if (OldPos > NewSize) then
  Position := NewSize
 else 
  Position := OldPos; 
end; // InternalSetSize
 
	
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------ 
procedure TMsgFileStream.SetSize(NewSize: Longint);