unit uROZeroConf;

{----------------------------------------------------------------------------}
{ 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 MSWINDOWS}Windows,{$ENDIF}
  SysUtils, Classes,
  uROClient,uROServer,uROServerIntf, uROClasses,
  uROmDNS, uROZeroConfHub, uROZeroConfStreamWorker;

const
  AllLocalServices = '_services._dns-sd._udp.';

type
  TROZeroConfEngine = (zceAuto, zceBonjour, zceROZeroConfHub, zceNone);
  TIpType = (ipkAny, iptIP4, iptIP6);
  TROZeroConfRegistration = class;
  TROZeroConfBrowser = class;
  TROZeroConfService = class;

  TROBaseZeroConf = class(TROComponent)
  private
    FEngine: TROZeroConfEngine;
    FDomain: Unicodestring;
    function GetHubClientClass(dummy: boolean): TZeroConfHubClientClass;
    procedure SetDomain(const Value: Unicodestring);
  protected
    procedure TriggerFailed(const ACurrentEngine: TROZeroConfEngine;anException: Exception); virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Engine: TROZeroConfEngine read FEngine write FEngine default zceAuto;
    property Domain: Unicodestring read FDomain write SetDomain;
  end;

{$IFDEF DELPHI10UP}{$REGION 'TROZeroConfRegistration'}{$ENDIF DELPHI10UP}

  {$IFDEF DELPHI10UP}{$REGION 'IZeroConfRegistrationStrategy'}{$ENDIF DELPHI10UP}
  IZeroConfRegistrationStrategy = interface
    procedure RegisterService(const aDomain, aServiceType, aServiceName: UnicodeString; const aPort: integer; aTxtRecord: AnsiString);
    procedure Stop;
    function GetCurrentEngineType: TROZeroConfEngine;
  end;

  TBaseZeroConfRegistrationEngine = class(TInterfacedObject,IZeroConfRegistrationStrategy)
  protected
    procedure RegisterService(const aDomain, aServiceType, aServiceName: UnicodeString; const aPort: integer; aTxtRecord: AnsiString); virtual; abstract;
    procedure Stop; virtual; abstract;
    function GetCurrentEngineType: TROZeroConfEngine;virtual; abstract;
  public
    destructor Destroy; override;
  end;

  TROZeroConfRegistrationEngine = class
  private
    fRegistrationStrategy: IZeroConfRegistrationStrategy;
    fOwner: TROZeroConfRegistration;
    fDomain, fServiceType, fServiceName: UnicodeString;
    fPort: integer;
    fTxtRecord: AnsiString;
    procedure RegistrationSucceeded;
    procedure RegistrationFailed(anException: Exception);
    function CreateHubStrategy:IZeroConfRegistrationStrategy;
    procedure InternalRegisterService;
    function IsNeedToCreateException: Boolean;
  protected
    procedure RegisterService(const aDomain, aServiceType, aServiceName: UnicodeString; const aPort: integer; aTxtRecord: AnsiString);
    procedure Stop;
    function GetCurrentEngineType: TROZeroConfEngine;
  public
    constructor Create(aOwner: TROZeroConfRegistration);
    destructor Destroy; override;
  end;

  TROBonjourRegistrationStrategy = class(TBaseZeroConfRegistrationEngine)
  private
    fService : TRORegisterNetService;
    FOwner: TROZeroConfRegistrationEngine;
    procedure RegError(Sender: TRODNSService; anErrorCode: DNSServiceErrorType);
  protected
    procedure RegisterService(const aDomain, aServiceType, aServiceName: UnicodeString; const aPort: integer; aTxtRecord: AnsiString);override;
    procedure Stop;override;
    function GetCurrentEngineType: TROZeroConfEngine;override;
  private
    constructor Create(const AOwner: TROZeroConfRegistrationEngine);
  end;

  TROHubRegistrationStrategy = class(TBaseZeroConfRegistrationEngine)
  private
    fEngine: TROZeroConfRegistrationEngine;
    fClient: TZeroConfHubClient;
    fHubClientClass: TZeroConfHubClientClass;
  protected
    procedure RegisterService(const aDomain, aServiceType, aServiceName: UnicodeString; const aPort: integer; aTxtRecord: AnsiString);override;
    procedure Stop;override;
    function GetCurrentEngineType: TROZeroConfEngine;override;
  public
    constructor Create(const AEngine: TROZeroConfRegistrationEngine;const AHubClientClass: TZeroConfHubClientClass);
  end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}

  TROZeroConfRegistrationFailedEvent = procedure(Sender: TROZeroConfRegistration; const ACurrentEngine: TROZeroConfEngine; anException: Exception) of object;
  TROZeroConfRegistrationSuccessEvent = procedure(Sender: TROZeroConfRegistration; const ACurrentEngine: TROZeroConfEngine) of object;

  TROZeroConfRegistration = class(TROBaseZeroConf)
  private
    FRegistrationEngine: TROZeroConfRegistrationEngine;
    FTXTRecordData: Unicodestring;
    FServer: TROServer;
    FServerName: UnicodeString;
    FIsRegistrationFailed: Boolean;
    fRegistrationFailed: TROZeroConfRegistrationFailedEvent;
    fRegistrationSucceeded: TROZeroConfRegistrationSuccessEvent;
    procedure SetServerName(const Value: Unicodestring);
    procedure SetServer(const Value: TROServer);
    procedure BuildServerChannelTXTRecord(aServer: TROServer);
    procedure RegisterServices(ClassFactory: IROClassFactory; aServer: TROServer);
    procedure RegisterAllServices(aServer: TROServer);
    Procedure ROServer_AfterOpen(Value: TObject);
    Procedure ROServer_BeforeClose(Value: TObject);
    procedure TriggerServiceRegistrationSucceeded(const ACurrentEngine: TROZeroConfEngine);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure TriggerFailed(const ACurrentEngine: TROZeroConfEngine;anException: Exception); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  public
    property ServerName: UnicodeString read FServerName write SetServerName;
    procedure Assign(Source: TPersistent); override;
  published
    property Server: TROServer read FServer write SetServer;
    property IsRegistrationFailed: Boolean read FIsRegistrationFailed default False;
    property RegistrationFailed: TROZeroConfRegistrationFailedEvent read fRegistrationFailed write fRegistrationFailed;
    property RegistrationSucceeded: TROZeroConfRegistrationSuccessEvent read fRegistrationSucceeded write fRegistrationSucceeded;
  end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}

{$IFDEF DELPHI10UP}{$REGION 'TROZeroConfBrowser'}{$ENDIF DELPHI10UP}
{$IFDEF DELPHI10UP}{$REGION 'IZeroConfBrowseStrategy'}{$ENDIF DELPHI10UP}
  IZeroConfBrowseStrategy = interface
    procedure Start(const aDomain, aServiceType: UnicodeString);
    procedure Stop;
    function GetCurrentEngineType: TROZeroConfEngine;
  end;

  TBaseZeroConfBrowseStrategy = class(TInterfacedObject, IZeroConfBrowseStrategy)
  protected
    procedure Start(const aDomain, aServiceType: UnicodeString); virtual; abstract;
    procedure Stop; virtual; abstract;
    function GetCurrentEngineType: TROZeroConfEngine; virtual; abstract;
  public
    destructor Destroy; override;
  end;

  TROZeroConfBrowseEngine = class
  private
    fBrowseStrategy: IZeroConfBrowseStrategy;
    fDomain, fServiceType: UnicodeString;
    procedure InternalStart;
    function CreateHubStrategy:IZeroConfBrowseStrategy;
    procedure TriggerError(anException: Exception);
    function IsNeedToCreateException: Boolean;
  protected
    fOwner: TROZeroConfBrowser;
    procedure Start(const aDomain, aServiceType: UnicodeString);
    procedure Stop;
    function GetCurrentEngineType: TROZeroConfEngine;
    procedure TriggerBrowse(const Add: boolean; const AServiceName, aServiceType, aDomain: Unicodestring);virtual;
    procedure InternalTriggerError(anException: Exception);virtual;
  public
    constructor Create(aOwner: TROZeroConfBrowser); virtual;
    destructor Destroy; override;
  end;

  TROBonjourBrowseStrategy = class(TBaseZeroConfBrowseStrategy)
  private
    fBrowse: TROBrowseNetService;
    fEngine: TROZeroConfBrowseEngine;
    procedure cbError(Sender: TRODNSService; anErrorCode: DNSServiceErrorType);
    procedure cbBrowse(service: TRONetService; Add: boolean; AName, aType, aDomain: Unicodestring);
  protected
    procedure Start(const aDomain, aServiceType: UnicodeString); override;
    procedure Stop; override;
    function GetCurrentEngineType: TROZeroConfEngine; override;
  public
    constructor Create(aEngine: TROZeroConfBrowseEngine);
  end;

  TROHubBrowseStrategy = class(TBaseZeroConfBrowseStrategy)
  private
    fEngine: TROZeroConfBrowseEngine;
    fClient: TZeroConfHubClient;
    fHubClientClass: TZeroConfHubClientClass;
  protected
    procedure Start(const aDomain, aServiceType: UnicodeString); override;
    procedure Stop; override;
    function GetCurrentEngineType: TROZeroConfEngine; override;
  private
    constructor Create(const aEngine: TROZeroConfBrowseEngine; const aHubClientClass: TZeroConfHubClientClass);
  end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}


  IZeroConfResolveStrategy = interface
    function TryResolve(aTimeout: integer): Boolean;
    procedure Resolve(aTimeout: integer);
    function GetCurrentEngineType: TROZeroConfEngine;
  end;

  TROBaseZeroConfResolveStrategy = class(TInterfacedObject,IZeroConfResolveStrategy)
  protected
    function TryResolve(aTimeout: integer): Boolean; virtual; abstract;
    procedure Resolve(aTimeout: integer); virtual; abstract;
    function GetCurrentEngineType: TROZeroConfEngine; virtual; abstract;
  end;

  TROZeroConfResolveEngine = class
  private
    fConfService: TROZeroConfService;
    fResolveStrategy: IZeroConfResolveStrategy;
    fRaiseException: Boolean;
    fTimeOut: Integer;
    function IntResolve(ADetectEngine: Boolean = False): Boolean;
    function CreateHubStrategy: TROBaseZeroConfResolveStrategy;
    function TriggerError(var aReRaise: Boolean): boolean;
  protected
    function TryResolve(aTimeout: integer): Boolean;
    procedure Resolve(aTimeout: integer);
    function GetCurrentEngineType: TROZeroConfEngine;
  public
    constructor Create(aConfService: TROZeroConfService);
    destructor Destroy; override;
  end;

  TROBonjourResolveStrategy = class(TROBaseZeroConfResolveStrategy)
  private
    fEngine: TROZeroConfResolveEngine;
    function IntResolve(aTimeout: integer): DNSServiceErrorType;
  protected
    function TryResolve(aTimeout: integer): Boolean; override;
    procedure Resolve(aTimeout: integer); override;
    function GetCurrentEngineType: TROZeroConfEngine; override;
  public
    constructor Create(aEngine: TROZeroConfResolveEngine);
  end;

  TROHubResolveStrategy = class(TROBaseZeroConfResolveStrategy)
  private
    fEngine: TROZeroConfResolveEngine;
    fClient: TZeroConfHubClient;
    fHubClientClass: TZeroConfHubClientClass;
    function IntResolve(aTimeout: integer): Boolean;
  protected
    function TryResolve(aTimeout: integer): Boolean; override;
    procedure Resolve(aTimeout: integer); override;
    function GetCurrentEngineType: TROZeroConfEngine; override;
  public
    constructor Create(aEngine: TROZeroConfResolveEngine;const AHubClientClass: TZeroConfHubClientClass);
    destructor Destroy; override;
  end;

  TROZeroConfBrowseAndResolveEngine = class(TROZeroConfBrowseEngine)
  private
    fEvent: TROEvent;
    fFullDomainName: UnicodeString;
    fHostTarget: UnicodeString;
    fPort: integer;
    fTxtRecord: UnicodeString;
    fAddresses: string;
    fIpType : TIpType;
    fError: Boolean;
    FTimeout: integer;
  protected
    function BrowseAndResolve(aTimeout: integer; const aDomain, aServiceType, aHostTarget: UnicodeString;
      out aFullDomainName: UnicodeString; out aPort: integer;out aTxtRecord: UnicodeString; out aAddresses: string; aIpType: TIpType = ipkAny): Boolean;
    procedure TriggerBrowse(const Add: boolean; const AServiceName, aServiceType, aDomain: Unicodestring);override;
    procedure InternalTriggerError(anException: Exception);override;
  public
    constructor Create(aOwner: TROZeroConfBrowser); override;
    destructor Destroy; override;
  end;


  TROZeroConfService = class
  private
    FBrowser: TROZeroConfBrowser;
    FServiceType: UnicodeString;
    FDomain: UnicodeString;
    FServiceName: UnicodeString;
    FDefEngine, FResolvedEngine: TROZeroConfEngine;
    FResolved: Boolean;
    fFullDomainName:UnicodeString;
    FHostTarget:UnicodeString;
    FTextRecord: Ansistring;
    fIpType: integer;
    fPort: cardinal;
    fIP4Address, fIP6Address: string;
    fResolvedIP4, fResolvedIP6: boolean;
    function GetFullDomainName: UnicodeString;
    function GetHostTarget: UnicodeString;
    procedure CheckResolved;
    function GetPort: cardinal;
    function GetTextRecord: UnicodeString;
    function GetAddress: string;
    function GetIP4Address: string;
    function GetIP6Address: string;
    function GetResolvedIP4: boolean;
    function GetResolvedIP6: boolean;
    function GetResolvedEngine: TROZeroConfEngine;
  public
    constructor Create(aBrowser: TROZeroConfBrowser; aDefEngine: TROZeroConfEngine; aDomain, aServiceName, aServiceType: UnicodeString; aIpType: TIpType = ipkAny);
    function TryResolve: boolean; overload;
    function TryResolve(aTimeout: integer): boolean;overload;
    procedure Resolve;overload;
    procedure Resolve(aTimeout: integer);overload;
    property Domain: UnicodeString read FDomain;
    property ServiceName: UnicodeString read FServiceName;
    property ServiceType: UnicodeString read FServiceType;
    property DefEngine: TROZeroConfEngine read FDefEngine;
    property ResolvedEngine : TROZeroConfEngine read GetResolvedEngine;
    property FullDomainName: UnicodeString read GetFullDomainName;
    property HostTarget: UnicodeString read GetHostTarget;
    property TextRecord: UnicodeString read GetTextRecord;
    Property IP4Address: string read GetIP4Address;
    Property IP6Address: string read GetIP6Address;
    property ResolvedIP6: boolean read GetResolvedIP6;
    property ResolvedIP4: boolean read GetResolvedIP4;
    property Port: cardinal read GetPort;
    Property Address: string read GetAddress;
    property Resolved: Boolean read FResolved;
  end;

  TROZeroConfBrowserError = procedure(Sender: TROZeroConfBrowser; const ACurrentEngine: TROZeroConfEngine; anException: Exception) of object;
  TROZeroConfBrowserResultEvent = procedure(Sender: TROZeroConfBrowser; aRecord:TROZeroConfService) of object;

  EDNSServiceException = class(Exception)
  private
    fErrorCode:DNSServiceErrorType;
  public
    constructor Create(const Msg :String; const aErrorCode: DNSServiceErrorType);
    property ErrorCode: DNSServiceErrorType read fErrorCode;
  end;

  TROZeroConfBrowser = class(TROBaseZeroConf)
  private
    fBrowseEngine: TROZeroConfBrowseEngine;
    FServiceType: Unicodestring;
    FActive: Boolean;
    FStreamedActive: Boolean;
    FOnServiceAdded: TROZeroConfBrowserResultEvent;
    FOnServiceRemoved: TROZeroConfBrowserResultEvent;
    FResults: TThreadList;
    //
    FResolveResult: integer;
    FResolveHostTarget : UnicodeString;
    FOnError: TROZeroConfBrowserError;
    //
    procedure SetServiceType(const Value: Unicodestring);
    procedure SetActive(const Value: Boolean);
    procedure Start;
    procedure IntBrowseResult(const ACurrentEngine: TROZeroConfEngine; Add: boolean; AName, aType, aDomain: Unicodestring);
    procedure ClearCache;
  protected
    procedure Loaded; override;
    procedure TriggerFailed(const ACurrentEngine: TROZeroConfEngine; anException: Exception); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Stop;
    function BrowseAndResolve(aTimeout: integer;const AHostTarget: UnicodeString; out fullDomainName: Unicodestring; out port: integer; out txtRecord: unicodestring; out addresses: string; aIpType: TIpType = ipkAny):Boolean;overload;
    function BrowseAndResolve(const AHostTarget: UnicodeString; out fullDomainName: Unicodestring; out port: integer; out txtRecord: unicodestring; out addresses: string; aIpType: TIpType = ipkAny):Boolean;overload;
    procedure Assign(Source: TPersistent); override;
  published
    property Active: Boolean read FActive write SetActive;
    property ServiceType: Unicodestring read FServiceType write SetServiceType;
    property OnError: TROZeroConfBrowserError read FOnError write FOnError;
    property OnServiceAdded: TROZeroConfBrowserResultEvent read FOnServiceAdded write FOnServiceAdded;
    property OnServiceRemoved: TROZeroConfBrowserResultEvent read FOnServiceRemoved write FOnServiceRemoved;
  end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}

implementation
uses
  DateUtils, uROZeroConfHubSynapse;
{ TROZeroConfRegistration }

procedure TROZeroConfRegistration.Assign(Source: TPersistent);
var
  lSource: TROZeroConfRegistration;
begin
  inherited;
  if Source is TROZeroConfRegistration then begin
    lSource := TROZeroConfRegistration(Source);

    RegistrationFailed := lSource.RegistrationFailed;
    RegistrationSucceeded := lSource.RegistrationSucceeded;
    Server := lSource.Server;
  end;
end;

procedure TROZeroConfRegistration.BuildServerChannelTXTRecord(
  aServer: TROServer);

  procedure AddValue(aName,aValue: UnicodeString);
  begin
    if FTXTRecordData <>'' then FTXTRecordData:=FTXTRecordData+#13#10;
    FTXTRecordData :=FTXTRecordData+ aName+'='+aValue;
  end;

var
  szc: IZeroConfServerChannel;
  i: integer;
  s,s1: UnicodeString;
begin
  FTXTRecordData := '';
  if aServer <> nil then begin
    AddValue('txtvers','1');
    {$IFNDEF FPC}
    AddValue('rosdk-edition','Delphi');
    {$ELSE}
      {$IFDEF LCL}
        AddValue('rosdk-edition','Lazarus');
      {$ELSE}
        AddValue('rosdk-edition','FreePascal');
      {$ENDIF}
    {$ENDIF}
    // AddValue('rosdk-version',???);
    // AddValue('runtime-version',???);
    {$IFDEF MSWINDOWS}
    case Win32Platform of
      VER_PLATFORM_WIN32s : AddValue('platform','Wins');
      VER_PLATFORM_WIN32_WINDOWS : AddValue('platform','Windows');
      VER_PLATFORM_WIN32_NT : AddValue('platform','WinNT');
    else
      // VER_PLATFORM_WIN32_CE = 3;
      AddValue('platform','WinCE');
    end;
    {$ELSE}
      {$IFDEF FPC}
       AddValue('platform',{$I %FPCTARGETOS%});
      {$ENDIF}
    {$ENDIF}
    if Supports(aServer,IZeroConfServerChannel, szc) then begin
      case szc.GetServerType of
        rstTCP: AddValue('channel','tcp');
        rstHTTP: AddValue('channel','http');
        rstUDP: AddValue('channel','udp');
        rstSuperHTTP: AddValue('channel','superhttp');
        rstSuperTCP: AddValue('channel','supertcp');
      else
        AddValue('channel','unknown');
      end;
    end;
    if aServer.Dispatchers.Count > 0 then begin
      s:= '';
      for i := 0 to aServer.Dispatchers.Count - 1 do begin
        if s <> '' then s:= s+ ', ';
        s1:= aServer.Dispatchers[i].Message.ClassName;
        s1 := StringReplace(s1, 'Message', '', []);
        s1 := StringReplace(s1, 'TRO', '', []);
        s:= s+ LowerCase(s1);
      end;
      AddValue('messages',s);
    end;
  end;
end;

constructor TROZeroConfRegistration.Create(AOwner: TComponent);
begin
  inherited;
  FIsRegistrationFailed:= False;
  fRegistrationEngine := TROZeroConfRegistrationEngine.Create(self);
end;

destructor TROZeroConfRegistration.Destroy;
begin
  Server := nil;
  FreeAndNil(FRegistrationEngine);
  inherited;
end;

procedure TROZeroConfRegistration.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent=FServer) then Server:=nil;
end;

procedure TROZeroConfRegistration.RegisterAllServices(aServer: TROServer);
var
  lcfn: IROStrings;
  i: integer;
begin
  lcfn := GetZeroConfClassFactoryNames;
  for I := 0 to lcfn.Count - 1 do
    RegisterServices(GetClassFactory(lCfn[i]),aServer);
end;
{$IFDEF FPC}{$HINTS OFF}{$ENDIF}
{$IFDEF FPC}{$HINTS ON}{$ENDIF}

procedure TROZeroConfRegistration.RegisterServices(
  ClassFactory: IROClassFactory; aServer: TROServer);
var
  i: integer;
  cfz:IROClassFactory_ZeroConfig;
  sz: IZeroConfServerChannel;
  lPort: integer;
begin
  if Supports(ClassFactory, IROClassFactory_ZeroConfig, cfz) then begin
//    ServerName := ClassFactory.InterfaceName;
    if Supports(aServer, IZeroConfServerChannel, sz) then lPort:=sz.Port else lPort:=0;
    for I := 0 to cfz.GetAliasNames.Count - 1 do
      fRegistrationEngine.RegisterService(FDomain, cfz.GetAliasNames[i], ServerName, lPort, TXTRecordFromString(FTXTRecordData));
  end;
end;

procedure TROZeroConfRegistration.ROServer_AfterOpen(Value: TObject);
begin
  if (csDesigning in ComponentState) then Exit;
  BuildServerChannelTXTRecord(TROServer(Value));
  RegisterAllServices(TROServer(Value));
end;

{$IFDEF FPC}{$HINTS OFF}{$ENDIF}
procedure TROZeroConfRegistration.ROServer_BeforeClose(Value: TObject);
begin
  fRegistrationEngine.Stop;
end;
{$IFDEF FPC}{$HINTS ON}{$ENDIF}

procedure TROZeroConfRegistration.SetServer(const Value: TROServer);
var
  zc: IZeroConfServerChannel;
  ev: TNotifyEvent;
begin
  if FServer <> Value then begin
    if Assigned(FServer) then begin
      FServer.RORemoveFreeNotification(Self);
      if Supports(FServer, IZeroConfServerChannel,zc) then begin
        zc.Z_SetAfterOpen(nil);
        zc.Z_SetBeforeClose(nil);
        ROServer_BeforeClose(FServer);
        zc.ZeroConfRegistrationServer := nil;
      end;
    end;
    FServer := nil;
    if Value <> nil then begin
      if Supports(Value, IZeroConfServerChannel,zc) then begin
        if (zc.ZeroConfRegistrationServer <> nil) then
          raise Exception.CreateFmt('%s cannot be used with %s because it is already linked with %s ',[Self.Name, Server.Name, TROZeroConfRegistration(zc.ZeroConfRegistrationServer).Name]);
        FServer := Value;
        FServer.ROFreeNotification(Self);
        zc.ZeroConfRegistrationServer:=Self;
        if FServer.Active then ROServer_AfterOpen(FServer);        
        ev := ROServer_AfterOpen;
        zc.Z_SetAfterOpen(ev);
        ev := ROServer_BeforeClose;
        zc.Z_SetBeforeClose(ev);
      end
      else begin
        raise Exception.Create(Value.Name + ' does not compatible with '+ClassName);
      end;
    end;
  end;
end;


procedure TROZeroConfRegistration.SetServerName(const Value: Unicodestring);
begin
  FServerName := Value;
end;

procedure TROZeroConfRegistration.TriggerFailed(const ACurrentEngine: TROZeroConfEngine;anException: Exception);
begin
  fIsRegistrationFailed := true;
  if Assigned(fRegistrationFailed) then fRegistrationFailed(self,ACurrentEngine, anException);
end;

procedure TROZeroConfRegistration.TriggerServiceRegistrationSucceeded(const ACurrentEngine: TROZeroConfEngine);
begin
  fIsRegistrationFailed := false;
  if Assigned(fRegistrationSucceeded) then fRegistrationSucceeded(self, ACurrentEngine);
end;

{ TROZeroConfBrowser }

function TROZeroConfBrowser.BrowseAndResolve(aTimeout: integer;
  const AHostTarget: UnicodeString; out fullDomainName: Unicodestring;
  out port: integer; out txtRecord: unicodestring; out addresses: string; aIpType: TIpType = ipkAny): Boolean;
var
  lBrowseAndResolveEngine: TROZeroConfBrowseAndResolveEngine;
begin
  FResolveResult := 0;
  FResolveHostTarget := AHostTarget;
  if not EndsWith(FDomain, FResolveHostTarget) then FResolveHostTarget := FResolveHostTarget +'.' +FDomain;
  lBrowseAndResolveEngine := TROZeroConfBrowseAndResolveEngine.Create(Self);
  try
    Result := lBrowseAndResolveEngine.BrowseAndResolve(aTimeout, FDomain, FServiceType, FResolveHostTarget, fullDomainName, port, txtRecord, addresses, aIpType);
  finally
    FreeAndNil(lBrowseAndResolveEngine);
  end;
end;

procedure TROZeroConfBrowser.Assign(Source: TPersistent);
var
  lSource: TROZeroConfBrowser;
begin
  if Active then raise EROException.Create( Self.Name+' must be stopped before assigning');
  inherited;
  if Source is TROZeroConfBrowser then begin
    lSource := TROZeroConfBrowser(Source);

    OnError := lSource.OnError;
    OnServiceAdded := lSource.OnServiceAdded;
    OnServiceRemoved := lSource.OnServiceRemoved;
    ServiceType := lSource.ServiceType;
  end;
end;

function TROZeroConfBrowser.BrowseAndResolve(const AHostTarget: UnicodeString;
  out fullDomainName: Unicodestring; out port: integer; out txtRecord: unicodestring;
  out addresses: string; aIpType: TIpType = ipkAny): Boolean;
begin
  Result:= BrowseAndResolve(15, AHostTarget, fullDomainName, port, txtRecord, addresses, aIpType);
end;

procedure TROZeroConfBrowser.ClearCache;
begin
  With FResults.LockList do try
    while Count > 0 do begin
      TObject(Items[0]).Free;
      Delete(0);
    end;
  finally
    FResults.UnlockList;
  end;
end;

constructor TROZeroConfBrowser.Create(AOwner: TComponent);
begin
  inherited;
  FResults := TThreadList.Create;
  FServiceType := AllLocalServices;
  fBrowseEngine := TROZeroConfBrowseEngine.Create(Self);
end;

destructor TROZeroConfBrowser.Destroy;
begin
  Stop;
  FreeAndNil(fBrowseEngine);
  FResults.Free;
  inherited;
end;

{$IFDEF FPC}{$HINTS OFF}{$ENDIF}

procedure TROZeroConfBrowser.IntBrowseResult(const ACurrentEngine: TROZeroConfEngine; Add: boolean; AName, aType, aDomain: Unicodestring);
var
  lRes: TROZeroConfService;
  i: integer;
begin
  lRes := nil;
  with FResults.LockList do try
    for I := 0 to Count - 1 do
      with TROZeroConfService(Items[i]) do
        if (ServiceType = aType) and (Domain = aDomain) and (ServiceName = AName) and
           (DefEngine = ACurrentEngine) then begin
          lRes := TROZeroConfService(Items[i]);
          Break;
        end;
  finally
    FResults.UnlockList;
  end;
  if Add then begin
    if lRes <> nil then Exit;
    lRes := TROZeroConfService.Create(Self, ACurrentEngine,aDomain, AName, aType);
    FResults.Add(lRes);
    if Assigned(onServiceAdded) then onServiceAdded(Self,lRes);
  end
  else begin
    if lRes <> nil then begin
      FResults.Remove(lRes);
      try
        if Assigned(onServiceRemoved) then onServiceRemoved(Self,lRes);
      finally
        lRes.Free;
      end;
    end;
  end;
end;
{$IFDEF FPC}{$HINTS ON}{$ENDIF}

procedure TROZeroConfBrowser.Loaded;
begin
  inherited;
  if fStreamedActive then Active:=True;
end;

procedure TROZeroConfBrowser.SetActive(const Value: Boolean);
begin
  if csLoading in ComponentState then begin
    fStreamedActive := Value
  end
  else if FActive <> Value then begin
    FActive := Value;
    if (csDesigning in ComponentState) then Exit;
    if Value then Start else Stop;
  end;
end;



procedure TROZeroConfBrowser.SetServiceType(const Value: Unicodestring);
begin
  FServiceType := Value;
end;

procedure TROZeroConfBrowser.Start;
begin
  fBrowseEngine.Start(FDomain, FServiceType);
  fActive := True;
end;

procedure TROZeroConfBrowser.Stop;
begin
  if (fBrowseEngine <> nil) then  fBrowseEngine.Stop;
  fActive := False;
  ClearCache;
end;


procedure TROZeroConfBrowser.TriggerFailed(
  const ACurrentEngine: TROZeroConfEngine; anException: Exception);
begin
  if Assigned(fOnError) then FOnError(Self, ACurrentEngine, anException);
end;

{ TROZeroConfService }

procedure TROZeroConfService.CheckResolved;
begin
  if (not fResolved) then raise Exception.Create('Not resolved yet');
end;

constructor TROZeroConfService.Create(aBrowser: TROZeroConfBrowser; aDefEngine: TROZeroConfEngine; aDomain, aServiceName, aServiceType: UnicodeString; aIpType: TIpType = ipkAny);
begin
  inherited Create;
  fBrowser := aBrowser;
  FServiceType := aServiceType;
  FDomain := aDomain;
  FServiceName := aServiceName;
  fDefEngine := aDefEngine;
  case aIpType of
    iptIP4: fIpType := AF_INET;
    iptIP6: fIpType := AF_INET6;
  else
    fIpType := AF_UNSPEC;
  end;
end;

function TROZeroConfService.GetAddress: string;
begin
  CheckResolved;
  Result := fIP6Address;
  if (Result = '') or (fIpType <> AF_INET6) then
    Result := fIP4Address;
end;

function TROZeroConfService.GetFullDomainName: UnicodeString;
begin
  CheckResolved;
  Result := fFullDomainName;
end;

function TROZeroConfService.GetHostTarget: UnicodeString;
begin
  CheckResolved;
  Result := FHostTarget;
end;

function TROZeroConfService.GetIP4Address: string;
begin
  CheckResolved;
  Result := FIP4Address;
end;

function TROZeroConfService.GetIP6Address: string;
begin
  CheckResolved;
  Result := FIP6Address;
end;

function TROZeroConfService.GetPort: cardinal;
begin
  CheckResolved;
  Result := fPort;
end;


function TROZeroConfService.GetResolvedEngine: TROZeroConfEngine;
begin
  CheckResolved;
  Result := FResolvedEngine;
end;

function TROZeroConfService.GetResolvedIP4: boolean;
begin
  CheckResolved;
  Result := fResolvedIP4;
end;

function TROZeroConfService.GetResolvedIP6: boolean;
begin
  CheckResolved;
  Result := fResolvedIP6;
end;

function TROZeroConfService.GetTextRecord: UnicodeString;
begin
  CheckResolved;
  Result := StringFromTXTRecord(FTextRecord);
end;

procedure TROZeroConfService.Resolve;
begin
  Resolve(10);
end;

procedure TROZeroConfService.Resolve(aTimeout: integer);
var
  lEngine : TROZeroConfResolveEngine;
begin
  lEngine := TROZeroConfResolveEngine.Create(Self);
  try
    lEngine.Resolve(aTimeout);
  finally
    FreeAndNil(lEngine);
  end;
end;

function TROZeroConfService.TryResolve(aTimeout: integer): boolean;
var
  lEngine : TROZeroConfResolveEngine;
begin
  lEngine := TROZeroConfResolveEngine.Create(Self);
  try
    Result := lEngine.TryResolve(aTimeout);
  finally
    FreeAndNil(lEngine);
  end;
end;

function TROZeroConfService.TryResolve: boolean;
begin
  result := TryResolve(10);
end;

{ EDNSServiceException }

constructor EDNSServiceException.Create(const Msg :String; const aErrorCode: DNSServiceErrorType);
begin
  inherited Create(Msg);
  FErrorCode := aErrorCode;
end;

{ TROBaseZeroConf }

function TROBaseZeroConf.GetHubClientClass(dummy: boolean): TZeroConfHubClientClass;
begin
  Result := TZeroConfHubSynapseClient;
end;

procedure TROBaseZeroConf.Assign(Source: TPersistent);
var
  lSource: TROBaseZeroConf;
begin
  inherited;
  if Source is TROBaseZeroConf then begin
    lSource := TROBaseZeroConf(Source);

    Domain := lSource.Domain;
    Engine := lSource.Engine;
  end;
end;

constructor TROBaseZeroConf.Create(AOwner: TComponent);
begin
  inherited;
  FEngine := zceAuto;
end;

destructor TROBaseZeroConf.Destroy;
begin
  inherited;
end;

procedure TROBaseZeroConf.SetDomain(const Value: Unicodestring);
begin
  FDomain := Value;
  if (FDomain <> '') and (FDomain[Length(FDomain)] <> '.') then FDomain := FDomain+'.'
end;

{$IFDEF DELPHI10UP}{$REGION 'IZeroConfRegistrationStrategy'}{$ENDIF DELPHI10UP}
{ TROZeroConfRegistrationEngine }

constructor TROZeroConfRegistrationEngine.Create(aOwner: TROZeroConfRegistration);
begin
  inherited Create;
  fOwner := aOwner;
end;

function TROZeroConfRegistrationEngine.CreateHubStrategy: IZeroConfRegistrationStrategy;
var
  lClientClass: TZeroConfHubClientClass;
begin
  lClientClass := fOwner.GetHubClientClass(fOwner.Engine = zceROZeroConfHub);
  if Assigned(lClientClass) then
    Result := TROHubRegistrationStrategy.Create(Self, lClientClass)
  else
    Result := nil;
end;

destructor TROZeroConfRegistrationEngine.Destroy;
begin
  Stop;
  inherited;
end;

function TROZeroConfRegistrationEngine.GetCurrentEngineType: TROZeroConfEngine;
begin
  if fRegistrationStrategy <> nil then
    Result := fRegistrationStrategy.GetCurrentEngineType
  else
    Result := fOwner.Engine;
end;

procedure TROZeroConfRegistrationEngine.InternalRegisterService;
begin
  if fRegistrationStrategy = nil then Exit;
  try
    fRegistrationStrategy.RegisterService(fDomain, fServiceType, fServiceName, fPort, fTxtRecord);
  except
    on E: Exception do begin
      RegistrationFailed(E);
    end;
  end;
end;

function TROZeroConfRegistrationEngine.IsNeedToCreateException: Boolean;
begin
  Result :=
    not ((fRegistrationStrategy.GetCurrentEngineType = zceBonjour) and
    (fOwner.Engine = zceAuto) and
    Assigned(fOwner.GetHubClientClass(False)));
end;

procedure TROZeroConfRegistrationEngine.RegisterService(const aDomain,
  aServiceType, aServiceName: UnicodeString; const aPort: integer;
  aTxtRecord: AnsiString);
var
  lEngine: TROZeroConfEngine;  
begin
  fDomain:= aDomain;
  fServiceType := aServiceType;
  fServiceName := aServiceName;
  fPort := aPort;
  fTxtRecord := aTxtRecord;

  fRegistrationStrategy := nil;


  lEngine := fOwner.Engine;

  if lEngine = zceAuto then begin
    if CheckDNSFunctions(False) then // Bonjour is present
      lEngine := zceBonjour
    else if fOwner.GetHubClientClass(False) <> nil then // Hub is present
      lEngine := zceROZeroConfHub
    else try // bonjour and hub isn't present
      CheckDNSFunctions(True);
    except
      On E: Exception do begin
        RegistrationFailed(E);
        exit;
      end;
    end;
  end;

  case lEngine of
    zceBonjour: fRegistrationStrategy := TROBonjourRegistrationStrategy.Create(self);
    zceROZeroConfHub: fRegistrationStrategy := CreateHubStrategy;
    zceNone: ;
  end;
  InternalRegisterService;
end;

procedure TROZeroConfRegistrationEngine.RegistrationFailed(anException: Exception);
begin
  if Assigned(fRegistrationStrategy) and
    (fRegistrationStrategy.GetCurrentEngineType = zceBonjour) and
    (fOwner.Engine = zceAuto) and
    Assigned(fOwner.GetHubClientClass(False)) then begin
      fRegistrationStrategy := CreateHubStrategy;
      InternalRegisterService;
  end
  else begin
    try
      fOwner.TriggerFailed(GetCurrentEngineType, anException);
    finally
      Stop;
    end;
  end;
end;

procedure TROZeroConfRegistrationEngine.RegistrationSucceeded;
begin
  fOwner.TriggerServiceRegistrationSucceeded(GetCurrentEngineType);
end;

procedure TROZeroConfRegistrationEngine.Stop;
begin
  if fRegistrationStrategy <> nil then begin
    fRegistrationStrategy.Stop;
    fRegistrationStrategy := nil;
  end;
end;

{ TROBonjourRegistrationStrategy }

constructor TROBonjourRegistrationStrategy.Create(
  const AOwner: TROZeroConfRegistrationEngine);
begin
  inherited Create;
  FOwner := AOwner;
end;

function TROBonjourRegistrationStrategy.GetCurrentEngineType: TROZeroConfEngine;
begin
  Result := zceBonjour;
end;

procedure TROBonjourRegistrationStrategy.RegError(Sender: TRODNSService;
  anErrorCode: DNSServiceErrorType);
begin
  if anErrorCode = kDNSServiceErr_NoError then
    FOwner.RegistrationSucceeded
  else begin
    if not FOwner.IsNeedToCreateException then FOwner.RegistrationFailed(nil)
    else try
      TRORegisterNetService.CreateDNSServiceRegisterException(anErrorCode);
    except
      on E: Exception do FOwner.RegistrationFailed(E);
    end;
  end;
end;

procedure TROBonjourRegistrationStrategy.RegisterService(const aDomain,
  aServiceType, aServiceName: UnicodeString; const aPort: integer;
  aTxtRecord: AnsiString);
begin
  Stop;
  fService := TRORegisterNetService.Create(aDomain, aServiceType, aServiceName, aPort);
  fService.TXTRecordData := aTxtRecord;
  fService.OnError := RegError;
  fService.Publish;
end;

procedure TROBonjourRegistrationStrategy.Stop;
begin
  FreeAndNil(fService);
end;

{ TROHubRegistrationStrategy }

constructor TROHubRegistrationStrategy.Create(const AEngine: TROZeroConfRegistrationEngine;const AHubClientClass: TZeroConfHubClientClass);
begin
  inherited Create;
  fEngine:= AEngine;
  FHubClientClass := AHubClientClass;
end;

procedure RegistrationResult(aHandle: String; aUserData: Pointer; aName, aService, aDomain: UnicodeString; anErrorCode: integer);
begin
  if Assigned(aUserData) then begin
    with TROHubRegistrationStrategy(aUserData) do begin
      if anErrorCode = 0 then
        fEngine.RegistrationSucceeded
      else begin
        if not fEngine.IsNeedToCreateException then fEngine.RegistrationFailed(nil)
        else try
          raise EROZeroConfHubException.CreateFmt('Registration failed. ErrorCode = %d',[anErrorCode],anErrorCode);
        except
          on E: Exception do fEngine.RegistrationFailed(E);
        end;
      end;
    end;
  end;
end;

function TROHubRegistrationStrategy.GetCurrentEngineType: TROZeroConfEngine;
begin
  Result := zceROZeroConfHub;
end;

procedure TROHubRegistrationStrategy.RegisterService(const aDomain,
  aServiceType, aServiceName: UnicodeString; const aPort: integer;
  aTxtRecord: AnsiString);
var
  lCallcack : TROZeroConfRegistrationResult;
begin
  lCallcack := RegistrationResult;
  if fClient = nil then begin
    fClient := fHubClientClass.Create;
    try
      fClient.Start;
    except
      FreeAndNil(fClient);
      raise;
    end;
  end;
  fClient.RegisterService(aServiceName,aServiceType,aDomain,0, '', aPort, aTxtRecord, Self, lCallcack);
end;

procedure TROHubRegistrationStrategy.Stop;
begin
  FreeAndnil(fClient);
end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}

{ TBaseZeroConfRegistrationEngine }

destructor TBaseZeroConfRegistrationEngine.Destroy;
begin
  Stop;
  inherited;
end;

{ TBaseZeroConfBrowseStrategy }

destructor TBaseZeroConfBrowseStrategy.Destroy;
begin
  Stop;
  inherited;
end;

{ TROZeroConfBrowseEngine }

constructor TROZeroConfBrowseEngine.Create(aOwner: TROZeroConfBrowser);
begin
  inherited Create;
  FOwner := AOwner;
end;

function TROZeroConfBrowseEngine.CreateHubStrategy: IZeroConfBrowseStrategy;
var
  lClientClass: TZeroConfHubClientClass;
begin
  lClientClass := fOwner.GetHubClientClass(fOwner.Engine = zceROZeroConfHub);
  if Assigned(lClientClass) then
    Result := TROHubBrowseStrategy.Create(Self, lClientClass)
  else
    Result := nil;
end;

destructor TROZeroConfBrowseEngine.Destroy;
begin
  Stop;
  inherited;
end;

function TROZeroConfBrowseEngine.GetCurrentEngineType: TROZeroConfEngine;
begin
  if fBrowseStrategy = nil then
    Result := fOwner.Engine
  else
    Result := fBrowseStrategy.GetCurrentEngineType;
end;

procedure TROZeroConfBrowseEngine.InternalStart;
begin
  if fBrowseStrategy = nil then Exit;
  try
    fBrowseStrategy.Start(fDomain, fServiceType);
  except
    on E: Exception do TriggerError(E);
  end;
end;

procedure TROZeroConfBrowseEngine.InternalTriggerError(
  anException: Exception);
begin
  fOwner.TriggerFailed(GetCurrentEngineType,anException);
end;

function TROZeroConfBrowseEngine.IsNeedToCreateException: Boolean;
begin
  Result := not
    ((fBrowseStrategy.GetCurrentEngineType = zceBonjour) and
    (fOwner.Engine = zceAuto) and
    Assigned(fOwner.GetHubClientClass(False)));
end;

procedure TROZeroConfBrowseEngine.Start(const  aDomain, aServiceType: UnicodeString);
var
  lEngine: TROZeroConfEngine;
begin
  fDomain := aDomain;
  fServiceType := aServiceType;
  fBrowseStrategy := nil;
  lEngine := fOwner.Engine;

  if lEngine = zceAuto then begin
    if CheckDNSFunctions(False) then // Bonjour is present
      lEngine := zceBonjour
    else if fOwner.GetHubClientClass(False) <> nil then // Hub is present
      lEngine := zceROZeroConfHub
    else try // bonjour and hub isn't present
      CheckDNSFunctions(True);
    except
      On E: Exception do begin
        InternalTriggerError(E);
        exit;
      end;
    end;
  end;

  case lEngine of
    zceBonjour: fBrowseStrategy := TROBonjourBrowseStrategy.Create(self);
    zceROZeroConfHub: fBrowseStrategy := CreateHubStrategy;
    zceNone:;
  end;
  InternalStart;
end;

procedure TROZeroConfBrowseEngine.Stop;
begin
  fBrowseStrategy := nil;
end;

procedure TROZeroConfBrowseEngine.TriggerBrowse(const Add: boolean; const AServiceName, aServiceType, aDomain: Unicodestring);
begin
  fOwner.IntBrowseResult(GetCurrentEngineType, Add, AServiceName, aServiceType, aDomain);
end;

procedure TROZeroConfBrowseEngine.TriggerError(anException: Exception);
begin
  if Assigned(fBrowseStrategy) and
    (fBrowseStrategy.GetCurrentEngineType = zceBonjour) and
    (fOwner.Engine = zceAuto) and
    Assigned(fOwner.GetHubClientClass(False)) then begin
      fBrowseStrategy := CreateHubStrategy;
      InternalStart;
  end
  else begin
    try
      InternalTriggerError(anException);
    finally
      Stop;
    end;
  end;
end;

{ TROBonjourBrowseStrategy }

procedure TROBonjourBrowseStrategy.cbBrowse(service: TRONetService;
  Add: boolean; AName, aType, aDomain: Unicodestring);
begin
  fEngine.TriggerBrowse(Add, aName, aType, aDomain);
end;

procedure TROBonjourBrowseStrategy.cbError(Sender: TRODNSService;
  anErrorCode: DNSServiceErrorType);
begin
  if (anErrorCode <> kDNSServiceErr_NoError) then
    if not fEngine.IsNeedToCreateException then
      fEngine.TriggerError(nil)
    else try
      TROBrowseNetService.CreateDNSServiceBrowseException(anErrorCode);
    except
      on E: Exception do fEngine.TriggerError(E);
    end;
end;

constructor TROBonjourBrowseStrategy.Create(aEngine: TROZeroConfBrowseEngine);
begin
  inherited Create;
  FEngine := aEngine;
end;

function TROBonjourBrowseStrategy.GetCurrentEngineType: TROZeroConfEngine;
begin
  Result := zceBonjour;
end;

procedure TROBonjourBrowseStrategy.Start(const aDomain, aServiceType: UnicodeString);
begin
  if Assigned(fBrowse) then Stop;
  fBrowse := TROBrowseNetService.Create(aDomain, aServiceType);
  fBrowse.OnError := cbError;
  fBrowse.BrowseResult := cbBrowse;
  fBrowse.Start();
end;

procedure TROBonjourBrowseStrategy.Stop;
begin
  FreeAndNil(fBrowse);
end;

{ TROHubBrowseStrategy }

constructor TROHubBrowseStrategy.Create(const aEngine: TROZeroConfBrowseEngine; const aHubClientClass: TZeroConfHubClientClass);
begin
  inherited Create;
  fEngine := aEngine;
  fHubClientClass := AHubClientClass;
end;

procedure ROBrowseResult(aHandle: String;aUserData: Pointer; aName, aType, aDomain: Unicodestring; aFlags: integer);
var
  lAdd: Boolean;
begin
  lAdd := (aFlags and hbDeleted) <> hbDeleted;
  if Assigned(aUserData) then TROHubBrowseStrategy(aUserData).fEngine.TriggerBrowse(lAdd, aName, aType, aDomain);
end;

function TROHubBrowseStrategy.GetCurrentEngineType: TROZeroConfEngine;
begin
  Result := zceROZeroConfHub;
end;

procedure TROHubBrowseStrategy.Start(const aDomain, aServiceType: UnicodeString);
var
  lcallback: TROZeroConfResolveBrowseResult;
begin
  lcallback := ROBrowseResult;
  if fClient = nil then begin
    fClient := fHubClientClass.Create;
    try
      fClient.Start;
    except
      FreeAndNil(fClient);
      raise;
    end;
  end;

  try
    fClient.BrowseService(aServiceType, aDomain, Self, lcallback);
  except
    on e: Exception do fEngine.TriggerError(E);
  end;
end;

procedure TROHubBrowseStrategy.Stop;
begin
  FreeAndNil(fClient);
end;

{ TROZeroConfResolveEngine }

constructor TROZeroConfResolveEngine.Create(aConfService: TROZeroConfService);
begin
  inherited Create;
  fConfService := aConfService;
end;

function TROZeroConfResolveEngine.CreateHubStrategy: TROBaseZeroConfResolveStrategy;
var
  lClientClass: TZeroConfHubClientClass;
begin
  lClientClass := fConfService.FBrowser.GetHubClientClass(fConfService.DefEngine = zceROZeroConfHub);
  if Assigned(lClientClass) then
    Result := TROHubResolveStrategy.Create(Self, lClientClass)
  else
    Result := nil;
end;

destructor TROZeroConfResolveEngine.Destroy;
begin
  fResolveStrategy := nil;
  inherited;
end;

function TROZeroConfResolveEngine.GetCurrentEngineType: TROZeroConfEngine;
begin
  if fResolveStrategy = nil then
    Result := fConfService.DefEngine
  else
    Result := fResolveStrategy.GetCurrentEngineType;
end;

function TROZeroConfResolveEngine.IntResolve(ADetectEngine: Boolean = False):Boolean;
var
  lReRaise: Boolean;
  lEngine: TROZeroConfEngine;
begin
  if ADetectEngine then begin
    lEngine := fConfService.DefEngine;
    if lEngine = zceAuto then begin
      if CheckDNSFunctions(False) then // Bonjour is present
        lEngine := zceBonjour
      else if fConfService.FBrowser.GetHubClientClass(False) <> nil then // Hub is present
        lEngine := zceROZeroConfHub
      else begin // bonjour and hub isn't present
        Result := False;
        if fRaiseException then CheckDNSFunctions(True);
        exit;
      end;
    end;

    case lEngine of
      zceBonjour: fResolveStrategy := TROBonjourResolveStrategy.Create(self);
      zceROZeroConfHub: fResolveStrategy := CreateHubStrategy;
      zceNone: fResolveStrategy := nil;
    end;
  end;

  Result := fResolveStrategy <> nil;
  if not Result then begin
    if fRaiseException then
      raise EDNSServiceException.Create('Cannot detect valid engine for Resolve ',-1)
    else
      Exit;
  end;
  try
    if fRaiseException then
      fResolveStrategy.Resolve(fTimeOut)
    else
      Result := fResolveStrategy.TryResolve(fTimeOut);
  except
    Result := TriggerError(lReRaise);
    if lReRaise then raise;    
  end;
end;

procedure TROZeroConfResolveEngine.Resolve(aTimeout: integer);
begin
  fRaiseException := True;
  fTimeOut := aTimeout;
  IntResolve(True);
end;

function TROZeroConfResolveEngine.TriggerError(var aReRaise: Boolean): Boolean;
begin
  if Assigned(fResolveStrategy) and
    (fResolveStrategy.GetCurrentEngineType = zceBonjour) and
    (fConfService.DefEngine = zceAuto) and
    Assigned(fConfService.FBrowser.GetHubClientClass(False)) then begin
      fResolveStrategy := CreateHubStrategy;
      Result := IntResolve;
      aReRaise:= False;
  end
  else begin
    aReRaise := fRaiseException;
    Result := False;
  end;
end;

function TROZeroConfResolveEngine.TryResolve(aTimeout: integer): Boolean;
begin
  fRaiseException := False;
  fTimeOut := aTimeout;
  try
    Result := IntResolve(True);
  except
    Result := False;
  end;
end;

{ TROBonjourResolveStrategy }

constructor TROBonjourResolveStrategy.Create(aEngine: TROZeroConfResolveEngine);
begin
  inherited Create;
  FEngine := aEngine;
end;

function TROBonjourResolveStrategy.GetCurrentEngineType: TROZeroConfEngine;
begin
  Result := zceBonjour;
end;

function TROBonjourResolveStrategy.IntResolve(
  aTimeout: integer): DNSServiceErrorType;
var
  lServ: TROResolveNetService;
  lfullDomainName, lhostTarget: Unicodestring;
  lport: integer;
  ltxtRecord: AnsiString;
  lIP4addresses, lIP6addresses: string;
begin
  with fEngine.fConfService do
    lServ := TROResolveNetService.Create(Domain,ServiceType,ServiceName);
  try
    Result := lServ.BlockResolve(aTimeout, fEngine.fConfService.fIpType, lfullDomainName, lhostTarget, lport, ltxtRecord, lIP4addresses, lIP6addresses);
    if Result = kDNSServiceErr_NoError then
      with fEngine.fConfService do begin
        fFullDomainName:= lfullDomainName;
        FHostTarget := lhostTarget;
        FTextRecord := ltxtRecord;
        fIP4Address := lIP4addresses;
        fIP6Address := lIP6addresses;
        fPort := lport;
        fResolvedIP4 := fIP4Address <> '';
        fResolvedIP6 := fIP6Address <> '';
        FResolvedEngine := GetCurrentEngineType;
        FResolved := fResolvedIP4 or fResolvedIP6; 
      end;
  finally
    lServ.Free;
  end;
end;

procedure TROBonjourResolveStrategy.Resolve(aTimeout: integer);
var
  lRaise: Boolean;
  lResult: DNSServiceErrorType;
begin
  lRaise := False;
  lResult := 0;
  try
    lResult := IntResolve(aTimeout);
    if lResult <> 0 then fEngine.TriggerError(lRaise);
  except
    // raise existing error
    fEngine.TriggerError(lRaise);
    if lRaise then raise;
  end;
  if lRaise then raise EDNSServiceException.Create('Resolve',lResult);
end;

function TROBonjourResolveStrategy.TryResolve(aTimeout: integer): Boolean;
var
  lRaise: Boolean;
begin
  try
    Result := IntResolve(aTimeout) = 0;
  except
    // raise existing error
    Result := fEngine.TriggerError(lRaise);
    if lRaise then raise;
  end;
end;

{ TROHubResolveStrategy }

constructor TROHubResolveStrategy.Create(aEngine: TROZeroConfResolveEngine;
  const AHubClientClass: TZeroConfHubClientClass);
begin
  inherited Create;
  fEngine := aEngine;
  fHubClientClass := AHubClientClass;
end;

destructor TROHubResolveStrategy.Destroy;
begin
  FreeAndNil(fClient);
  inherited;
end;

function TROHubResolveStrategy.GetCurrentEngineType: TROZeroConfEngine;
begin
  Result := zceROZeroConfHub;
end;

function TROHubResolveStrategy.IntResolve(aTimeout: integer): Boolean;
var
  lFullName,
  lLocalAddress: Unicodestring;
  lPort: integer;
  lText: TROHubBytes;
  lIP4, lIP6: string;
begin
  if fClient = nil then begin
    fClient := fHubClientClass.Create;
    try
      fClient.Start;
    except
      FreeAndNil(fClient);
      raise;
    end;
  end;

  try
    with fEngine.fConfService do begin
      Result := fClient.BlockResolve(aTimeout, ServiceName, ServiceType, Domain, fEngine.fConfService.fIpType, lFullName, lLocalAddress, lPort, lText, lIP4, lIP6);
      if Result then begin
        if EndsWith('.local', lLocalAddress) then SetLength(lLocalAddress, Length(lLocalAddress)-6);
        fFullDomainName:= lFullName;
        FHostTarget := lLocalAddress;
        fPort := lPort;
        FTextRecord := lText;
        fIP4Address := lIP4;
        fIP6Address := lIP6;
        fResolvedIP4 := fIP4Address <> '';
        fResolvedIP6 := fIP6Address <> '';
        FResolvedEngine := GetCurrentEngineType;
        FResolved := fResolvedIP4 or fResolvedIP6;
      end;
    end;
  finally
    FreeAndNil(FClient);
  end;
end;

procedure TROHubResolveStrategy.Resolve(aTimeout: integer);
var
  lRaise: Boolean;
begin
  try
    IntResolve(aTimeout);
  except
    // raise existing error
    fEngine.TriggerError(lRaise);
    if lRaise then raise;
  end;
end;

function TROHubResolveStrategy.TryResolve(aTimeout: integer): Boolean;
var
  lRaise: Boolean;
begin
  try
    Result := IntResolve(aTimeout);
  except
    // raise existing error
    Result := fEngine.TriggerError(lRaise);
    if lRaise then raise;
  end;
end;

{ TROZeroConfBrowseAndResolveEngine }

function TROZeroConfBrowseAndResolveEngine.BrowseAndResolve(aTimeout: integer; const aDomain, aServiceType, aHostTarget: UnicodeString;
  out aFullDomainName: UnicodeString; out aPort: integer;out aTxtRecord: UnicodeString; out aAddresses: string; aIpType: TIpType = ipkAny): Boolean;
begin
  fError := False;
  FTimeout := aTimeout;
  FHostTarget := aHostTarget;
  FIpType := aIpType;
  Start(aDomain, aServiceType);
  Result := FEvent.WaitFor(aTimeout*1000) = wrSignaled;
  if Result and not fError then begin
    aFullDomainName := fFullDomainName;
    aPort := fPort;
    aTxtRecord := FTxtRecord;
    aAddresses := FAddresses;
  end
  else begin
    aFullDomainName := '';
    aPort := 0;
    aTxtRecord := '';
    aAddresses := '';
  end;
end;

constructor TROZeroConfBrowseAndResolveEngine.Create(
  aOwner: TROZeroConfBrowser);
begin
  inherited;
  FEvent := TROEvent.Create(nil, False, False, '');
end;

destructor TROZeroConfBrowseAndResolveEngine.Destroy;
begin
  FreeAndNil(FEvent);
  inherited;
end;

procedure TROZeroConfBrowseAndResolveEngine.InternalTriggerError(
  anException: Exception);
begin
  fError := True;
  fEvent.SetEvent;
end;

procedure TROZeroConfBrowseAndResolveEngine.TriggerBrowse(
  const Add: boolean; const AServiceName, aServiceType,
  aDomain: Unicodestring);

  function IncludeDot(aStr: UnicodeString): UnicodeString;
  begin
    Result := aStr;
    if EndsWith(',',aStr) then Result:= aStr else Result:= aStr +'.';
  end;

var
  lRes : TROZeroConfService;
begin
  if Add then begin
     lRes := TROZeroConfService.Create(fOwner, GetCurrentEngineType, aDomain, AServiceName, aServiceType, fIpType);
     try
       if lRes.TryResolve(FTimeOut) then begin
         if (ROWideCompare(lRes.HostTarget, fHostTarget,True) = 0) or // bonjour
            (ROWideCompare(IncludeDot(lRes.HostTarget)+IncludeDot(aDomain),  fHostTarget,True) = 0) // hub
            then begin
           fFullDomainName:= lRes.FullDomainName;
           fPort:= lRes.Port;
           fTxtRecord := lRes.TextRecord;
           fAddresses := lRes.Address;
           if assigned(fEvent) then fEvent.SetEvent;
         end;
       end;
     finally
       lRes.Free;
     end;
  end;
end;


end.