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
343 lines
12 KiB
ObjectPascal
343 lines
12 KiB
ObjectPascal
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.
|