Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uROServerMultiMessage.pas

unit uROServerMultiMessage;

{$I RemObjects.inc}
interface
uses
{$IFDEF REMOBJECTS_TRIAL}uROTrial, {$ENDIF}
  SysUtils, Classes, TypInfo,
  uROClientIntf, uROSerializer, uROClient;

type
  TROServerMultiMessage = class;
  TROServerMultiMessageCollectionItem = class(TCollectionItem)
  private
    FMessage: TROMessage;
    procedure SetMessage(const Value: TROMessage);
  protected
    function GetDisplayName: string; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Message: TROMessage read FMessage write SetMessage;
  end;

  TROServerMultiMessageCollection = class(TCollection)
  private
    FOwner: TROServerMultiMessage;
    function GetItems(Index: integer): TROServerMultiMessageCollectionItem;
  public
    constructor Create(aOwner: TROServerMultiMessage);
    function FindItemByMessage(AMessage: TROMessage): TROServerMultiMessageCollectionItem;
    property Items[Index: integer]: TROServerMultiMessageCollectionItem read GetItems; default;
  end;

  TROServerMultiMessage = class(TROMessage)
  private
    FSupportedMessages: TROServerMultiMessageCollection;
    FDefaultMessage: TROMessage;
    procedure DetectMessageFromStream(aStream: TStream);
    procedure SetSupportedMessages(const Value: TROServerMultiMessageCollection);
    function InternalIsValidMessage(aData: PChar; aLength: Integer): integer;
  protected
    function DefaultMessage: IROMessage;
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    { Internals }
    function ReadException: Exception; override;
    procedure InitObject; override;

    function CreateSerializer: TROSerializer; override;

    { IROMessage }
    procedure Initialize(const aTransport: IROTransport; const anInterfaceName, aMessageName: string; aType: TMessageType); override;
    procedure Initialize(const aTransport: IROTransport; const aLibraryName, anInterfaceName, aMessageName: string; aType: TMessageType); override;
    procedure Finalize; override;

{$IFDEF DOTNET}
{$ELSE}
    procedure Write(const aName: string; aTypeInfo: PTypeInfo; const Ptr; Attributes: TParamAttributes); override;
    procedure Read(const aName: string; aTypeInfo: PTypeInfo; var Ptr; Attributes: TParamAttributes); override;
{$ENDIF}

    procedure WriteToStream(aStream: TStream); override;
    procedure ReadFromStream(aStream: TStream); override;
    procedure ReadFromStream(aStream: TStream; var aFreeStream: Boolean); override;
    function GetMessageType: TMessageType; override;
    procedure WriteException(aStream: TStream; anException: Exception); override;
    procedure FreeStream; override;
  public
    destructor Destroy; override;
    procedure Assign(iSource: TPersistent); override;
    procedure CheckProperties; override;
    function IsValidMessage(aData: PChar; aLength: Integer): boolean; override;
  published
    property SupportedMessages: TROServerMultiMessageCollection read FSupportedMessages write SetSupportedMessages;
  end;

implementation
uses
  uROClasses, uRORes;

{ TROServerMultiMessage }

procedure TROServerMultiMessage.Assign(iSource: TPersistent);
begin
  inherited;
  if Assigned(iSource) then begin
    if not (iSource is TROServerMultiMessage) then RaiseError('Cannot Assign a %s t a %s', [ClassName, iSource.ClassName]);
    self.SupportedMessages := (iSource as TROServerMultiMessage).SupportedMessages;
  end;
end;

procedure TROServerMultiMessage.CheckProperties;
begin
  Check(FDefaultMessage = nil, Name + '. Can not detect default message'); //???
  FDefaultMessage.CheckProperties;
  inherited;
end;

function TROServerMultiMessage.CreateSerializer: TROSerializer;
begin
  Result := nil;
end;

function TROServerMultiMessage.DefaultMessage: IROMessage;
begin
  CheckProperties;
  Result := FDefaultMessage;
end;

destructor TROServerMultiMessage.Destroy;
begin
  inherited;
end;

procedure TROServerMultiMessage.DetectMessageFromStream(aStream: TStream);
const
  BufSize = 100;
var
  i: integer;
  buf: Pchar;
  currentBufSize: int64;
begin
  FDefaultMessage := nil;
  aStream.Position := 0;

  if aStream.Size > bufsize then
    currentBufSize := BufSize
  else
    currentBufSize := aStream.Size;

  GetMem(buf, currentBufSize);
  try
    aStream.Read(buf^, currentBufSize);
    if copy(Buf,1,6) = 'rorock' then RaiseInvalidStreamError(err_InvalidHeaderEncrypted, [], aStream);
    i := InternalIsValidMessage(buf, currentBufSize);
    if i <> -1 then FDefaultMessage := FSupportedMessages[i].Message;
    Check(FDefaultMessage = nil, Name + '. Can not find the valid Message for stream.' + sLineBreak + string(buf));
  finally
    aStream.Position := 0;
    FreeMem(buf);
  end;
end;

procedure TROServerMultiMessage.Finalize;
begin
  DefaultMessage.Finalize;
  inherited;
end;

procedure TROServerMultiMessage.FreeStream;
begin
  DefaultMessage.FreeStream;
  inherited;
end;

function TROServerMultiMessage.GetMessageType: TMessageType;
begin
  Result := DefaultMessage.MessageType;
end;

procedure TROServerMultiMessage.Initialize(const aTransport: IROTransport;
  const anInterfaceName, aMessageName: string; aType: TMessageType);
begin
  inherited Initialize(aTransport, anInterfaceName, aMessageName, aType);
  DefaultMessage.Initialize(aTransport, anInterfaceName, aMessageName, aType);
end;

procedure TROServerMultiMessage.Initialize(const aTransport: IROTransport;
  const aLibraryName, anInterfaceName, aMessageName: string;
  aType: TMessageType);
begin
  inherited Initialize(aTransport, anInterfaceName, aMessageName, aType);
  DefaultMessage.Initialize(aTransport, aLibraryName, anInterfaceName, aMessageName, aType);
end;

procedure TROServerMultiMessage.InitObject;
begin
  inherited;
  FSupportedMessages := TROServerMultiMessageCollection.Create(Self);
end;

function TROServerMultiMessage.InternalIsValidMessage(aData: PChar;
  aLength: Integer): integer;
begin
  for Result := 0 to FSupportedMessages.Count - 1 do
    with FSupportedMessages[Result] do
    if (Message <> nil) and Message.IsValidMessage(aData, aLength) then Exit;
  Result := -1;
end;

function TROServerMultiMessage.IsValidMessage(aData: PChar;
  aLength: Integer): boolean;
begin
  Result := InternalisValidMessage(aData, aLength) <> -1;
end;

procedure TROServerMultiMessage.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  item: TROServerMultiMessageCollectionItem;
begin
  inherited;
  if (Operation = opRemove) then begin
    if (AComponent is TROMessage) and (FSupportedMessages.Count > 0) then begin
      Item := FSupportedMessages.FindItemByMessage(AComponent as TROMessage);
      if Item <> nil then Item.Message := nil;
    end;
  end
end;

function TROServerMultiMessage.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  Result := inherited QueryInterface(IID, Obj);
  if Result = E_NOINTERFACE then
    if FDefaultMessage <> nil then
      Result := DefaultMessage.QueryInterface(IID, Obj);
end;

procedure TROServerMultiMessage.Read(const aName: string;
  aTypeInfo: PTypeInfo; var Ptr; Attributes: TParamAttributes);
begin
  DefaultMessage.Read(aName, aTypeInfo, Ptr, Attributes);
  if Assigned(OnReadMessageParameter) then OnReadMessageParameter(Self, aName, aTypeInfo, pointer(Ptr), Attributes);
end;

function TROServerMultiMessage.ReadException: Exception;
begin
  // not called from ROServerMultiMessage
  Result := nil;
end;

procedure TROServerMultiMessage.ReadFromStream(aStream: TStream);
begin
  inherited;
  DetectMessageFromStream(aStream);
  DefaultMessage.ReadFromStream(aStream);
  InterfaceName := DefaultMessage.InterfaceName;
  MessageName := DefaultMessage.MessageName;
end;

procedure TROServerMultiMessage.ReadFromStream(aStream: TStream;
  var aFreeStream: Boolean);
begin
  inherited;
  DetectMessageFromStream(aStream);
  DefaultMessage.ReadFromStream(aStream, aFreeStream);
  InterfaceName := DefaultMessage.InterfaceName;
  MessageName := DefaultMessage.MessageName;
end;

procedure TROServerMultiMessage.SetSupportedMessages(
  const Value: TROServerMultiMessageCollection);
begin
  FSupportedMessages.Assign(Value);
end;

procedure TROServerMultiMessage.Write(const aName: string;
  aTypeInfo: PTypeInfo; const Ptr; Attributes: TParamAttributes);
begin
  if Assigned(OnWriteMessageParameter) then OnWriteMessageParameter(Self, aName, aTypeInfo, pointer(Ptr), Attributes);
  DefaultMessage.Write(aName, aTypeInfo, Ptr, Attributes);
end;

procedure TROServerMultiMessage.WriteException(aStream: TStream;
  anException: Exception);
begin
  DefaultMessage.WriteException(aStream, anException);
  inherited;
end;

procedure TROServerMultiMessage.WriteToStream(aStream: TStream);
begin
  DefaultMessage.WriteToStream(aStream);
  inherited;
end;

{ TROServerMultiMessageCollectionItem }

procedure TROServerMultiMessageCollectionItem.Assign(Source: TPersistent);
begin
  if Source is TROServerMultiMessageCollectionItem then begin
    Message := TROServerMultiMessageCollectionItem(Source).Message;
  end
  else
    inherited Assign(Source);
end;

function TROServerMultiMessageCollectionItem.GetDisplayName: string;
begin
  if FMessage <> nil then
    Result := FMessage.Name + ' (' + FMessage.ClassName + ')'
  else
    Result := '[Unassigned]';
end;

procedure TROServerMultiMessageCollectionItem.SetMessage(
  const Value: TROMessage);
begin
  if (FMessage <> Value) then begin
    if Value <> nil then Check(Value is TROServerMultiMessage, Value.Name + ' can not be used here.');
    FMessage := Value;
    if (FMessage <> nil) then FMessage.FreeNotification(TROServerMultiMessageCollection(inherited Collection).FOwner);
  end;
end;

{ TROServerMultiMessageCollection }

constructor TROServerMultiMessageCollection.Create(
  aOwner: TROServerMultiMessage);
begin
  inherited Create(TROServerMultiMessageCollectionItem);
  FOwner := aOwner;
end;

function TROServerMultiMessageCollection.FindItemByMessage(
  AMessage: TROMessage): TROServerMultiMessageCollectionItem;
var
  i: integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
    if Items[i].Message = AMessage then begin
      Result := Items[i];
      Break;
    end;
end;

function TROServerMultiMessageCollection.GetItems(
  Index: integer): TROServerMultiMessageCollectionItem;
begin
  Result := TROServerMultiMessageCollectionItem(inherited Items[Index]);
end;

end.