Componentes.Terceros.RemObjects/official/5.0.35.741/RemObjects SDK for Delphi/Source/uROServerMultiMessage.pas

unit uROServerMultiMessage;

{$I RemObjects.inc}
interface
uses
  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
    procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
    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;
    FDefaultMessageIndex: integer;
    FNeedInitializeRead:boolean;
    fTransport: IROTransport;
    procedure DetectMessageFromStream(aStream: TStream);
    procedure SetSupportedMessages(const Value: TROServerMultiMessageCollection);
    function InternalIsValidMessage(aData: PAnsiChar; aLength: Integer): integer;
    procedure SetDefaultMessageIndex(const Value: integer);
    function intGetDefaultMessage:TROMessage;
    function GetSupportedMessages: TROServerMultiMessageCollection;
  protected
    function GetClientID : TGUID; override;
    procedure SetClientID(const Value : TGUID); override;
    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;
    procedure InitializeRead(const aTransport: IROTransport); override;
  public
    destructor Destroy; override;
    procedure Assign(iSource: TPersistent); override;
    procedure CheckProperties; override;
    function IsValidMessage(aData: PAnsiChar; aLength: Integer): boolean; override;
  published
    property SupportedMessages: TROServerMultiMessageCollection read GetSupportedMessages write SetSupportedMessages;
    property DefaultMessageIndex: integer read FDefaultMessageIndex write SetDefaultMessageIndex default -1;
  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;
    Self.DefaultMessageIndex := (iSource as TROServerMultiMessage).DefaultMessageIndex;
  end;
end;

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

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

function TROServerMultiMessage.DefaultMessage: IROMessage;
begin
  CheckProperties;
  Result := intGetDefaultMessage;
  if FNeedInitializeRead then begin
    Result.InitializeRead(fTransport);
    fTransport:=nil;
    FNeedInitializeRead:= False;
  end;
end;

destructor TROServerMultiMessage.Destroy;
begin
  FSupportedMessages.Free;
  inherited;
end;

procedure TROServerMultiMessage.DetectMessageFromStream(aStream: TStream);
const
  BufSize = 100;
var
  i: integer;
  buf: PAnsichar;
  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(AnsiString(Buf),1,6) = AnsiString('rorock') then RaiseInvalidStreamError(err_InvalidHeaderEncrypted, [], aStream);
    i := InternalIsValidMessage(buf, currentBufSize);
    if i <> -1 then FDefaultMessage := SupportedMessages[i].Message;
    Check(intGetDefaultMessage = nil, Name + '. Can not find the valid Message for stream.' + sLineBreak +{$IFDEF UNICODE}AnsiStringToWideString{$ENDIF}(Ansistring(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.GetClientID: TGUID;
var
  lMessage: TROMessage;
begin
  lMessage := intGetDefaultMessage;
  if lMessage <> nil then
    Result := lMessage.ClientID
  else
    Result := inherited GetClientID;
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;

function TROServerMultiMessage.GetSupportedMessages: TROServerMultiMessageCollection;
begin
  if FSupportedMessages = nil then FSupportedMessages := TROServerMultiMessageCollection.Create(Self);
  Result := FSupportedMessages;
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.InitializeRead(
  const aTransport: IROTransport);
begin
  inherited;
  FNeedInitializeRead:=True;
  fTransport := aTransport;
end;

procedure TROServerMultiMessage.InitObject;
begin
  inherited;
  FDefaultMessageIndex := -1;
  FNeedInitializeRead:=False;
  fTransport := nil;
end;

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

function TROServerMultiMessage.intGetDefaultMessage: TROMessage;
begin
  Result := FDefaultMessage;
  if (Result = nil) and (FDefaultMessageIndex >=0) and (FDefaultMessageIndex < SupportedMessages.Count) then
    Result := SupportedMessages[FDefaultMessageIndex].Message;
end;

function TROServerMultiMessage.IsValidMessage(aData: PAnsiChar;
  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 (SupportedMessages.Count > 0) then begin
      Item := SupportedMessages.FindItemByMessage(AComponent as TROMessage);
      if Item <> nil then Item.Message := nil;
    end;
  end
end;

function TROServerMultiMessage.QueryInterface(const IID: TGUID;
  out Obj): HResult;
var
  lMessage: TROMessage;
begin
  Result := inherited QueryInterface(IID, Obj);
  if Result = E_NOINTERFACE then begin
    lMessage:= intGetDefaultMessage;
    if lMessage <> nil then Result := (lMessage as IROMessage).QueryInterface(IID, Obj);
  end;
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);
var
  lMessage: IROMessage;
begin
  inherited;
  DetectMessageFromStream(aStream);
  lMessage := DefaultMessage;
  lMessage.ReadFromStream(aStream);
  InterfaceName := lMessage.InterfaceName;
  MessageName := lMessage.MessageName;
end;

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

procedure TROServerMultiMessage.SetClientID(const Value: TGUID);
var
  lMessage: TROMessage;
begin
  lMessage:= intGetDefaultMessage;
  if lMessage <> nil then
    lMessage.ClientID := Value
  else
    inherited SetClientID(Value);
end;

procedure TROServerMultiMessage.SetDefaultMessageIndex(
  const Value: integer);
begin
  if Value >= SupportedMessages.Count then raise Exception.Create(err_IndexOutOfBounds);
  FDefaultMessageIndex := Value;
end;

procedure TROServerMultiMessage.SetSupportedMessages(
  const Value: TROServerMultiMessageCollection);
begin
  SupportedMessages.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;

procedure TROServerMultiMessageCollection.Notify(Item: TCollectionItem;
  Action: TCollectionNotification);
begin
  inherited;
  if (Action = cnDeleting) and (FOwner <> nil) and (FOwner.FDefaultMessageIndex >= Count) then
    FOwner.FDefaultMessageIndex:= Count-1;
end;

end.