david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
626 lines
20 KiB
ObjectPascal
626 lines
20 KiB
ObjectPascal
unit uROBinMessage;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF REMOBJECTS_TRIAL}uROTrial, {$ENDIF}
|
|
Classes, SysUtils, TypInfo,
|
|
uROSerializer, uROClient, uROClientIntf;
|
|
|
|
type
|
|
TBinMessageSignature = array[0..4] of char;
|
|
|
|
const
|
|
BinSignature: TBinMessageSignature = 'RO107';
|
|
EncryptedBinSignature: TBinMessageSignature = 'roroc';
|
|
|
|
BIN_HEADER_SIZE = $1c;
|
|
|
|
{ Misc }
|
|
{
|
|
// Header BINARY LAYOUT: $1C bytes
|
|
//
|
|
// Keep in sync with
|
|
// - Delphi - uROBINMessage.pas
|
|
// - C# - BinMessage.cs
|
|
//
|
|
// 52 4f 31 30 = "RO10" basic RO signature for RO 1.0
|
|
// XX YY ZZ -- = XX: subversion (currenly "7")
|
|
// YY: option flags: 01 = compressed
|
|
// ZZ: message type as defined in uROClientIntf
|
|
// --: reserved for future use
|
|
// -- -- UU UU = UU: user data (word)
|
|
// CC CC CC CC $10 bytes ClientID (guid)
|
|
// CC CC CC CC
|
|
// CC CC CC CC
|
|
// CC CC CC CC
|
|
}
|
|
|
|
type
|
|
TBinHeaderArray = array[0..BIN_HEADER_SIZE - 1] of byte;
|
|
TBinMessageType = Byte;
|
|
|
|
type
|
|
TBinHeader = class
|
|
private
|
|
fHeader: TBinHeaderArray;
|
|
function GetCompressed: boolean;
|
|
procedure SetCompressed(const Value: boolean);
|
|
function GetSignatureValid: boolean;
|
|
function GetSignatureIsEncrypted: boolean;
|
|
function GetMessageType: TBinMessageType;
|
|
procedure SetMessageType(const Value: TBinMessageType);
|
|
function GetUserData: Word;
|
|
procedure SetUserData(const Value: Word);
|
|
function GetClientID: TGUID;
|
|
procedure SetClientID(const Value: TGUID);
|
|
|
|
public
|
|
constructor CreateFromStream(iStream: TStream);
|
|
constructor Create;
|
|
procedure WriteToStream(iStream: TStream);
|
|
|
|
{$IFNDEF DELPHI10UP}property Header: TBinHeaderArray read fHeader;{$ENDIF}
|
|
property Compressed: boolean read GetCompressed write SetCompressed;
|
|
property SignatureValid: boolean read GetSignatureValid;
|
|
property SignatureIsEncrypted: boolean read GetSignatureIsEncrypted;
|
|
property MessageType: TBinMessageType read GetMessageType write SetMessageType;
|
|
property UserData: Word read GetUserData write SetUserData;
|
|
property ClientID: TGUID read GetClientID write SetClientID;
|
|
end;
|
|
|
|
TROCompressionEvent = procedure(OriginalSize, CompressedSize, CompressionTime: integer) of object;
|
|
|
|
{ TROBinMessage }
|
|
|
|
IROBinMessage = interface(IROMessage)
|
|
['{255E6B2C-66BC-4BE3-9C29-459D00221F7E}']
|
|
function GetCompressionBufferSize: integer;
|
|
function GetUseCompression: boolean;
|
|
function GetMinSizeForCompression: integer;
|
|
procedure SetMinSizeForCompression(const Value: integer);
|
|
procedure SetCompressionBufferSize(const Value: integer);
|
|
procedure SetUseCompression(const Value: boolean);
|
|
function GetWasCompressed : boolean;
|
|
|
|
function GetStream: TStream;
|
|
|
|
property UseCompression: boolean read GetUseCompression write SetUseCompression;
|
|
property MinSizeForCompression: integer read GetMinSizeForCompression write SetMinSizeForCompression;
|
|
property CompressionBufferSize: integer read GetCompressionBufferSize write SetCompressionBufferSize;
|
|
property Stream: TStream read GetStream;
|
|
property WasCompressed : boolean read GetWasCompressed;
|
|
end;
|
|
|
|
TROBinMessage = class(TROMessage, IROBinMessage, IROStreamAccess)
|
|
private
|
|
fStream: TStream;
|
|
fUseCompression: boolean;
|
|
fDestroyStream: boolean;
|
|
fWasCompressed: boolean;
|
|
fOnCompress: TROCompressionEvent;
|
|
fOnDecompress: TROCompressionEvent;
|
|
fCompressionBufferSize: integer;
|
|
fType: TMessageType;
|
|
fMinSizeForCompression: integer;
|
|
function GetMinSizeForCompression: integer;
|
|
procedure SetMinSizeForCompression(const Value: integer);
|
|
|
|
procedure WriteStream(aMessageType: TBinMessageType; Source, Destination: TStream);
|
|
|
|
function GetCompressionBufferSize: integer;
|
|
function GetUseCompression: boolean;
|
|
procedure SetCompressionBufferSize(const Value: integer);
|
|
procedure SetUseCompression(const Value: boolean);
|
|
function GetWasCompressed : boolean;
|
|
|
|
protected
|
|
{ Internals }
|
|
function ReadException: Exception; override;
|
|
procedure WriteException(aStream: TStream; anException: Exception); override;
|
|
|
|
function CreateSerializer: TROSerializer; override;
|
|
|
|
{ IROMessage }
|
|
procedure Initialize(const aTransport: IROTransport; const anInterfaceName, aMessageName: string; aType: TMessageType); override;
|
|
|
|
|
|
procedure WriteToStream(aStream: TStream); override;
|
|
procedure IntReadFromStream(aStream: TStream; CopyStream: Boolean);
|
|
|
|
procedure ReadFromStream(aStream: TStream); overload; override;
|
|
procedure ReadFromStream(aStream: TStream; var aFreeStream: Boolean); overload; override;
|
|
|
|
function GetStream: TStream;
|
|
procedure FreeStream; override;
|
|
procedure InitializeExceptionMessage(const aTransport: IROTransport;
|
|
const aLibraryName: String; const anInterfaceName: String;
|
|
const aMessageName: String); override;
|
|
public
|
|
procedure InitObject; override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Assign(iSource: TPersistent); override;
|
|
|
|
property Stream: TStream read FStream;
|
|
function IsValidMessage(aData: PChar; aLength: Integer): boolean; override;
|
|
published
|
|
property UseCompression: boolean read GetUseCompression write SetUseCompression default true;
|
|
property MinSizeForCompression: integer read GetMinSizeForCompression write SetMinSizeForCompression default 4096;
|
|
property CompressionBufferSize: integer read GetCompressionBufferSize write SetCompressionBufferSize default 256 * 1024;
|
|
property OnCompress: TROCompressionEvent read fOnCompress write fOnCompress;
|
|
property OnDecompress: TROCompressionEvent read fOnDecompress write fOnDecompress;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}Windows, {$ENDIF MSWINDOWS}
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE}eDebugServer, {$ENDIF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
uROStreamSerializer,
|
|
uRORes, uROCompression, uROHTTPTools, uROClasses,
|
|
uROTypes, uROBinaryHelpers, uROZLib;
|
|
|
|
{ TROBinMessage }
|
|
|
|
destructor TROBinMessage.Destroy;
|
|
begin
|
|
if fDestroyStream then FreeAndNIL(fStream);
|
|
inherited;
|
|
end;
|
|
|
|
function TROBinMessage.CreateSerializer: TROSerializer;
|
|
begin
|
|
result := TROStreamSerializer.Create(nil);
|
|
end;
|
|
|
|
procedure TROBinMessage.Initialize(const aTransport: IROTransport; const anInterfaceName, aMessageName: string; aType: TMessageType);
|
|
begin
|
|
inherited;
|
|
|
|
SetHTTPInfo(aTransport, DataFormatBinary);
|
|
|
|
if fDestroyStream then FreeAndNIL(fStream);
|
|
fStream := TMemoryStream.Create;
|
|
fDestroyStream := TRUE;
|
|
|
|
(Serializer as TROStreamSerializer).SetStorageRef(fStream); // Very important!
|
|
|
|
MessageName := aMessageName;
|
|
InterfaceName := anInterfaceName;
|
|
fType := aType;
|
|
|
|
Stream_WriteStringWithLength(fStream, InterfaceName);
|
|
Stream_WriteStringWithLength(fStream, MessageName);
|
|
end;
|
|
|
|
procedure TROBinMessage.IntReadFromStream(aStream: TStream; CopyStream: Boolean);
|
|
var //sze : integer;
|
|
//s : string;
|
|
lHeader: TBinHeader;
|
|
lPos: Int64;
|
|
{$IFDEF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
start: Integer;
|
|
PerformanceFrequency,
|
|
PerformanceCounter: Int64;
|
|
{$ENDIF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
begin
|
|
inherited;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
DebugServer.EnterMethod('TROBinMessage.ReadFromStream(stream=%x; position:$%x)', [integer(pointer(aStream)), aStream.Position]);
|
|
try
|
|
DebugServer.WriteHexDump('Incoming BIN, start of ReadFromStream: ', aStream);
|
|
//aStream.Seek(0,soBeginning);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
|
|
if fDestroyStream then FreeAndNIL(fStream);
|
|
|
|
lHeader := TBinHeader.CreateFromStream(aStream);
|
|
try
|
|
fWasCompressed := lHeader.Compressed;
|
|
SetClientID(lHeader.ClientID);
|
|
|
|
if lHeader.Compressed then begin
|
|
{$IFDEF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
if not QueryPerformanceFrequency(PerformanceFrequency) then RaiseLastOSError;
|
|
if not QueryPerformanceCounter(PerformanceCounter) then RaiseLastOSError;
|
|
start := GetTickCount();
|
|
{$ENDIF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
|
|
fDestroyStream := TRUE;
|
|
fStream := TMemoryStream.Create;
|
|
|
|
ZDecompressStream(aStream, fStream);
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
DebugServer.WriteHexDump('Decompressed BIN message (sans Header): ', fStream);
|
|
//aStream.Seek(0,soBeginning);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
|
|
{$IFDEF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
if not QueryPerformanceCounter(PerformanceCounter) then RaiseLastOSError;
|
|
if Assigned(OnDeCompress) then OnDecompress(fStream.Size, aStream.Size, GetTickCount - start);
|
|
{$ELSE}
|
|
if Assigned(OnDeCompress) then OnDecompress(fStream.Size, aStream.Size, 0);
|
|
{$ENDIF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
|
|
fStream.Position := 0;
|
|
// TROTransportChannel.Dispatch always destroys stream if error.
|
|
if (lHeader.MessageType<>MESSAGE_TYPE_EXCEPTION) then
|
|
if not CopyStream then aStream.Free;
|
|
end
|
|
else begin
|
|
if CopyStream then begin
|
|
fStream := TMemoryStream.Create;
|
|
lPos := aStream.Position;
|
|
aStream.position := 0;
|
|
fStream.CopyFrom(aStream, aStream.Size);
|
|
fStream.Position := lPos;
|
|
end
|
|
else
|
|
fStream := aStream;
|
|
fDestroyStream := true;
|
|
end;
|
|
|
|
(Serializer as TROStreamSerializer).SetStorageRef(fStream); // Very important!
|
|
|
|
case lHeader.MessageType of
|
|
MESSAGE_TYPE_EVENT,
|
|
MESSAGE_TYPE_MESSAGE: begin
|
|
InterfaceName := Stream_ReadStringWithLength(fStream, MAX_ITEM_NAME);
|
|
MessageName := Stream_ReadStringWithLength(fStream, MAX_ITEM_NAME);
|
|
end;
|
|
MESSAGE_TYPE_EXCEPTION: begin
|
|
ProcessException;
|
|
end;
|
|
else // Do what?
|
|
end;
|
|
|
|
finally
|
|
FreeAndNil(lHeader);
|
|
end;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
finally
|
|
DebugServer.ExitMethod('TROBinMessage.ReadFromStream(stream=%x; position:$%x)', [integer(pointer(fStream)), fStream.Position]);
|
|
end;
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
|
|
end;
|
|
|
|
procedure TROBinMessage.WriteToStream(aStream: TStream);
|
|
begin
|
|
if fType = mtEvent then
|
|
WriteStream(MESSAGE_TYPE_EVENT, fStream, aStream)
|
|
else
|
|
WriteStream(MESSAGE_TYPE_MESSAGE, fStream, aStream);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TROBinMessage.ReadException: Exception;
|
|
var
|
|
lExceptionName, lMessage: string;
|
|
begin
|
|
// At this point the stream is already at position 1
|
|
lExceptionName := Stream_ReadStringWithLength(fStream, MAX_ITEM_NAME);
|
|
lMessage := Stream_ReadStringWithLength(fStream, MAX_EXCEPTION_TEXT);
|
|
|
|
result := CreateException(lExceptionName, lMessage);
|
|
|
|
// Reads the other fields which have been properly serialized
|
|
if result.InheritsFrom(EROException) then
|
|
Serializer.Read(name_Exception, result.ClassType.ClassInfo, result);
|
|
|
|
fDestroyStream:=False; // we destroy stream in TROTransportChannel.Dispatch
|
|
end;
|
|
|
|
procedure TROBinMessage.WriteException(aStream: TStream; anException: Exception);
|
|
var typinfo : PTypeInfo;
|
|
begin
|
|
if fDestroyStream then FreeAndNIL(fStream);
|
|
fStream := TMemoryStream.Create;
|
|
fDestroyStream := TRUE;
|
|
|
|
Stream_WriteStringWithLength(fStream, anException.ClassName);
|
|
Stream_WriteStringWithLength(fStream, anException.Message);
|
|
|
|
if (anException is EROException) then begin
|
|
with TROStreamSerializer.Create(fStream) do try
|
|
typinfo := anException.ClassInfo;
|
|
Write(name_Exception, typinfo, anException);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
WriteStream(MESSAGE_TYPE_EXCEPTION, fStream, aStream);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROBinMessage.WriteStream(aMessageType: TBinMessageType; Source, Destination: TStream);
|
|
var
|
|
lHeader: TBinHeader;
|
|
{$IFDEF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
start: Integer;
|
|
PerformanceFrequency,
|
|
PerformanceCounter: Int64;
|
|
{$ENDIF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
begin
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
DebugServer.EnterMethod('TROBinMessage.WriteStream()');
|
|
try
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
|
|
// Writes the header
|
|
lHeader := TBinHeader.Create();
|
|
try
|
|
lHeader.Compressed := UseCompression and (Source.Size >= MinSizeForCompression);
|
|
lHeader.MessageType := aMessageType;
|
|
lHeader.ClientID := GetClientID;
|
|
lHeader.WriteToStream(Destination);
|
|
finally
|
|
FreeAndNil(lHeader);
|
|
end;
|
|
|
|
// Writes the data
|
|
Source.Position := 0;
|
|
if UseCompression and (Source.Size >= MinSizeForCompression) then begin
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
DebugServer.WriteHexDump('Uncompressed BIN: ', Source);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
|
|
{$IFDEF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
if not QueryPerformanceFrequency(PerformanceFrequency) then
|
|
RaiseLastOSError;
|
|
if not QueryPerformanceCounter(PerformanceCounter) then
|
|
RaiseLastOSError;
|
|
start := GetTickCount { + Frac(PerformanceCounter / PerformanceFrequency * MSecsPerSec)};
|
|
{$ENDIF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
|
|
ZCompressStream(Source, Destination);
|
|
|
|
{$IFDEF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
if not QueryPerformanceCounter(PerformanceCounter) then RaiseLastOSError;
|
|
if Assigned(OnCompress) then OnCompress(Source.Size, Destination.Size, GetTickCount - start);
|
|
{$ELSE }
|
|
if Assigned(OnCompress) then OnCompress(Source.Size, Destination.Size, 0);
|
|
{$ENDIF REMOBJECTS_PERFORMANCE_MEASUREMENT}
|
|
end
|
|
else begin
|
|
TMemoryStream(Source).SaveToStream(Destination);
|
|
{ToDo -cOptimization/RO4: The infrastructure could re rearranged so that the message
|
|
could be written to the final stream right away. This would require significant
|
|
changes to proxy and invoker code, among others, so we'll defer to RO4. mh. }
|
|
end;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
DebugServer.WriteHexDump('Outgoing BIN: ', Destination);
|
|
finally
|
|
DebugServer.ExitMethod('TROBinMessage.WriteStream()');
|
|
end;
|
|
//Destination.Seek(0,soBeginning);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE}
|
|
|
|
end;
|
|
|
|
procedure TROBinMessage.InitObject;
|
|
begin
|
|
inherited;
|
|
fUseCompression := true;
|
|
fCompressionBufferSize := 256 * 1024;
|
|
fMinSizeForCompression := 4096;
|
|
end;
|
|
|
|
procedure TROBinMessage.Assign(iSource: TPersistent);
|
|
var
|
|
lSource: TROBinMessage;
|
|
begin
|
|
inherited;
|
|
if Assigned(iSource) then begin
|
|
if not (iSource is TROBinMessage) then RaiseError('Cannot Assign a %s t a %s', [ClassName, iSource.ClassName]);
|
|
lSource := TROBinMessage(iSource);
|
|
self.UseCompression := lSource.UseCompression;
|
|
self.MinSizeForCompression := lSource.MinSizeForCompression;
|
|
self.CompressionBufferSize := lSource.CompressionBufferSize;
|
|
self.OnCompress := lSource.OnCompress;
|
|
self.OnDecompress := lSource.OnDecompress;
|
|
//ToDO -c2.0 -omh: clone the stream to, if one is assigned;
|
|
end;
|
|
end;
|
|
|
|
function TROBinMessage.GetCompressionBufferSize: integer;
|
|
begin
|
|
result := fCompressionBufferSize;
|
|
end;
|
|
|
|
function TROBinMessage.GetMinSizeForCompression: integer;
|
|
begin
|
|
result := fMinSizeForCompression;
|
|
end;
|
|
|
|
function TROBinMessage.GetUseCompression: boolean;
|
|
begin
|
|
result := fUseCompression;
|
|
end;
|
|
|
|
procedure TROBinMessage.SetCompressionBufferSize(const Value: integer);
|
|
begin
|
|
fCompressionBufferSize := Value;
|
|
end;
|
|
|
|
procedure TROBinMessage.SetMinSizeForCompression(const Value: integer);
|
|
begin
|
|
fMinSizeForCompression := Value;
|
|
end;
|
|
|
|
procedure TROBinMessage.SetUseCompression(const Value: boolean);
|
|
begin
|
|
fUseCompression := Value;
|
|
end;
|
|
|
|
function TROBinMessage.GetStream: TStream;
|
|
begin
|
|
result := fStream;
|
|
end;
|
|
|
|
function TROBinMessage.GetWasCompressed: boolean;
|
|
begin
|
|
result := fWasCompressed;
|
|
end;
|
|
|
|
procedure TROBinMessage.ReadFromStream(aStream: TStream);
|
|
begin
|
|
inherited;
|
|
IntReadFromStream(aStream, true);
|
|
end;
|
|
|
|
procedure TROBinMessage.ReadFromStream(aStream: TStream;
|
|
var aFreeStream: Boolean);
|
|
begin
|
|
inherited ReadFromStream(aStream);
|
|
aFreeStream := False; // set to false BEFORE the call; as the following might raise exceptions
|
|
IntReadFromStream(aStream, false);
|
|
end;
|
|
|
|
procedure TROBinMessage.FreeStream;
|
|
begin
|
|
inherited;
|
|
if fDestroyStream then FreeAndNil(FStream);
|
|
end;
|
|
|
|
procedure TROBinMessage.InitializeExceptionMessage(
|
|
const aTransport: IROTransport; const aLibraryName, anInterfaceName,
|
|
aMessageName: String);
|
|
begin
|
|
inherited;
|
|
SetHTTPInfo(aTransport, DataFormatBinary);
|
|
end;
|
|
|
|
function TROBinMessage.IsValidMessage(aData: PChar; aLength: Integer): boolean;
|
|
begin
|
|
Result := (aLength >= Sizeof(TBinMessageSignature)) and
|
|
((StrLComp(aData, Pchar(@BinSignature),SizeOf(TBinMessageSignature))=0) or
|
|
(StrLComp(aData, Pchar(@EncryptedBinSignature),SizeOf(TBinMessageSignature))=0));
|
|
end;
|
|
|
|
{ TBinHeader }
|
|
|
|
const
|
|
OFFSET_MESSAGE_FLAGS = $05; { offset of Flags field in header }
|
|
OFFSET_MESSAGE_TYPE = $06; { offset of Type field in header }
|
|
OFFSET_USER_DATA = $0a; { offset of UserData field in header }
|
|
OFFSET_CLIENTID = $0c; { offset of ClientID GUID }
|
|
|
|
BINMESSAGE_FLAG_COMPRESSED = $01;
|
|
|
|
constructor TBinHeader.Create;
|
|
begin
|
|
inherited Create();
|
|
|
|
fHeader[0] := Ord(BINSignature[0]);
|
|
fHeader[1] := Ord(BINSignature[1]);
|
|
fHeader[2] := Ord(BINSignature[2]);
|
|
fHeader[3] := Ord(BINSignature[3]);
|
|
fHeader[4] := Ord(BINSignature[4]);
|
|
end;
|
|
|
|
constructor TBinHeader.CreateFromStream(iStream: TStream);
|
|
begin
|
|
inherited Create();
|
|
iStream.ReadBuffer(fHeader, SizeOf(fHeader));
|
|
if not SignatureValid then begin
|
|
if SignatureIsEncrypted then
|
|
RaiseInvalidStreamError(err_InvalidHeaderEncrypted, [], iStream);
|
|
RaiseInvalidStreamError(err_InvalidHeader, [], iStream);
|
|
end;
|
|
end;
|
|
|
|
function TBinHeader.GetMessageType: TBinMessageType;
|
|
begin
|
|
result := TBinMessageType(fHeader[OFFSET_MESSAGE_TYPE]);
|
|
end;
|
|
|
|
procedure TBinHeader.SetMessageType(const Value: TBinMessageType);
|
|
begin
|
|
fHeader[OFFSET_MESSAGE_TYPE] := byte(Value);
|
|
end;
|
|
|
|
function TBinHeader.GetSignatureIsEncrypted: boolean;
|
|
begin
|
|
result := (fHeader[0] = ord(EncryptedBinSignature[0])) and
|
|
(fHeader[1] = ord(EncryptedBinSignature[1])) and
|
|
(fHeader[2] = ord(EncryptedBinSignature[2])) and
|
|
(fHeader[3] = ord(EncryptedBinSignature[3])) and
|
|
(fHeader[4] = ord(EncryptedBinSignature[4]));
|
|
end;
|
|
|
|
function TBinHeader.GetSignatureValid: boolean;
|
|
begin
|
|
result := (fHeader[0] = ord(BINSignature[0])) and
|
|
(fHeader[1] = ord(BINSignature[1])) and
|
|
(fHeader[2] = ord(BINSignature[2])) and
|
|
(fHeader[3] = ord(BINSignature[3])) and
|
|
(fHeader[4] = ord(BINSignature[4]));
|
|
end;
|
|
|
|
function TBinHeader.GetCompressed: boolean;
|
|
begin
|
|
result := fHeader[OFFSET_MESSAGE_FLAGS] and BINMESSAGE_FLAG_COMPRESSED = BINMESSAGE_FLAG_COMPRESSED;
|
|
end;
|
|
|
|
procedure TBinHeader.SetCompressed(const Value: boolean);
|
|
begin
|
|
if Value then
|
|
fHeader[OFFSET_MESSAGE_FLAGS] := fHeader[OFFSET_MESSAGE_FLAGS] or BINMESSAGE_FLAG_COMPRESSED
|
|
else
|
|
fHeader[OFFSET_MESSAGE_FLAGS] := fHeader[OFFSET_MESSAGE_FLAGS] and not BINMESSAGE_FLAG_COMPRESSED;
|
|
end;
|
|
|
|
procedure TBinHeader.WriteToStream(iStream: TStream);
|
|
begin
|
|
iStream.Write(fHeader, SizeOf(fHeader));
|
|
end;
|
|
|
|
function TBinHeader.GetUserData: Word;
|
|
begin
|
|
result := Word((@fHeader[OFFSET_USER_DATA])^);
|
|
end;
|
|
|
|
procedure TBinHeader.SetUserData(const Value: Word);
|
|
begin
|
|
Word((@fHeader[OFFSET_USER_DATA])^) := Value;
|
|
end;
|
|
|
|
function TBinHeader.GetClientID: TGUID;
|
|
begin
|
|
Move(fHeader[OFFSET_CLIENTID], result, SizeOf(TGUID));
|
|
end;
|
|
|
|
procedure TBinHeader.SetClientID(const Value: TGUID);
|
|
begin
|
|
Move(Value, fHeader[OFFSET_CLIENTID], SizeOf(TGUID));
|
|
end;
|
|
|
|
initialization
|
|
RegisterMessageClass(TROBinMessage);
|
|
|
|
end.
|
|
|