unit uROClientIntf;

{----------------------------------------------------------------------------}
{ 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, uRODL, uRORes, uROTypes;

const
  MESSAGE_TYPE_MESSAGE = 0;
  MESSAGE_TYPE_EXCEPTION = 1;
  MESSAGE_TYPE_EVENT = 2;

  MAX_ITEM_NAME = $100; { max name length for interface, function etc. }
  MAX_EXCEPTION_TEXT = $10000; { max exception text }

type
  { Misc }
  TROURIType = (utHTTP, utTCP, utUDP, utPipes, utSMTP, utPOP3);
  TROProbingOption = (poProbeWhenEnabled, poProbeWhenDisabled, poEnableIfProbeSucceeded, poDisableIfProbeFailed);
  TROProbingOptions = set of TROProbingOption;

const
  URITypeIdentifiers : array[TROURIType] of string =
    ('HTTP', 'TCP', 'UDP', 'PIPE', 'SMTP', 'POP3');

type
  TMessageType = (mtRequest,
                  mtResponse,
                  mtException,
                  mtQueryServiceInfo,
                  mtEvent,
                  mtPoll);

  { for Delphi 5 know we can reply on the correct value-assignment 0,1,2 }

  { Forward declarations }
  IROMessage = interface;
  TROServerLocator = class;

  { Misc }

  DateTime = TDateTime; { Alias for the type TDateTime }

  { IROMessage }
  TParamAttribute = (paIsDateTime, paIsArrayElement);
  TParamAttributes = set of TParamAttribute; { Set of TParamAttribute }

  IROTransport = interface;

  { IROMessage }
  IROMessage = interface
  ['{092FB8BE-5FC4-48CB-BB50-623465168B98}']
    procedure Initialize(const aTransport : IROTransport; const anInterfaceName, aMessageName : string; aType: TMessageType); overload;
    procedure Initialize(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string; aType: TMessageType); overload;

    procedure InitializeRequestMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string);
    procedure InitializeResponseMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string);
    procedure InitializeEventMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string);
    procedure InitializeExceptionMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string);

    procedure Finalize;

    function GetClientID : TGUID;
    procedure SetClientID(const Value : TGUID);

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

    function GetInterfaceName : string;
    function GetMessageName : string;
    procedure SetInterfaceName(const aValue : string);
    procedure SetMessageName(const aValue : string);
    procedure WriteToStream(aStream : TStream);
    procedure ReadFromStream(aStream : TStream); overload;
    procedure ReadFromStream(aStream : TStream; var aFreeStream: Boolean); overload;
    procedure WriteException(aStream : TStream; anException : Exception);
    function GetMessageType: TMessageType;

    procedure FreeStream;

    procedure SetAttributes(aTransport: IROTransport; const aNames: array of string; const aValues: array of string);
    procedure UnsetAttributes(aTransport: IROTransport);
    
    procedure InitializeRead(const aTransport : IROTransport);

    property MessageName : string read GetMessageName write SetMessageName;
    property InterfaceName : string read GetInterfaceName write SetInterfaceName;
    property ClientID : TGUID read GetClientID write SetClientID;
    property MessageType : TMessageType read GetMessageType;
    //
    { Writers }
    procedure WriteInteger(const aName : string; anOrdType : TOrdType; const Ref; ArrayElementId : integer = -1);
    procedure WriteInt64(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; const Ref; ArrayElementId : integer = -1);
    procedure WriteUTF8String(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteWideString(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteDateTime(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteDouble(const aName : string; aFloatType : TFloatType; const Ref; ArrayElementId : integer = -1);
    procedure WriteVariant(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteXml(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteGuid(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteDecimal(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteStruct(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteArray(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteBinary(const aName : string; const Ref; ArrayElementId : integer = -1);

    { Readers }
    procedure ReadInteger(const aName : string; anOrdType : TOrdType; var Ref; ArrayElementId : integer = -1);
    procedure ReadInt64(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; var Ref; ArrayElementId : integer = -1);
    procedure ReadUTF8String(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
    procedure ReadWideString(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
    procedure ReadDateTime(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadDouble(const aName : string; aFloatType : TFloatType; var Ref; ArrayElementId : integer = -1);
    procedure ReadVariant(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadXml(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadGuid(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadDecimal(const aName : string; var Ref; ArrayElementId : integer = -1);
    function ReadStruct(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean;
    function ReadArray(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean;
    procedure ReadBinary(const aName : string; var Ref; ArrayElementId : integer = -1);
  end;

  IROMessageCloneable = interface
  ['{4AA33660-25B7-4794-A978-CB791640475D}']
    function Clone:IROMessage;
  end;

  IROStreamAccess = interface
  ['{DF3D000F-7EB3-4981-AA01-921553CAFF52}']
    function GetStream : TStream;

    property Stream : TStream read GetStream;
  end;

  { IROTransport }
  IROTransport = interface
  ['{56FA09B9-FFC8-4432-80E3-BF78E5E7DF33}']
    function GetTransportObject : TObject;
  end;

  { IROTransportChannel }
  IROTransportChannel = interface(IROTransport)
  ['{EDFA0CF3-3265-46C9-AC5C-14C3CACF2721}']
    procedure SetServerLocator(aServerLocator : TROServerLocator; anException : Exception = NIL);
    function Probe(aServerLocator : TROServerLocator) : boolean;
    procedure ProbeAll;

    procedure Dispatch(aRequest, aResponse : TStream); overload;
    procedure Dispatch(aMessage: IROMessage); overload;
    procedure BeforeDispatch(aMessage: IROMessage);
  end;

  { IROMetadataReader }
  IROMetadataReader = interface
  ['{526269B5-FAB2-45A2-A2E6-8CBFF317BC98}']
    procedure RetrieveMetadata(out Metadata : TStream);
    procedure RetrieveRODL(out RODLLibrary : TRODLLibrary);
  end;

  { IROTCPTransport }
  IROTCPTransport = interface(IROTransport)
  ['{C80E773D-B8A8-4E0D-9B49-2668EFC1E27F}']
    function GetClientAddress : string;

    property ClientAddress : string read GetClientAddress;
  end;

  { IROHTTPTransport }
  IROHTTPTransport = interface(IROTCPTransport)
  ['{AD51DB69-993F-49C1-9F3B-4C678A95007D}']
    procedure SetHeaders(const aName, aValue : string);
    function GetHeaders(const aName : string) : string;

    function GetContentType : string;
    procedure SetContentType(const aValue : string);

    function GetUserAgent : string;
    procedure SetUserAgent(const aValue : string);

    function GetTargetURL : string;
    procedure SetTargetURL(const aValue : string);

    procedure SetPathInfo (const aValue : string);
    function GetPathInfo : string;
    function GetQueryString : string;
    function GetLocation : string;

    property ContentType : string read GetContentType write SetContentType;
    property UserAgent : string read GetUserAgent write SetUserAgent;
    property TargetURL : string read GetTargetURL write SetTargetURL;
    property Headers[const aName : string] : string read GetHeaders write SetHeaders;

    property PathInfo : string read GetPathInfo write SetPathInfo;
    property QueryString : string read GetQueryString;

    property Location : string read GetLocation;
  end;

  { IROEventWriter }
  IROEventWriter = interface
  ['{501A01A8-0663-488A-BB29-3C0FBA7F43B5}']
    function GetSessionList: TStrings;
    function GetExcludeSender: boolean;
    function GetExcludeSessionList: boolean;
    procedure SetExcludeSender(const Value: boolean);
    procedure SetExcludeSessionList(const Value: boolean);

    property ExcludeSender : boolean read GetExcludeSender write SetExcludeSender;
    property ExcludeSessionList : boolean read GetExcludeSessionList write SetExcludeSessionList;
    property SessionList : TStrings read GetSessionList;
  end;

  IROEventsWriter = IROEventWriter {$IFDEF DELPHI10UP}deprecated{$ENDIF};

  { IROModuleInfo }
  TDataFormat = string;
  IROModuleInfo = interface
  ['{83ED3A44-DA4B-4F4E-884A-DDF5E726A2C1}']
    procedure GetModuleInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat);
    procedure GetRodlInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat); 
  end;

  IRONamedModuleInfo = interface(IROModuleInfo)
  ['{C7D24186-D600-465C-9B09-4E1E2CF835BE}']
    function ModuleInfoName: string;
  end;

  { TROServerLocator }
  TROServerLocatorNotifyEvent = procedure(Sender : TROServerLocator) of object;
  TROServerLocator = class(TCollectionItem)
  private
    fEnabled: boolean;
    fPort: integer;
    fHost: string;
    fDisableOnFailure: boolean;
    fLoadBalancingServer: boolean;
    fProbingOptions: TROProbingOptions;
    fOnEnabledChanged: TROServerLocatorNotifyEvent;
    fName: string;

    procedure SetHost(const Value: string);
    procedure SetPort(const Value: integer);
    function GetEnabled: boolean;
    procedure SetEnabled(const Value: boolean);

  protected
    function GetDisplayName: string; override;

  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    function GetNamePath: string; override;
    procedure Assign(Source: TPersistent); override;

  published
    property Name : string read fName write fName;
    property Enabled : boolean read GetEnabled write SetEnabled;
    property Host : string read fHost write SetHost;
    property Port : integer read fPort write SetPort;
    property DisableOnFailure : boolean read fDisableOnFailure write fDisableOnFailure;
    property LoadBalancingServer : boolean read fLoadBalancingServer write fLoadBalancingServer;
    property ProbingOptions : TROProbingOptions read fProbingOptions write fProbingOptions;

    property OnEnabledChanged : TROServerLocatorNotifyEvent read fOnEnabledChanged write fOnEnabledChanged;
  end;

  { IROMultiThreadAwareChannel }
  IROMultiThreadAwareChannel = interface
    ['{0C2FD6DE-DEC1-4B1D-851C-F55C36869920}']
  end;

  { TROServerLocatorCollection }
  TROServerLocatorCollection = class(TCollection)
  private
    fOwner : TComponent;

  protected
    function GetItems(aIndex: integer): TROServerLocator;
    procedure SetItems(aIndex: integer; aNewItem: TROServerLocator);
    function GetOwner: TPersistent; override;
  public
    constructor Create(aOwner : TComponent);
    destructor Destroy; override;

    function Add: TROServerLocator;
    function Insert(aIndex: integer): TROServerLocator;
    function IndexOf(aItem: TROServerLocator): integer;

    function GetNextLocator(out aLocator : TROServerLocator;
                            var CurrentIndex : integer;
                            InitialIndex : integer;
                            ForLoadBalancing : boolean) : boolean;

    procedure EnableAll;
    procedure DisableAll;

    property Items[Index: integer]: TROServerLocator read GetItems write SetItems; default;
  end;

  IROEventReceiver = interface
    ['{A3320CBC-2E62-41C8-9C3D-FB7ADCBF6920}']
    procedure Dispatch(aStream: TStream; aCaller: TThread);
    function GetObject: TObject;
  end;
  
  IROActiveEventChannel = interface
    ['{BFDD73B9-3C6A-4E78-AFFA-7B9A182A5CC4}']
    procedure RegisterEventReceiver(aReceiver: IROEventReceiver);
    procedure UnregisterEventReceiver(aReceiver: IROEventReceiver);
  end;



implementation

uses
  uROClasses;

{ TROServerLocator }
constructor TROServerLocator.Create(Collection: TCollection);
begin
  inherited;

  fProbingOptions := [poProbeWhenEnabled, poProbeWhenDisabled, poEnableIfProbeSucceeded, poDisableIfProbeFailed];
  fLoadBalancingServer := TRUE;
  fEnabled := TRUE;
  fDisableOnFailure := TRUE;
end;

destructor TROServerLocator.Destroy;
begin
  inherited;
end;

function TROServerLocator.GetDisplayName: string;
var options : string;
begin
  if (Trim(fHost)='')
    then result := '!!Empty!!'
    else result := fHost;

  if (fPort>0) then result := result+':'+IntToStr(fPort);

  if not Enabled then result := '(Disabled) '+result;

  if LoadBalancingServer then options := 'LBS' else options := 'non-LBS';
  if DisableOnFailure then options := options+', Disable On Failure' else options := options+',';
  options := options+', '+GetPropValue(Self, 'ProbingOptions');

  result := result+' '+options;
end;

function TROServerLocator.GetEnabled: boolean;
begin
  result := fEnabled and (Length(fHost)>0);
end;

procedure TROServerLocator.SetEnabled(const Value: boolean);
begin
  if (fEnabled=Value) then Exit;

  fEnabled := Value;
  if Assigned(fOnEnabledChanged) then fOnEnabledChanged(Self);
end;

procedure TROServerLocator.SetHost(const Value: string);
begin
  fHost := Trim(Value);
end;

procedure TROServerLocator.SetPort(const Value: integer);
begin
  if (fPort<>Value) and (Value>=0)
    then fPort := Value;
end;

function TROServerLocator.GetNamePath: string;
begin
  if (Collection <> nil) and (Collection.Owner <> nil) then
    result := TComponent(Collection.Owner).Name + '.' + FName
  else                
    result := inherited GetNamePath
end;

procedure TROServerLocator.Assign(Source: TPersistent);
begin
  if Source is TROServerLocator then begin
    Name := TROServerLocator(Source).Name;
    Enabled := TROServerLocator(Source).Enabled;
    Host := TROServerLocator(Source).Host;
    Port := TROServerLocator(Source).Port;
    DisableOnFailure := TROServerLocator(Source).DisableOnFailure;
    LoadBalancingServer := TROServerLocator(Source).LoadBalancingServer;
    ProbingOptions := TROServerLocator(Source).ProbingOptions;
    OnEnabledChanged := TROServerLocator(Source).OnEnabledChanged;
  end 
  else
    inherited;
end;

{ TROServerLocatorCollection }
constructor TROServerLocatorCollection.Create(aOwner : TComponent);
begin
  inherited Create(TROServerLocator);

  fOwner := aOwner;  
end;

destructor TROServerLocatorCollection.Destroy;
begin
  inherited;
end;

function TROServerLocatorCollection.Add: TROServerLocator;
begin
  result := TROServerLocator(inherited Add);
end;

function TROServerLocatorCollection.Insert(aIndex: integer): TROServerLocator;
begin
  result := TROServerLocator(inherited Insert(aIndex));
end;

function TROServerLocatorCollection.GetItems(aIndex: integer): TROServerLocator;
begin
  result := TROServerLocator(inherited Items[aIndex]);
end;

function TROServerLocatorCollection.IndexOf(aItem: TROServerLocator): integer;
var i: integer;
begin
  result := - 1;
  for i := 0 to (Count - 1) do
    if (aItem = Items[i]) then begin
      result := i;
      Exit;
  end;
end;

procedure TROServerLocatorCollection.SetItems(aIndex: integer; aNewItem: TROServerLocator);
begin
  inherited Items[aIndex].Assign(aNewItem);
end;


function TROServerLocatorCollection.GetNextLocator(out aLocator : TROServerLocator;
  var CurrentIndex : integer; InitialIndex : integer; ForLoadBalancing : boolean) : boolean;
var idx : integer;
begin
  aLocator := NIL;
  result := FALSE;
  if Count=0 then Exit;

  idx := CurrentIndex;
  repeat
    try
      idx := IncID(idx, Count-1);

      if (idx=InitialIndex)
        then Exit // We ended up to the first one.

      else if Items[idx].Enabled then begin
        if ForLoadBalancing and not Items[idx].LoadBalancingServer
          then Continue;

        result := TRUE;
        aLocator := Items[idx];
        CurrentIndex := idx;
        Exit;
      end;
    finally
      if InitialIndex = -1 then
        InitialIndex := 0;
    end;
  until FALSE;
end;

procedure TROServerLocatorCollection.DisableAll;
var i: Integer;
begin
  for i := 0 to (Count - 1) do begin
    Items[i].Enabled := FALSE;
  end;
end;

procedure TROServerLocatorCollection.EnableAll;
var i: Integer;
begin
  for i := 0 to (Count - 1) do begin
    Items[i].Enabled := TRUE;
  end;
end;

function TROServerLocatorCollection.GetOwner: TPersistent;
begin
  result := fOwner;
end;

end.