unit uRODiscovery;

{----------------------------------------------------------------------------}
{ 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
  Classes, Contnrs, SysUtils,
  uROBroadcastChannel, uROClient, uRODiscovery_Intf, uRODiscovery_Async;

type
  TRODiscoveryNewServiceFoundEvent = procedure(aSender:TObject; aName:string; aDiscoveryOptions:TRODiscoveryOptions) of object;

  TRODiscoveryException = procedure(aSender: TObject; aException: Exception) of object;

  TROCustomDiscoveryClient = class(TROComponent, IROBroadcastNotification)
  private
    fChannel: TROBroadcastChannel;
    fMessage: TROMessage;
    fServerList: TStrings;
    fServiceName: string;
    fOnNewServersFound: TNotifyEvent;
    fDiscoveryService: IRODiscoveryService_Async;
    fOnNewServiceFound: TRODiscoveryNewServiceFoundEvent;
    FOnDiscoveryException: TRODiscoveryException;

    procedure SetChannel(const Value: TROBroadcastChannel);
    procedure SetMessage(const Value: TROMessage);
    procedure SetServiceName(const Value: string);
    procedure TriggerNewServersFound;
    procedure TriggerNewServiceFound(aName:string; aDiscoveryOptions:TRODiscoveryOptions);
  private
    { IROBroadcastNotification }
    procedure ResponseReceived(ServerIP,ResponseUID: String);
  protected
    procedure Notification(aComponent:TComponent; aOperation:TOperation); override;
  public
    constructor Create(aOwner:TComponent); override;
    destructor Destroy; override;
    procedure RefreshServerList(aDiscoveryOptions: TRODiscoveryOptions=nil);
    procedure CheckProperties;
    property Channel:TROBroadcastChannel read fChannel write SetChannel;
    property Message:TROMessage read fMessage write SetMessage;
    property ServerList:TStrings read fServerList;
    property ServiceName:string read fServiceName write SetServiceName;
    property OnNewServersFound:TNotifyEvent read fOnNewServersFound write fOnNewServersFound;
    property OnNewServiceFound:TRODiscoveryNewServiceFoundEvent read fOnNewServiceFound write fOnNewServiceFound;
    property OnDiscoveryException: TRODiscoveryException read FOnDiscoveryException write FOnDiscoveryException;
  end;

  TRODiscoveryClient = class(TROCustomDiscoveryClient)
  published
    property Channel;
    property Message;
    property ServerList;
    property ServiceName;
    property OnNewServersFound;
    property OnNewServiceFound;
    property OnDiscoveryException;
  end;

  TRODiscoveryServiceFoundEvent = procedure (aSender:TObject; aName:string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean) of object;

  TROCustomDiscoveryServer = class(TROComponent)
  private
    fServiceList: TStrings;
    fSupportRegisteredServerClasses: boolean;
    fOnServiceFound: TRODiscoveryServiceFoundEvent;
    fServerAddress: string;
    procedure SetServiceList(const Value: TStrings);
    procedure TriggerOnServiceFound(aName:string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean);
    function FindServiceInList(iList:TStrings; const iName:string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean):string;
  protected
    procedure Notification(aComponent:TComponent; aOperation:TOperation); override;
    function FindService(const iName: string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean):string;
  public
    constructor Create(aOwner:TComponent); override;
    destructor Destroy; override;
    property ServerAddress:string read fServerAddress write fServerAddress;
    property ServiceList:TStrings read fServiceList write SetServiceList;
    property SupportRegisteredServerClasses:boolean read fSupportRegisteredServerClasses write fSupportRegisteredServerClasses default true;
    property OnServiceFound:TRODiscoveryServiceFoundEvent read fOnServiceFound write fOnServiceFound;
  end;

  TRODiscoveryServer = class(TROCustomDiscoveryServer)
  published
    property ServiceList;
    property SupportRegisteredServerClasses;
    property OnServiceFound;
  end;

  TRODiscoveryServerManager = class(TObjectList)
  public
    constructor Create();
    procedure RegisterDiscoveryServer(iDiscoveryServer:TROCustomDiscoveryServer);
    procedure UnregisterDiscoveryServer(iDiscoveryServer:TROCustomDiscoveryServer);
    function FindService(const iName:string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean):string;
  end;

var
  DiscoveryServerManager:TRODiscoveryServerManager;

implementation

uses
  {$IFDEF VER140UP}DateUtils,{$ENDIF}
  IdStack,
  uROClassFactories, uROServer, uRODiscoveryService_Impl, uROClasses;

{ TROCustomDiscoveryClient }

constructor TROCustomDiscoveryClient.Create(aOwner: TComponent);
begin
  inherited;
  fServerList := TStringList.Create;
  TStringList(fServerList).Duplicates := dupIgnore;
end;

destructor TROCustomDiscoveryClient.Destroy;
begin
  Channel := nil;
  FreeAndNil(fServerList);
  inherited;
end;

procedure TROCustomDiscoveryClient.Notification(aComponent: TComponent; aOperation: TOperation);
begin
  inherited;
  if aOperation <> opRemove then exit;
  if aComponent = Channel then Channel := nil;
  if aComponent = Message then Message := nil;
end;

procedure TROCustomDiscoveryClient.RefreshServerList(aDiscoveryOptions: TRODiscoveryOptions=nil);
begin
  CheckProperties;
  fServerList.Clear();
  TriggerNewServersFound();

  if not Assigned(fDiscoveryService) then
    fDiscoveryService := CoIRODiscoveryService_Async.Create(Message,Channel);

  fDiscoveryService.Invoke_FindService(ServiceName, aDiscoveryOptions);
end;

procedure TROCustomDiscoveryClient.TriggerNewServersFound;
begin
  if Assigned(OnNewServersFound) then OnNewServersFound(self);
end;

procedure TROCustomDiscoveryClient.ResponseReceived(ServerIP, ResponseUID: String);
var
  lOptions: TRODiscoveryOptions;
  lServer:string;
begin
  lOptions := nil;

  if not Assigned(fDiscoveryService) then exit;

  try
    lServer := fDiscoveryService.Retrieve_FindService(lOptions);
  except
    on E: Exception do begin
      if Assigned(FOnDiscoveryException) then begin
        FOnDiscoveryException(Self, E);
        exit;
      end
      else begin
        raise;
      end;
    end;
  end;

  try
    TriggerNewServiceFound(lServer, lOptions);
    if (lServer <> '') and (fServerList.IndexOf(lServer) = -1) then begin
      fServerList.Add(lServer);
      TriggerNewServersFound();
    end;
  finally
    FreeAndNil(lOptions);
  end;
end;

procedure TROCustomDiscoveryClient.SetChannel(const Value: TROBroadcastChannel);
var
  lBroadcastNotification:IROBroadcastNotification;
begin
  if fChannel <> Value then begin
    fDiscoveryService := nil;  { proxy is no longer valid }
    if Assigned(fChannel) then begin
      fChannel.UnregisterResponseListner(self);
    end;

    fChannel := Value;
    if Assigned(fChannel) then begin
      fChannel.FreeNotification(self);
      if Supports(self,IROBroadcastNotification,lBroadcastNotification) then
        fChannel.RegisterResponseListner(lBroadcastNotification);
    end;
  end;
end;

procedure TROCustomDiscoveryClient.SetMessage(const Value: TROMessage);
begin
  if fMessage <> Value then begin
    fDiscoveryService := nil;  { proxy is no longer valid }
    fMessage := Value;
    if Assigned(fMessage) then fMessage.FreeNotification(self);
  end;
end;

procedure TROCustomDiscoveryClient.SetServiceName(const Value: string);
begin
  if fServiceName <> Value then begin
    fServiceName := Value;
  end;
end;

procedure TROCustomDiscoveryClient.TriggerNewServiceFound(aName: string; aDiscoveryOptions: TRODiscoveryOptions);
begin
  if Assigned(OnNewServiceFound) then
    OnNewServiceFound(self, aName, aDiscoveryOptions);
end;

procedure TROCustomDiscoveryClient.CheckProperties;
begin
  Check(Channel = NIL, Name + '.Channel must be assigned.');
  Channel.CheckProperties;
  Check(Message = NIL, Name + '.Message must be assigned.');
  Message.CheckProperties;
  Check(ServiceName = '', Name + '.ServiceName must be set.');
end;

{ TROCustomDiscoveryServer }

constructor TROCustomDiscoveryServer.Create(aOwner: TComponent);
begin
  inherited;
  fServiceList := TStringList.Create;
  TStringList(fServiceList).Sorted := true;
  SupportRegisteredServerClasses := true;

  RegisterDiscoveryService();
  DiscoveryServerManager.RegisterDiscoveryServer(self);
end;

destructor TROCustomDiscoveryServer.Destroy;
begin
  DiscoveryServerManager.UnregisterDiscoveryServer(self);
  FreeAndNil(fServiceList);
  inherited;
end;

function TROCustomDiscoveryServer.FindService(const iName: string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean):string;
begin
  result := FindServiceInList(fServiceList, iName, ioDiscoveryOptions, ioHandled);
  if (not ioHandled) and SupportRegisteredServerClasses then
    result := FindServiceInList(GetClassFactoryNames.Strings, iName, ioDiscoveryOptions, ioHandled);
end;

function TROCustomDiscoveryServer.FindServiceInList(iList:TStrings; const iName:string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean):string;
begin
  result := '';
  if iList.IndexOf(iName) > -1 then begin
    ioHandled := true;
    TriggerOnServiceFound(iName,ioDiscoveryOptions,ioHandled);
    if ioHandled then begin
      if fServerAddress <> '' then begin
        result := fServerAddress;
      end
      else begin
        result := GStack.LocalAddress;
      end;
    end;
  end;
end;

procedure TROCustomDiscoveryServer.Notification(aComponent:TComponent; aOperation:TOperation);
begin
  inherited;
  if aOperation <> opRemove then exit;
end;

procedure TROCustomDiscoveryServer.SetServiceList(const Value: TStrings);
begin
  fServiceList.Assign(Value);
end;

procedure TROCustomDiscoveryServer.TriggerOnServiceFound(aName:string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean);
begin
  if Assigned(OnServiceFound) then
    OnServiceFound(self,aName,ioDiscoveryOptions,ioHandled);
end;

{ TRODiscoveryServerManager }

constructor TRODiscoveryServerManager.Create;
begin
  inherited Create(false);
end;

function TRODiscoveryServerManager.FindService(const iName: string; var ioDiscoveryOptions:TRODiscoveryOptions; var ioHandled:boolean):string;
var
  i:integer;
begin
  for i := 0 to Count-1 do begin
    result := (Items[i] as TROCustomDiscoveryServer).FindService(iName,ioDiscoveryOptions,ioHandled);
    if ioHandled then exit;
  end;
end;

procedure TRODiscoveryServerManager.RegisterDiscoveryServer(iDiscoveryServer:TROCustomDiscoveryServer);
begin
  if IndexOf(iDiscoveryServer) = -1 then Add(iDiscoveryServer);
end;

procedure TRODiscoveryServerManager.UnregisterDiscoveryServer(iDiscoveryServer:TROCustomDiscoveryServer);
var
  lIndex:integer;
begin
  lIndex := IndexOf(iDiscoveryServer);
  if IndexOf(iDiscoveryServer) <> -1 then Delete(lIndex);
end;

initialization
  DiscoveryServerManager := TRODiscoveryServerManager.Create;
finalization
  FreeAndNil(DiscoveryServerManager);
end.