unit uROZeroConfHub;

{$I RemObjects.inc}
{.$DEFINE uROZeroConfHub_DEBUG}
interface

uses
  {$IFDEF MSWINDOWS}Windows, SyncObjs,{$ENDIF}SysUtils, Classes,
  uROClasses, uROThread,uROThreadPool, uROClient, uROZeroConfStreamWorker;

const
  //ZeroConfBrowseFlags
  hbNone = 0;
  hbMoreComing = 1;
  hbDeleted = 2;
  // from Winsock2
  AF_UNSPEC = 0;
  AF_INET   = 2;
  AF_INET6  = 23;

type
  TROZeroConfRegistrationResult   = procedure(aHandle: String; aUserData: Pointer; aName, aService, aDomain: UnicodeString; anErrorCode: integer);
  TROZeroConfResolveAddressResult = procedure(aHandle: String; aUserData: Pointer; aFullName: Unicodestring; anIP: string; aIPType: integer);
  TROZeroConfResolveServiceResult = procedure(aHandle: String; aUserData: Pointer; aName, aType, aDomain, aLocalAddress: Unicodestring; aPort: integer; aText: TROHubBytes);
  TROZeroConfResolveBrowseResult  = procedure(aHandle: String; aUserData: Pointer; aName, aType, aDomain: Unicodestring; aFlags: integer);

  TROStreamWorkerCallback = procedure(aData: TROHubBytes) of object;

  TriggerDelegate = procedure of object;

  TROWaitingRequest = class
  private
    fwh: TROEvent;
    fTrigger: TriggerDelegate;
    fName: Unicodestring;
    FArgs: TKeyValuePair;
    procedure EventTrigger;
  public
    constructor Create(ACreateWithEventSupport: Boolean = False);
    destructor Destroy; override;
    property Event:TROEvent read fwh;
    property Trigger: TriggerDelegate read fTrigger write FTrigger;
    property Name: Unicodestring read fName write fName;
    property Args: TKeyValuePair read FArgs write FArgs;
  end;

  TRODictionary = class
  private
    fItems:TStringList;
    FLock: TRTLCriticalSection;
  protected
    function Lock: TStringList;
    procedure Unlock;
  public
    constructor Create;
    destructor Destroy; override;
    function TryGetValue(aKey: string; out aValue: TObject): boolean;overload;
    procedure Remove(aKey: string);overload;
    procedure Add(aKey: string; aValue: TObject);overload;
    function TryGetValue(aKey: integer; out aValue: TObject): boolean;overload;
    procedure Remove(aKey: integer);overload;
    procedure Add(aKey: integer; aValue: TObject);overload;
  end;


  TDelegateType = (zcRegistration, zcResolveAddress, zcResolveService, zcResolveBrowse);
  MulticastDelegate = record
    aType: TDelegateType;
    case TDelegateType of
      zcRegistration: (RegistrationResult:TROZeroConfRegistrationResult);
      zcResolveAddress: (ResolveAddressResult:TROZeroConfResolveAddressResult);
      zcResolveService: (ResolveServiceResult: TROZeroConfResolveServiceResult);
      zcResolveBrowse: (ResolveBrowseResult: TROZeroConfResolveBrowseResult);
  end;

  TROZeroConfHandle = class
  public
    Handle: TROHubBytes;
    UserData: Pointer;
    Delegate: MulticastDelegate;
  end;

  TZeroConfHubClient = class;

  TROServiceSetup = class
  private
    fWaitingRequest : TROWaitingRequest;
    fWaitHandle: TROEvent;
    fHandle: TROZeroConfHandle;
    fGenID: integer;
    fOwner: TZeroConfHubClient;
    fHandleVal : String;
  public
    constructor Create(aOwner: TZeroConfHubClient; aUserData: Pointer; aDelegate: MulticastDelegate);
    destructor Destroy;override;
    procedure Trigger;
    function GetResult: String;
    property GenID: Integer read fGenID;
  end;

  TZeroConfHubClient = class(TObject, IROStreamWorkerCallbacks)
  private
    fWorker: TROStreamWorker;
    fWaitingRequests: TRODictionary;
    fHandles: TRODictionary;
    fCommandTimeout: integer;
    fBlockResolveEvent: TROEvent;
    fBlockPort: integer;
    fBlockText: TROHubBytes;
    fBlockFullName: Unicodestring;
    fBlockIP4,fBlockIP6: string;
    fBlockLocalAddress: Unicodestring;
    fBlockOrigIpType: integer;
    fPool: TROThreadPool;
    procedure HandleEvent_RegistrationFailed(aHandle: TROHubBytes;aName, aService, aDomain: UnicodeString; anErrorCode: integer);
    procedure HandleEvent_RegistrationSucceeded(aHandle: TROHubBytes;aName, aService, aDomain: UnicodeString);
    procedure HandleEvent_ResolveAddressResult(aHandle: TROHubBytes;aFullName: UnicodeString; anIP: TROHubBytes);
    procedure HandleEvent_ResolveServiceResult(aHandle: TROHubBytes;aName, aType, aDomain, aLocalAddress: Unicodestring; aPort: integer; aText: TROHubBytes);
    procedure HandleEvent_ResolveBrowseResult(aHandle: TROHubBytes; aName, aType, aDomain: Unicodestring; aFlags: integer);
    procedure HandleEvent(lName: UnicodeString; lArgs: TKeyValuePair);
    procedure SendCommand_CloseHandle(aHandle: TROHubBytes);
    procedure CloseHandles;
    function GetRunning: boolean;
  protected
    { IInterface }
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    // IROStreamWorkerCallbacks
    procedure ControlCommand(aSender: TROStreamWorker; aName: UnicodeString; aArguments: TKeyValuePair);
    procedure Data(aSender: TROStreamWorker; aData: TROHubBytes);
    procedure Disconnected(aSender: TROStreamWorker);
    function CreateTCPClient: TTCPStream; virtual; abstract;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
    procedure CloseHandle(aHandle: String);
    function GetMyHostName: UnicodeString;
    function RegisterService(const aName, aService, aDomain: UnicodeString; const aFlags: integer; const aHost: Unicodestring; const aPort: integer; const aText: TROHubBytes; const aUserData: Pointer; const aDelegate: TROZeroConfRegistrationResult): String;
    function ResolveAddress(const aFullName: UnicodeString; const aUserData: Pointer; const aDelegate: TROZeroConfResolveAddressResult):String;
    function ResolveService(const aServiceName, aServiceType, aDomain: UnicodeString; const aUserData: Pointer; const aDelegate: TROZeroConfResolveServiceResult):String;
    function BrowseService(const aServiceType, aDomain: UnicodeString; const aUserData: Pointer; const aDelegate: TROZeroConfResolveBrowseResult):String;
    function BlockResolve(const aTimeout: integer; aServiceName, aServiceType, aDomain: UnicodeString; aIPType: integer; out aFullName, aLocalAddress: Unicodestring; out aPort: integer; out aText: TROHubBytes; out anIP4, anIP6: string): boolean;
    property Running: boolean read GetRunning;
    property CommandTimeout: integer read fCommandTimeout write fCommandTimeout default 10000;
  end;

  TZeroConfHubClientClass = class of TZeroConfHubClient;

implementation

const
  HUB_PORT = 16565;
  HUB_HOST = '127.0.0.1';

function FindParameter(aArgs: TKeyValuePair; aName: UnicodeString):TROHubBytes; forward;
function RemoveLastDot(aValue: Unicodestring): UnicodeString; forward;
function HandleToString(aHandle: TROHubBytes): String; forward;
procedure ProcessException(aArgs: TKeyValuePair);forward;


{$IFDEF DELPHI10UP}{$REGION 'shared functions'}{$ENDIF DELPHI10UP}

function FindParameter(aArgs: TKeyValuePair; aName: UnicodeString): TROHubBytes;
var
  i: integer;
begin
  for i := 0 to Length(aArgs) - 1 do begin
    if ROWideCompare(aArgs[i].ArgName, aName, True)=0 then begin
      Result := aArgs[i].ArgValue;
      Exit;
    end;
  end;
  raise Exception.CreateFmt('No such parameter: %s',[aName]);
end;

function RemoveLastDot(aValue: Unicodestring): UnicodeString;
begin
  Result := aValue;
  if EndsWith('.',Result) then SetLength(Result, Length(Result)-1);
end;

function HandleToString(aHandle: TROHubBytes): String;
var
  lguid: TGUID;
begin
  lguid.D1 := ord(aHandle[1])+ord(aHandle[2])*$100+ord(aHandle[3])*$10000+ord(aHandle[4])*$1000000;
  lguid.D2 := ord(aHandle[5])+ord(aHandle[6])*$100;
  lguid.D3 := ord(aHandle[7])+ord(aHandle[8])*$100;
  Move(aHandle[9],lguid.D4[0],8);
  Result:= GUIDToString(lguid);
end;

procedure ProcessException(aArgs: TKeyValuePair);
var
  lCode: integer;
  lClass: Unicodestring;
  lMessage: unicodestring;
  i: integer;
begin
  lCode := 0;
  lMessage := 'Exception from server';
  for i := 0 to Length(aArgs) - 1 do begin
    if ROWideCompare(aArgs[i].ArgName, 'class', True) = 0 then begin
      lclass := UTF8ToString(aArgs[i].ArgValue);
    end
    else if ROWideCompare(aArgs[i].ArgName, 'code' ,True) = 0 then begin
      lCode := Int32FromBuffer(aArgs[i].ArgValue);
    end
    else if ROWideCompare(aArgs[i].ArgName, 'message' ,True) = 0 then begin
      lMessage := UTF8ToString(aArgs[i].ArgValue);
    end;
  end;
  raise EROZeroConfHubException.Create(lMessage, lCode);
end;


{$IFDEF DELPHI10UP}{$REGION 'TZeroConfHubClient methods'}{$ENDIF DELPHI10UP}
{ TZeroConfHubClient }

procedure cbBlockResolveAddress(aHandle: String; aUserData: Pointer; aFullName: Unicodestring; anIP: string; aIPType: integer);
begin
  if Assigned(aUserData) then
    with TZeroConfHubClient(aUserData) do begin
      if aIPType = AF_INET then
        fBlockIP4 := anIP
      else
        fBlockIP6 := anIP;
      if ((fBlockOrigIpType = AF_UNSPEC) or (fBlockOrigIpType = aIPType)) and Assigned(fBlockResolveEvent) then fBlockResolveEvent.SetEvent;
    end;
end;

procedure cbBlockResolveService(aHandle: String; aUserData: Pointer; aServiceName, aServiceType, aDomain, aLocalAddress: Unicodestring; aPort: integer; aText: TROHubBytes);
begin
  if Assigned(aUserData) then
    with TZeroConfHubClient(aUserData) do begin
      fBlockLocalAddress := aLocalAddress;
      fBlockPort := aPort;
      fBlockText := aText;
      ResolveAddress(aLocalAddress,aUserData,@cbBlockResolveAddress);
    end;
end;

function TZeroConfHubClient.BlockResolve(const aTimeout: integer; aServiceName, aServiceType,
  aDomain: UnicodeString; aIPType: integer; out aFullName, aLocalAddress: Unicodestring;
  out aPort: integer; out aText: TROHubBytes; out anIP4, anIP6: string): boolean;
begin
{$IFDEF uROZeroConfHub_DEBUG}
  OutputDebugString(PChar('BlockResolve, self= ' + intTohex(Cardinal(self),8)));
{$ENDIF}
  fBlockResolveEvent := TROEvent.Create(nil, false, false,'');
  try
    fBlockFullName := aServiceName + '.' + aServiceType + '.' + aDomain;
    fBlockOrigIpType := aIPType;
    ResolveService(aServiceName,aServiceType,aDomain, Self, @cbBlockResolveService);
    Result := fBlockResolveEvent.WaitFor(aTimeout*1000) = wrSignaled;
    if (not Result) then begin
      raise EROZeroConfHubException.Create('Timeout waiting for request', 0);
    end
    else begin
      aFullName := fBlockFullName;
      aLocalAddress := fBlockLocalAddress;
      aPort := fBlockPort;
      aText := fBlockText;
      anIP4 := fBlockIP4;
      anIP6 := fBlockIP6;
    end;
  finally
    FreeAndNil(fBlockResolveEvent);
  end;
end;

function TZeroConfHubClient.BrowseService(const aServiceType, aDomain: UnicodeString;
  const aUserData: Pointer; const aDelegate: TROZeroConfResolveBrowseResult):String;
var
  lServiceType,lDomain: UnicodeString;
  lArgs: TKeyValuePair;
  zc: TROServiceSetup;
  delegate: MulticastDelegate;
begin
  lServiceType := RemoveLastDot(aServiceType);
  lDomain := RemoveLastDot(aDomain);
  SetLength(lArgs,2);
  lArgs[0].ArgName := 'aType';    lArgs[0].ArgValue := UnicodeStringToBytes(lServiceType);
  lArgs[1].ArgName := 'aDomain';  lArgs[1].ArgValue := UnicodeStringToBytes(lDomain);
  delegate.aType := zcResolveBrowse;
  delegate.ResolveBrowseResult := aDelegate;
  zc := TROServiceSetup.Create(Self, aUserData, delegate);
  try
    fWorker.SendData(EncodePackage('BrowseService', true, Int32ToBuffer(zc.GenID), lArgs));
    Result := zc.GetResult;
  finally
    zc.Free;
  end;
end;

procedure TZeroConfHubClient.CloseHandle(aHandle: String);
var
  lHandle: TObject;
begin
  if fHandles.TryGetValue(aHandle,lHandle) then begin
    fHandles.Remove(aHandle);
    if (lHandle <> nil) then begin
      SendCommand_CloseHandle(TROZeroConfHandle(lHandle).Handle);
      lHandle.Free;
    end;
  end;
end;

procedure TZeroConfHubClient.CloseHandles;
var
  lhandle: TROZeroConfHandle;
  i: integer;
  List: TStringList;
begin
  List := fHandles.Lock;
  try
    for i := 0 to List.Count - 1 do begin
      lhandle := TROZeroConfHandle(List.Objects[i]);
      if lhandle <> nil then begin
        try
          SendCommand_CloseHandle(lhandle.Handle);
        except
          // catch exceptions
        end;
        lhandle.Free;
      end;
    end;
    List.Clear;
  finally
    fHandles.Unlock;
  end;
end;

procedure TZeroConfHubClient.ControlCommand(aSender: TROStreamWorker;
  aName: UnicodeString; aArguments: TKeyValuePair);
begin
// nothing
end;

constructor TZeroConfHubClient.Create;
begin
  inherited;
  fPool := TROThreadPool.Create(nil);
  fPool.MaxQueue := MaxInt;
  fPool.MaxThreads := 1;
  fPool.PoolThreads := 1;
  fHandles := TRODictionary.Create;
  fWaitingRequests := TRODictionary.Create;
  fCommandTimeout := 90000; // 10 seconds
  Start;
end;

procedure TZeroConfHubClient.Data(aSender: TROStreamWorker;
  aData: TROHubBytes);
var
  lName: Unicodestring;
  lArgs: TKeyValuePair;
  lPackage: integer;
  w: TObject;
begin
  DecodePackage(aData, 4, lName, lArgs);
  lPackage := Int32FromBuffer(aData);
{$IFDEF uROZeroConfHub_DEBUG}
  OutputDebugStringW(PWideChar('TZeroConfHubClient.Data. Name = ' + lName + ' package = '+ BoolToStr(lPackage > 0,True)));
{$ENDIF}
  if (lPackage > 0) then begin
    if fWaitingRequests.TryGetValue(lPackage, w) then begin
      TROWaitingRequest(w).Name := lName;
      TROWaitingRequest(w).Args := lArgs;
      TROWaitingRequest(w).Trigger;
    end;
  end
  else begin
    HandleEvent(lName, lArgs);
  end;
end;

destructor TZeroConfHubClient.Destroy;
begin
  Stop;
  FreeAndNil(fWaitingRequests);
  FreeAndNil(fHandles);
  FreeAndNil(fPool);
  inherited;
end;

procedure TZeroConfHubClient.Disconnected(aSender: TROStreamWorker);
begin
  Stop();
end;

function TZeroConfHubClient.GetMyHostName: UnicodeString;
var
  lArgs: TKeyValuePair;
  wr: TROWaitingRequest;
  lGenID: integer;
  lOk: Boolean;
begin
  wr := TROWaitingRequest.Create(True);
  try
    lGenID := fWorker.GenerateID(true);
    fWaitingRequests.Add(lGenID, wr);
    SetLength(lArgs,0);
    fWorker.SendData(EncodePackage('GetMyHostName', true, Int32ToBuffer(lGenID), lArgs));
    lOk := wr.Event.WaitFor(fCommandTimeout) = wrSignaled;// in ms
    fWaitingRequests.Remove(lGenID);
    if (not lOk) then raise EROZeroConfHubException.Create('Timeout waiting for request', 0);
    if EndsWith('#Exception', wr.Name, True) then ProcessException(wr.Args);
    Result := BytesToUnicodeString(FindParameter(wr.Args, 'Result'));
  finally
    wr.Free;
  end;
end;

function TZeroConfHubClient.GetRunning: boolean;
begin
  Result := Assigned(fWorker);
end;

procedure TZeroConfHubClient.HandleEvent(lName: UnicodeString;
  lArgs: TKeyValuePair);
begin
  if lName = 'RegistrationFailed' then begin
    HandleEvent_RegistrationFailed(
      FindParameter(lArgs, 'aHandle'),
      BytesToUnicodeString(FindParameter(lArgs, 'aName')),
      BytesToUnicodeString(FindParameter(lArgs, 'aService')),
      BytesToUnicodeString(FindParameter(lArgs, 'aDomain')),
      Int32FromBuffer(FindParameter(lArgs, 'anErrorCode')));
  end
  else if lName = 'RegistrationSucceeded' then begin
    HandleEvent_RegistrationSucceeded(
      FindParameter(lArgs, 'aHandle'),
      BytesToUnicodeString(FindParameter(lArgs, 'aName')),
      BytesToUnicodeString(FindParameter(lArgs, 'aService')),
      BytesToUnicodeString(FindParameter(lArgs, 'aDomain')));

  end
  else if lName = 'ResolveAddressResult'  then begin
    HandleEvent_ResolveAddressResult(
      FindParameter(lArgs, 'aHandle'),
      BytesToUnicodeString(FindParameter(lArgs, 'aFullName')),
      FindParameter(lArgs, 'anIP'));
  end
  else if lName = 'ResolveServiceResult' then begin
    HandleEvent_ResolveServiceResult(
      FindParameter(lArgs, 'aHandle'),
      BytesToUnicodeString(FindParameter(lArgs, 'aName')),
      BytesToUnicodeString(FindParameter(lArgs, 'aType')),
      BytesToUnicodeString(FindParameter(lArgs, 'aDomain')),
      BytesToUnicodeString(FindParameter(lArgs, 'aLocalAddress')),
      Int32FromBuffer(FindParameter(lArgs, 'aPort')),
      FindParameter(lArgs, 'aText'));
  end
  else if lName = 'ResolveBrowseResult' then begin
    HandleEvent_ResolveBrowseResult(
      FindParameter(lArgs, 'aHandle'),
      BytesToUnicodeString(FindParameter(lArgs, 'aName')),
      BytesToUnicodeString(FindParameter(lArgs, 'aType')),
      BytesToUnicodeString(FindParameter(lArgs, 'aDomain')),
      Int32FromBuffer(FindParameter(lArgs, 'aFlags')));
  end;
end;

type
  TROHubPooledEvent = class(TInterfacedObject, IROThreadPoolCallback)
  private
    fHandle: TROZeroConfHandle;
    fHandleVal: string;
    //
    aName, aType, aService, aDomain, aLocalAddress: UnicodeString;
    aFullName: UnicodeString;
    aPort, anErrorCode,aFlags: integer;
    aIP: string;
    aIPType: integer;
    aText: TROHubBytes;
  protected
    procedure Callback(Caller: TROThreadPool; Thread: TThread);
  public
    constructor Create(aHandle: TROZeroConfHandle);
    destructor Destroy; override;
  end;

{ TROHubPooledEvent }

procedure TROHubPooledEvent.Callback(Caller: TROThreadPool;
  Thread: TThread);
begin
  if (fHandle <> nil) then
{$IFDEF uROZeroConfHub_DEBUG}
  OutputDebugString(PChar('before TROHubPooledEvent.Callback, ID='+inttostr(ord(fHandle.Delegate.aType))));
{$ENDIF}
    case fHandle.Delegate.aType  of
     zcRegistration:   fHandle.Delegate.RegistrationResult(fHandleVal, fHandle.UserData, aName, aService, aDomain, anErrorCode);
     zcResolveAddress: fHandle.Delegate.ResolveAddressResult(fHandleVal, fHandle.UserData, aFullName, aIP, aIPType);
     zcResolveService: fHandle.Delegate.ResolveServiceResult(fHandleVal, fHandle.UserData, aName, aType, aDomain, aLocalAddress,aPort, aText);
     zcResolveBrowse:  fHandle.Delegate.ResolveBrowseResult(fHandleVal, fHandle.UserData, aName, aType, aDomain, aFlags);
   end;
{$IFDEF uROZeroConfHub_DEBUG}
  OutputDebugString(PChar('after TROHubPooledEvent.Callback, ID='+inttostr(ord(fHandle.Delegate.aType))));
{$ENDIF}
end;

constructor TROHubPooledEvent.Create(aHandle: TROZeroConfHandle);
begin
  inherited Create;
  fHandle := aHandle;
end;

procedure TZeroConfHubClient.HandleEvent_RegistrationFailed(
  aHandle: TROHubBytes; aName, aService, aDomain: UnicodeString;
  anErrorCode: integer);
var
  lHandle: TObject;
  lHandleVal: string;
  lpe: TROHubPooledEvent;
  lpeEv : IROThreadPoolCallback;
begin
  lHandle := nil;
  lHandleVal := HandleToString(aHandle);
  fHandles.TryGetValue(lHandleVal, lHandle);
  if lHandle <> nil then begin
    lpe := TROHubPooledEvent.Create(TROZeroConfHandle(lHandle));
    //
    lpe.fHandleVal := lHandleVal;
    lpe.aName := aName;
    lpe.aService:= aService;
    lpe.aDomain := aDomain;
    lpe.anErrorCode := anErrorCode;
    //
    lpeEv := lpe;
    fPool.QueueItem(lpeEv);
  end;
end;

procedure TZeroConfHubClient.HandleEvent_RegistrationSucceeded(
  aHandle: TROHubBytes; aName, aService, aDomain: UnicodeString);
var
  lHandle: TObject;
  lHandleVal: string;
  lpe: TROHubPooledEvent;
  lpeEv : IROThreadPoolCallback;
begin
  lHandle := nil;
  lHandleVal := HandleToString(aHandle);
  fHandles.TryGetValue(lHandleVal, lHandle);
  if lHandle <> nil then begin
    lpe := TROHubPooledEvent.Create(TROZeroConfHandle(lHandle));
    //
    lpe.fHandleVal := lHandleVal;
    lpe.aName := aName;
    lpe.aService:= aService;
    lpe.aDomain := aDomain;
    lpe.anErrorCode := 0;
    //
    lpeEv := lpe;
    fPool.QueueItem(lpeEv);
  end;
end;

function DecodeIP4(anIP: TROHubBytes): string;
begin
  Result:=Format('%d.%d.%d.%d', [ord(anIP[1]),ord(anIP[2]),ord(anIP[3]),ord(anIP[4])]);
end;

function DecodeIP6(anIP: TROHubBytes): string;
begin
  if Length(anIP) = 16 then begin
    Result := Format('%.x:%.x:%.x:%.x:%.x:%.x:%.x:%.x',[
    ord(anIP[1])*$100+ord(anIP[2]),ord(anIP[3])*$100+ord(anIP[4]),ord(anIP[5])*$100+ord(anIP[6]),ord(anIP[7])*$100+ord(anIP[8]),
    ord(anIP[9])*$100+ord(anIP[10]),ord(anIP[11])*$100+ord(anIP[12]),ord(anIP[13])*$100+ord(anIP[14]),ord(anIP[15])*$100+ord(anIP[16])]);
    Result := StringReplace( Result, ':0:0:', '::', [rfReplaceAll]);
    Result := StringReplace( Result, ':0:', '::', [rfReplaceAll]);
    Result := StringReplace( Result, ':::', '::', [rfReplaceAll]);
    Result := StringReplace( Result, ':::', '::', [rfReplaceAll]);
    Result := LowerCase(Result);
  end
  else
    Result:= {$IFDEF UNICODE}AnsiStringToWideString{$ENDIF}(anIP);
end;

procedure TZeroConfHubClient.HandleEvent_ResolveAddressResult(aHandle: TROHubBytes;aFullName: UnicodeString; anIP: TROHubBytes);
var
  lHandle: TObject;
  lHandleVal: string;
  lIP: string;
  lIPType: integer;
  lpe: TROHubPooledEvent;
  lpeEv : IROThreadPoolCallback;
begin
  if Length(anIP) = 4 then lIPtype := AF_INET else lIPtype := AF_INET6;

  if lIPtype = AF_INET then
    lIP := DecodeIP4(anIP)
  else
    lIP := DecodeIP6(anIP);
  lHandle := nil;
  lHandleVal := HandleToString(aHandle);
  fHandles.TryGetValue(lHandleVal, lHandle);

  if lHandle <> nil then begin
    lpe := TROHubPooledEvent.Create(TROZeroConfHandle(lHandle));
    //
    lpe.fHandleVal := lHandleVal;
    lpe.aFullName := aFullName;
    lpe.aIP:= lIP;
    lpe.aIPType := lIPType;
    //
    lpeEv := lpe;
    fPool.QueueItem(lpeEv);
  end;
end;

procedure TZeroConfHubClient.HandleEvent_ResolveBrowseResult(
  aHandle: TROHubBytes; aName, aType, aDomain: Unicodestring;
  aFlags: integer);
var
  lHandle: TObject;
  lHandleVal: string;
  lpe: TROHubPooledEvent;
  lpeEv : IROThreadPoolCallback;
begin
  lHandle := nil;
  lHandleVal := HandleToString(aHandle);
  fHandles.TryGetValue(lHandleVal, lHandle);
  if lHandle <> nil then begin
    lpe := TROHubPooledEvent.Create(TROZeroConfHandle(lHandle));
    //
    lpe.aName := aName;
    lpe.aType := aType;
    lpe.aDomain := aDomain;
    lpe.aFlags := aFlags;
    //
    lpeEv := lpe;
    fPool.QueueItem(lpeEv);
  end;
end;

procedure TZeroConfHubClient.HandleEvent_ResolveServiceResult(
  aHandle: TROHubBytes; aName, aType, aDomain, aLocalAddress: Unicodestring;
  aPort: integer; aText: TROHubBytes);
var
  lHandle: TObject;
  lHandleVal: string;
  lpe: TROHubPooledEvent;
  lpeEv : IROThreadPoolCallback;
begin
  lHandle := nil;
  lHandleVal := HandleToString(aHandle);
  fHandles.TryGetValue(lHandleVal, lHandle);

  if lHandle <> nil then begin
    lpe := TROHubPooledEvent.Create(TROZeroConfHandle(lHandle));
    //
    lpe.aName := aName;
    lpe.aType := aType;
    lpe.aDomain := aDomain;
    lpe.aLocalAddress := aLocalAddress;
    lpe.aPort := aPort;
    lpe.aText := aText;
    //
    lpeEv := lpe;
    fPool.QueueItem(lpeEv);
  end;
end;

function TZeroConfHubClient.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE
end;

function TZeroConfHubClient.RegisterService(const aName, aService, aDomain: UnicodeString;
  const aFlags: integer; const aHost: Unicodestring; const aPort: integer; const aText: TROHubBytes;
  const aUserData: Pointer; const aDelegate: TROZeroConfRegistrationResult): String;
var
  lService, lDomain: UnicodeString;
  lArgs: TKeyValuePair;
  zc: TROServiceSetup;
  ldelegate:MulticastDelegate;
begin
  lService := RemoveLastDot(aService);
  lDomain := RemoveLastDot(aDomain);
  SetLength(lArgs, 7);
  lArgs[0].ArgName := 'aName';    lArgs[0].ArgValue := UnicodeStringToBytes(aName);
  lArgs[1].ArgName := 'aService'; lArgs[1].ArgValue := UnicodeStringToBytes(lService);
  lArgs[2].ArgName := 'aDomain';  lArgs[2].ArgValue := UnicodeStringToBytes(lDomain);
  lArgs[3].ArgName := 'aFlags';   lArgs[3].ArgValue := Int32ToBuffer(aFlags);
  lArgs[4].ArgName := 'aHost';    lArgs[4].ArgValue := UnicodeStringToBytes(aHost);
  lArgs[5].ArgName := 'aPort';    lArgs[5].ArgValue := Int32ToBuffer(aPort);
  lArgs[6].ArgName := 'aText';    lArgs[6].ArgValue := aText;
  ldelegate.aType := zcRegistration;
  ldelegate.RegistrationResult := aDelegate;
  zc := TROServiceSetup.Create(Self, aUserData, ldelegate);
  try
    fWorker.SendData(EncodePackage('RegisterService', true, Int32ToBuffer(zc.GenID), lArgs));
    Result := zc.GetResult;
  finally
    zc.Free;
  end;
end;

function TZeroConfHubClient.ResolveAddress(const aFullName: UnicodeString; const aUserData: Pointer; 
  const aDelegate: TROZeroConfResolveAddressResult):String;
var
  lArgs: TKeyValuePair;
  zc: TROServiceSetup;
  ldelegate: MulticastDelegate;
begin
  SetLength(lArgs,1);
  lArgs[0].ArgName := 'aFullName';lArgs[0].ArgValue := UnicodeStringToBytes(aFullName);
  ldelegate.aType := zcResolveAddress;
  ldelegate.ResolveAddressResult := aDelegate;
  zc := TROServiceSetup.Create(Self, aUserData, ldelegate);
  try
    fWorker.SendData(EncodePackage('ResolveAddress', true, Int32ToBuffer(zc.GenID), lArgs));
    Result := zc.GetResult;
  finally
    zc.Free;
  end;
end;

function TZeroConfHubClient.ResolveService(const aServiceName, aServiceType, aDomain: UnicodeString;
  const aUserData: Pointer; const aDelegate: TROZeroConfResolveServiceResult):String;
var
  lServiceType,lDomain: UnicodeString;
  lArgs: TKeyValuePair;
  zc: TROServiceSetup;
  ldelegate: MulticastDelegate;
begin
  lServiceType := RemoveLastDot(aServiceType);
  lDomain := RemoveLastDot(aDomain);
  SetLength(lArgs,3);
  lArgs[0].ArgName := 'aName';    lArgs[0].ArgValue := UnicodeStringToBytes(aServiceName);
  lArgs[1].ArgName := 'aType';    lArgs[1].ArgValue := UnicodeStringToBytes(lServiceType);
  lArgs[2].ArgName := 'aDomain';  lArgs[2].ArgValue := UnicodeStringToBytes(lDomain);
  ldelegate.aType := zcResolveService;
  ldelegate.ResolveServiceResult := aDelegate;
  zc := TROServiceSetup.Create(Self, aUserData, ldelegate);
  try
    fWorker.SendData(EncodePackage('ResolveService', true, Int32ToBuffer(zc.GenID), lArgs));
    Result := zc.GetResult;
  finally
    zc.Free;
  end;
end;

procedure TZeroConfHubClient.SendCommand_CloseHandle(aHandle: TROHubBytes);
var
  lArgs: TKeyValuePair;
  wr: TROWaitingRequest;
  lGenID: integer;
  lOk: Boolean;
begin
  lOk := True;
  SetLength(lArgs,1);
  lArgs[0].ArgName := 'aHandle';
  lArgs[0].ArgValue := aHandle;
  wr := TROWaitingRequest.Create(True);
  try
    lGenID := fWorker.GenerateID(true);
    fWaitingRequests.Add(lGenID, wr);
    fWorker.SendData(EncodePackage('CloseHandle', true, Int32ToBuffer(lGenID), lArgs));
//    lOk := wr.Event.WaitFor(fCommandTimeout) = wrSignaled;// in ms
    fWaitingRequests.Remove(lGenID);
    if (not lOk) then raise EROZeroConfHubException.Create('Timeout waiting for request', 0);
    if EndsWith('#Exception', wr.Name, True) then ProcessException(wr.Args);
  finally
    SetLength(lArgs,0);
    wr.Free;
  end;
end;

procedure TZeroConfHubClient.Start;
var
  lSock: TTCPStream;
begin
  if (fWorker = nil) then begin
    lSock := CreateTCPClient;
    fWorker := TROStreamWorker.Create(Self,lSock);
    lSock.Connect(HUB_HOST, HUB_PORT);
    fWorker.Start();
  end;
end;

procedure TZeroConfHubClient.Stop;
begin
  if fWorker <> nil then begin
    CloseHandles;
    FreeAndNil(fWorker);
  end;
end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}

{$IFDEF DELPHI10UP}{$REGION 'TROServiceSetup methods'}{$ENDIF DELPHI10UP}
function TZeroConfHubClient._AddRef: Integer;
begin
  Result := -1   // -1 indicates no reference counting is taking place
end;

function TZeroConfHubClient._Release: Integer;
begin
  Result := -1   // -1 indicates no reference counting is taking place
end;

destructor TROHubPooledEvent.Destroy;
begin
  inherited;
end;

{ TROServiceSetup }

constructor TROServiceSetup.Create(aOwner: TZeroConfHubClient; aUserData: Pointer; aDelegate: MulticastDelegate);
begin
  inherited Create;
  fOwner := aOwner;
  fWaitHandle := TROEvent.Create(nil,false,false,'');
  fWaitingRequest := TROWaitingRequest.Create;
  fWaitingRequest.Trigger := Self.Trigger;
  fHandle := TROZeroConfHandle.Create;
  fHandle.UserData := aUserData;
  fHandle.Delegate := aDelegate;
  fGenID := fOwner.fWorker.GenerateID(true);
  fOwner.fWaitingRequests.Add(fGenID, fWaitingRequest);
end;

destructor TROServiceSetup.Destroy;
begin
  FreeAndNil(fWaitingRequest);
//  FreeAndNil(fHandle);
  inherited;
end;

function TROServiceSetup.GetResult: String;
var
  lOk: Boolean;
begin
  lOk := fWaitHandle.WaitFor(fOwner.fCommandTimeout)=wrSignaled; // in ms
  FreeAndNil(fWaitHandle);
  fOwner.fWaitingRequests.Remove(fGenID);
  if ( not lOk) then raise EROZeroConfHubException.Create('Timeout waiting for request', 0);
  if EndsWith('#Exception',fWaitingRequest.Name,True) then ProcessException(fWaitingRequest.Args);
  Result := fHandleVal;
end;

procedure TROServiceSetup.Trigger;
begin
  try
    if not EndsWith('#Exception',fWaitingRequest.Name) then begin
      fHandle.Handle := FindParameter(fWaitingRequest.Args, 'aHandle');
      fHandleVal := HandleToString(fHandle.Handle);
      fOwner.fHandles.Add(fHandleVal, fHandle);
    end
    else begin
      FreeAndNil(fHandle);
    end;
    if fWaitHandle <> nil then fWaitHandle.SetEvent;
  except
    fWaitingRequest.Name := '#Exception';
    fOwner.fHandles.Remove(fHandleVal);
    FreeAndNil(fHandle);
  end;
end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}

{$IFDEF DELPHI10UP}{$REGION 'TRODictionary methods'}{$ENDIF DELPHI10UP}
{ TRODictionary }

procedure TRODictionary.Add(aKey: string; aValue: TObject);
begin
  Lock;
  try
    FItems.AddObject(aKey,aValue);
  finally
    Unlock;
  end;
end;

procedure TRODictionary.Add(aKey: integer; aValue: TObject);
begin
  Add(IntToStr(aKey),aValue);
end;

constructor TRODictionary.Create;
begin
  inherited;
  {$IFDEF FPC}
  InitCriticalSection(FLock);
  {$ELSE}
  InitializeCriticalSection(FLock);
  {$ENDIF}
  fItems := TStringList.Create;
  fItems.Duplicates:= dupError;
end;

destructor TRODictionary.Destroy;
begin
  Lock;
  try
    fItems.Free;
    inherited;
  finally
    Unlock;
    {$IFDEF FPC}
    DoneCriticalSection(FLock);
    {$ELSE}
    DeleteCriticalSection(FLock);
    {$ENDIF}
  end;
end;

function TRODictionary.Lock: TStringList;
begin
  EnterCriticalSection(FLock);
  Result := fItems;
end;

procedure TRODictionary.Remove(aKey: integer);
begin
  Remove(IntToStr(aKey));
end;

procedure TRODictionary.Remove(aKey: string);
var
  i: integer;
begin
  Lock;
  try
    i := FItems.IndexOf(aKey);
    if i <> -1 then FItems.Delete(i);
  finally
    Unlock;
  end;
end;

function TRODictionary.TryGetValue(aKey: string;
  out aValue: TObject): boolean;
var
  i: integer;
begin
  Lock;
  try
    i := FItems.IndexOf(aKey);
    Result := i <> -1;
    if Result then aValue := FItems.Objects[i];
  finally
    Unlock;
  end;
end;

procedure TRODictionary.Unlock;
begin
  LeaveCriticalSection(FLock);
end;

function TRODictionary.TryGetValue(aKey: integer;
  out aValue: TObject): boolean;
begin
  Result := TryGetValue(IntToStr(aKey),aValue);
end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}

{$IFDEF DELPHI10UP}{$REGION 'TROWaitingRequest methods'}{$ENDIF DELPHI10UP}
{ TROWaitingRequest }

constructor TROWaitingRequest.Create(ACreateWithEventSupport: Boolean = False);
begin
  inherited Create;
  fName := '';
  SetLength(FArgs,0);
  if ACreateWithEventSupport then begin
    fwh := TROEvent.Create(nil, False,False,'');
    fTrigger := EventTrigger;
  end;
end;

destructor TROWaitingRequest.Destroy;
begin
  SetLength(FArgs,0);
  fwh.Free;
  inherited;
end;

procedure TROWaitingRequest.EventTrigger;
begin
  fwh.SetEvent;
end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF DELPHI10UP}


end.