unit uROSuperTCPChannel;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Indy 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
  SysUtils, Classes, uROClasses, uROClient, uROClientIntf, SyncObjs,
  {$IFDEF REMOBJECTS_TRIAL}uROTrial, {$ENDIF} uROAsync,
  {$IFDEF RemObjects_UseEncryption} uRoEncryption, {$ENDIF}
  IdTCPConnection, IdTCPClient, {$IFDEF WIN32}Windows, {$ENDIF}uROSCHelpers, uROThreadPool;

type
  TROCustomSuperTCPChannel = class;
  TROSCClientWorker = class;
  TROWaitingRequest = class
  private
    fEvent: TROEvent;
    fFreeEvent: Boolean;
    fId: Integer;
    fResultData: TStream;
    fResultErrorCode: Integer;
  public
    property Id: Integer read fId;
    property Event: TROEvent read fEvent;
    property Resultdata: TStream read fResultData write fResultData;
    property ResultErrorCode: Integer read fResultErrorCode write fResultErrorCode;

    constructor Create(Id: Integer); overload;
    constructor Create(Id: Integer; Ev: TROEvent); overload;
    destructor Destroy; override;
  end;

  TROPooledEvent = class(TInterfacedObject, IROThreadPoolCallback)
  private
    fData: TStream;
    fOwner: TROCustomSuperTCPChannel;
  protected
    procedure Callback(Caller: TROThreadPool; Thread: TThread);
  public
    constructor Create(aData: TStream; aOwner: TROCustomSuperTCPChannel);
    destructor Destroy; override;
  end;
  TROSCState = (scNotConnected, scConnecting, scConnected, scReconnecting);
  TROCustomSuperTcpChannel = class(TROTransportChannel, IROTransport,
    IROTCPTransport, IROActiveEventChannel, IROMultiThreadAwareChannel,
    IROAsyncTransportChannel, IROActiveAsyncTransportChannel, IROTransportChannelEx)
  private
    fRequestTimeout: Integer;
    fState: TROSCState;
    fHost: string;
    fPort: Integer;
    fConnection: TIdTCPClient;
    fActive: Boolean;
    fOwnsEventThreadPool: Boolean;
    fEventThreadPool: TROThreadPool;
    fClient: TROSCClientWorker;
    fWorkerThread: TThread;
    fWaitingRequests: TThreadList;
    fAutoReconnect: Boolean;
    fEventReceiver: IROEventReceiver;
    fConnectEvent: TROEvent;
    fReconnectEvent: TROEvent;
    fOnDisconnected: TNotifyEvent;
    fOnConnected: TNotifyEvent;
    fReconnectDelay: Integer;
    fStoreActive: Boolean;
    fPingSecs: Integer;
    fAckWaitTimeout: Integer;
    fIdleTimeoutMinutes: Integer;
    fSynchronizeEvents: Boolean;
    fConnectionWaitTimeout: Integer;
    procedure SetHost(const Value: string);
    procedure SetPort(const Value: Integer);
    procedure SetActive(const Value: Boolean);
    procedure SetEventThreadPool(const Value: TROThreadPool);
    function GetClientID: TGUID;
    procedure SetClientID(const Value: TGUID);
    function GetMaxPackageSize: Longint;
    procedure SetMaxPackageSize(val: longint);
    function GetConnected: Boolean;
    function GetSkipAck: Boolean;
    procedure SetSkipAck(const Value: Boolean);
    procedure SetPingSecs(const Value: Integer);
  protected
    procedure Loaded; override;
    function GetClientAddress: String;
    function GetTransportObject: TObject; override;

    procedure HasData(Id: Integer; aData: TStream);
    procedure BeforeDispatch(aMessage: IROMessage); override;
    procedure IntDispatch(aRequest, aResponse : TStream); override;
    procedure IntSetServerLocator(aServerLocator: TROServerLocator); override;
    procedure RegisterEventReceiver(aReceiver: IROEventReceiver);
    procedure UnregisterEventReceiver(aReceiver: IROEventReceiver);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function InvokeRequest(aRequest: TStream; aGetResponse: Boolean = True;
      aEvent: TROEvent = nil): String; overload;
    function InvokeRequest(aRequest:TStream; iGetResponse:boolean=true):string; overload;
    function CheckStatus(const iMessageID: String): Boolean;
    procedure RetrieveResponse(const iMessageID: String;
      aResponse: TStream);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure WaitForActive(const Timeout: Integer);

    property Host: string read fHost write SetHost;
    property Port: Integer read fPort write SetPort default 8095;
    property PingSecs: Integer read fPingSecs write SetPingSecs default 60;
    property StoreActive: Boolean read fStoreActive write fStoreActive default True;
    property Active: Boolean read fActive write SetActive  stored fStoreActive default False;
    property Client: TIdTCPClient read fConnection;
    property RequestTimeout: Integer read fRequestTimeout write fRequestTimeout default 60000;
    property EventThreadPool: TROThreadPool read fEventThreadPool write SetEventThreadPool;
    property AutoReconnect: Boolean read fAutoReconnect write fAutoReconnect default False;
    property ReconnectDelay: Integer read fReconnectDelay write fReconnectDelay default 500;
    property ClientID: TGUID read GetClientID write SetClientID;
    property OnDisconnected: TNotifyEvent read fOnDisconnected write fOnDisconnected;
    property MaxPackageSize: Integer read GetMaxPackageSize write SetMaxPackageSize default 1024*1024;
    property OnConnected: TNotifyEvent read fOnConnected write fOnConnected;
    property AckWaitTimeout: Integer read fAckWaitTimeout write fAckWaitTimeout default 10000;
    property Connected: Boolean read GetConnected;
    property IdleTimeoutMinutes: Integer read fIdleTimeoutMinutes write fIdleTimeoutMinutes default 0; // minutes
    property SynchronizeEvents: Boolean read fSynchronizeEvents write fSynchronizeEvents default False;
    property ConnectionWaitTimeout: Integer read fConnectionWaitTimeout write fConnectionWaitTimeout default 10000;
    property SkipAck: Boolean read GetSkipAck write SetSkipAck default false;
  end;

  TROSuperTcpChannel = class(TROCustomSuperTcpChannel)
  public
  published
    property Host;
    property Port;
    property Active;
    property RequestTimeout;
    property AutoReconnect;
    property ReconnectDelay;
    property OnDisconnected;
    property OnConnected;
    property StoreActive;
    property MaxPackageSize;
    property AckWaitTimeout;
  	property SynchronizeEvents;
    property ConnectionWaitTimeout;
  published
    property SynchronizedProbing;
    property OnSendStream;
    property OnReceiveStream;
    property ServerLocators;
    property DispatchOptions;
    property OnServerLocatorAssignment;
    property ProbeServers;
    property ProbeFrequency;
    property SkipAck;    
    property OnBeforeProbingServers;
    property OnAfterProbingServers;
    property OnBeforeProbingServer;
    property OnAfterProbingServer;
    property OnLoginNeeded;
  end;

  TROSCClientWorker = class(TROSuperChannelWorker)
  private
    fOwner: TROCustomSuperTCPChannel;
    fSkipReconnect: Boolean;
  protected
    procedure Connected; override;
    procedure Disconnected(var RestartLoop: Boolean); override;
    procedure IncomingData(Id: Integer; aData: TStream); override;
    procedure Idle; override;
    procedure SetAckDetails(Id: Integer; Oke: Boolean; ErrorNo: Integer); override;
  public
    constructor Create(aOwner: TROCustomSuperTCPChannel; aConnection: TIdTCPConnection);
    property Owner: TROCustomSuperTCPChannel read fOwner;
  end;

implementation

type
  TROClientThread = class(TThread)
  private
    fChannel: TROSCClientWorker;
    fConnecting: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(aChannel: TROSCClientWorker);
    property Connecting: Boolean read fConnecting;
  end;

{ TROCustomSuperTCPChannel }

procedure TROCustomSuperTcpChannel.BeforeDispatch(aMessage: IROMessage);
begin
  inherited;
  if not  fConnection.Connected then
  begin
    SetActive(true);
  end;
  fReconnectEvent.SetEvent;
  if  fConnectEvent.WaitFor(fConnectionWaitTimeout) <> wrSignaled then raise EROException.Create('No connection available');
  if aMessage <> nil then
    aMessage.ClientID := fClient.ClientId;
end;

function TROCustomSuperTcpChannel.CheckStatus(
  const iMessageID: String): Boolean;
var
  i, id: Integer;
  lList: TList;
  lReq: TROWaitingRequest;
begin
  Result := False;
  id := StrToInt(iMessageID);
  lList := fWaitingRequests.LockList;
  try
    for i := lList.Count -1 downto 0 do begin
      lReq := TROWaitingRequest(lList[i]);
      if Lreq.Id = id then
      begin
        Result := (lReq.Resultdata <> nil) or (lReq.ResultErrorCode <> -1);
        exit;
      end;
    end;
  finally
    fWaitingRequests.UnlockList;
  end;
end;

constructor TROCustomSuperTCPChannel.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fConnectEvent := TROEvent.create(nil, true, false, '');
  fReconnectEvent := TROEvent.Create(nil, true, false, '');

  fPingSecs := 60;
  fWaitingRequests := TThreadList.Create;
  fHost := 'localhost';
  fPort := 8095;
  fConnection := TIdTCPClient.Create(nil);
  fClient := TROSCClientWorker.Create(Self, fConnection);
  fRequestTimeout := 60000;
  fAckWaitTimeout := 10000;
  fReconnectDelay := 500;
  fConnectionWaitTimeout := 10000;
  fStoreActive := True;
  ThreadSafe := True;
end;


destructor TROCustomSuperTCPChannel.Destroy;
begin
  SetActive(False);
  fClient.Free;
  fConnection.Free;
  fWaitingRequests.Free;
  fConnectEvent.Free;
  if fOwnsEventThreadPool then
  begin
    fEventThreadPool.Free;
  end;
  fEventReceiver := nil;
  fReconnectEvent.Free;
  inherited Destroy;
end;

function TROCustomSuperTCPChannel.GetClientAddress: String;
begin
{$IFDEF REMOBJECTS_INDY8}
  if (fConnection.Binding <> nil) and (fConnection.Binding <> nil) then
    Result := fConnection.Binding.PeerIP
  else
    Result := '';
{$ELSE}
  if (fConnection.Socket <> nil) and (fConnection.Socket.Binding <> nil) then
    Result := fConnection.Socket.Binding.PeerIP
  else
    Result := '';
{$ENDIF}
end;

function TROCustomSuperTcpChannel.GetClientID: TGUID;
begin
  Result := fClient.ClientID;
end;

function TROCustomSuperTcpChannel.GetConnected: Boolean;
begin
  result := fClient.IsConnected;
end;

function TROCustomSuperTcpChannel.GetMaxPackageSize: Longint;
begin
  result := fClient.MaxPackageSize;
end;

function TROCustomSuperTcpChannel.GetSkipAck: Boolean;
begin
  result := fClient.SkipAck;
end;

function TROCustomSuperTCPChannel.GetTransportObject: TObject;
begin
  Result := self;
end;

procedure TROCustomSuperTCPChannel.HasData(Id: Integer; aData: TStream);
var
  lList: TList;
  i: Integer;
  lReq: TROWaitingRequest;
  lEvent: TROPooledEvent;
  lEventIntf: IROThreadPoolCallback;
begin
  if Id < 0 then // got an event
  begin
    if fEventThreadPool = nil then raise EROException.Create('No thread pool assigned');
    lEvent := TROPooledEvent.Create(aData, Self);
    lEventIntf := lEvent;
    try
        fEventThreadPool.QueueItem(lEventIntf);
    except
      lEvent.fData := nil;
      raise;
    end;
  end else
  begin
    lList := fWaitingRequests.LockList;
    try
      lReq := nil;
      for i := lList.Count -1 downto 0 do
      begin
        if TROWaitingRequest(lList[i]).Id = Id then
        begin
          lReq := TROWaitingRequest(lList[i]);
          break;
        end;
      end;
      if lReq = nil then
      begin
        // Don't want a response
        aData.Free;
        exit;
      end;
      lReq.Resultdata := aData;
      lReq.Event.SetEvent;
    finally
      fWaitingRequests.UnlockList;
    end;
  end;
end;

procedure TROCustomSuperTCPChannel.IntDispatch(aRequest,
  aResponse: TStream);
var
  lId: Integer;
  lReq: TROWaitingRequest;
begin
//  if (not fActive) then raise EROException.Create('Not connected');
  lId := fClient.GenerateId;
  lReq := TROWaitingRequest.Create(lId);
  fWaitingRequests.Add(lReq);
  try
    TROSCClientWorker.WaitForAck(fClient.SendPackage(aRequest, lId), fAckWaitTimeout);
    try
      lReq.Event.WaitFor(fRequestTimeout);
    finally
      fWaitingRequests.Remove(lReq);
    end;
    if lReq.Resultdata = nil then begin
      case lReq.fResultErrorCode of
        ScCmdNoAck_MsgTooLarge: raise EROException.Create('Message from server too large');
        ScCmdNoAck_QueueFull: raise EROException.Create('Server queue full');
        else raise EROTimeout.Create('Timeout waiting for response');
      end;
    end;
    lReq.Resultdata.Seek(0, soFromBeginning);
    aResponse.CopyFrom(lReq.Resultdata, lReq.Resultdata.Size);
  finally
    lReq.Free;
  end;
end;

procedure TROCustomSuperTCPChannel.IntSetServerLocator(
  aServerLocator: TROServerLocator);
begin
  Host := aServerLocator.Host;
  Port := aServerLocator.Port;
end;

function TROCustomSuperTcpChannel.InvokeRequest(aRequest: TStream;
  aGetResponse: Boolean; aEvent: TROEvent): String;
var
  lId: Integer;
  lReq: TROWaitingRequest;
begin
  lId := fClient.GenerateId;
  if aGetResponse then begin
    if aEvent = nil then
      lReq := TROWaitingRequest.Create(lId)
    else
      lReq := TROWaitingRequest.Create(lId, aEvent);

    fWaitingRequests.Add(lReq);
  end;
  fClient.SendPackage(aRequest, lId);
  Result := IntToStr(lId);
  aRequest.Free; // needs to be freed here
end;

function TROCustomSuperTcpChannel.InvokeRequest(aRequest: TStream;
  iGetResponse: boolean): string;
begin
  Result := InvokeRequest(aRequest, iGetResponse, nil);
end;

procedure TROCustomSuperTCPChannel.Loaded;
begin
  inherited;
  if fActive then
  begin
    fActive := false;
    SetActive(true);
  end;
end;

procedure TROCustomSuperTcpChannel.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  dummy: IROEventReceiver;
begin
  if (Operation = opRemove) then
  begin
    if (AComponent = fEventThreadPool) then
      fEventThreadPool := nil;
    if Supports(aComponent, IROEventReceiver, dummy) and (dummy = fEventReceiver) then
      fEventReceiver := nil;
  end;
  inherited;
end;

procedure TROCustomSuperTcpChannel.RegisterEventReceiver(
  aReceiver: IROEventReceiver);
begin
  if assigned(fEventReceiver) then
    TComponent(fEventReceiver.GetObject).RemoveFreeNotification(Self);
  fEventReceiver := aReceiver;
  if assigned(fEventReceiver) then
    TComponent(fEventReceiver.GetObject).FreeNotification(Self);
end;

procedure TROCustomSuperTcpChannel.RetrieveResponse(
  const iMessageID: String; aResponse: TStream);
var
  i, id: Integer;
  lList: TList;
  lReq: TROWaitingRequest;

begin
  id := STrToInt(iMessageID);
  lList := fWaitingRequests.LockList;
  try
    lReq := nil;
    for i := lList.Count -1 downto 0 do begin
      lReq := TROWaitingRequest(lList[i]);
      if Lreq.Id = id then
        break
      else lReq := nil;
    end;
  finally
    fWaitingRequests.UnlockList;
  end;
  if lReq = nil then
    raise EROTimeout.Create('Unknown response id '+iMessageID);

  try
    if lReq.fEvent <> nil then
      lReq.fEvent.WaitFor(fRequestTimeout);
    if lReq.fResultData = nil then begin
      case lReq.ResultErrorCode of
        ScCmdNoAck_MsgTooLarge: raise EROException.Create('Message from server too large');
        ScCmdNoAck_QueueFull: raise EROException.Create('Server queue full');
        else raise EROTimeout.Create('Timeout waiting for response');
      end;
    end;
    lREq.Resultdata.Seek(0, soFromBeginning);
  {$IFDEF RemObjects_UseEncryption}
    if Encryption.EncryptionMethod <> tetNone then
      DoDecryption(lReq.Resultdata, aResponse)
    else
  {$ENDIF}
      aResponse.CopyFrom(lReq.Resultdata, lReq.Resultdata.Size);
    aResponse.Seek(0, soFromBeginning);
  finally
    fWaitingRequests.Remove(lReq);
    lReq.Free;
  end;
end;

procedure TROCustomSuperTCPChannel.SetActive(const Value: Boolean);
var
  fw: TThread;
begin
  if (fActive = value) then begin
    if not fActive or (fState <> scNotConnected) then
      Exit;
  end;
  fActive := value;
  if ComponentState * [csLoading] = [] then
  begin
    if (fWorkerThread <> nil) then
    begin
      fw := fWorkerThread;
      fWorkerThread := nil;
      fClient.Disconnect;
      TROClientThread(fw).Terminate;
      fw.WaitFor;
      FreeAndNil(fw);
      fState := scNotConnected;
    end;
    if fEventThreadPool = nil then
    begin
      EventThreadPool := TROThreadPool.Create(nil);
      fOwnsEventThreadPool := true;
    end;
    if fActive then
    begin
      fReconnectEvent.SetEvent;
      fConnectEvent.ResetEvent;
      fState := scConnecting;
      fWorkerThread := TROClientThread.Create(fClient);
    end;
  end;
end;

procedure TROCustomSuperTcpChannel.SetClientID(const Value: TGUID);
begin
  fClient.ClientID := Value;
end;

procedure TROCustomSuperTcpChannel.SetEventThreadPool(
  const Value: TROThreadPool);
begin
  if fOwnsEventThreadPool then
  begin
    fEventThreadPool.Free;
    fOwnsEventThreadPool := false;
  end;
  fEventThreadPool := Value;
end;

procedure TROCustomSuperTCPChannel.SetHost(const Value: string);
begin
  if fActive and (csLoading in ComponentState) then
    raise Exception.Create('Client is active');
  fHost := value;
end;

procedure TROCustomSuperTcpChannel.SetMaxPackageSize(val: Integer);
begin
  fClient.MaxPackageSize := Val;
end;

procedure TROCustomSuperTcpChannel.SetPingSecs(const Value: Integer);
begin
  if (Value < 10) or (Value > 60) then raise Exception.Create('PingSecs has to be between 10 and 60');
  fPingSecs := Value;
end;

procedure TROCustomSuperTCPChannel.SetPort(const Value: Integer);
begin
  if fActive and (csLoading in ComponentState) then
    raise Exception.Create('Client is active');
  fPort := Value;
end;

procedure TROCustomSuperTcpChannel.SetSkipAck(const Value: Boolean);
begin
  fClient.SkipAck := Value;
end;

procedure TROCustomSuperTcpChannel.UnregisterEventReceiver(
  aReceiver: IROEventReceiver);
begin
  if assigned(fEventReceiver) then
    TComponent(fEventReceiver.GetObject).RemoveFreeNotification(Self);
  fEventReceiver := nil;
end;

type
  TROSBEventTrigger = class(TInterfacedObject, IROThreadPoolCallback)
  private
    fEvent: TNotifyEvent;
    fSender: TObject;
    procedure Execute;
  public
    constructor Create(aSender: TObject; aEvent: TNotifyEvent);
    procedure Callback(Caller: TROThreadPool; aThread: TThread);
  end;

procedure TROCustomSuperTcpChannel.WaitForActive(const Timeout: Integer);
begin
  SetActive(true);
  if fConnectEvent.WaitFor(Timeout) <> wrSignaled then raise EROException.Create('No connection available');
end;

{ TROSCClientWorker }

procedure TROSCClientWorker.Connected;
begin
  inherited;
  fOwner.fState := scConnected;
  fOwner.fConnectEvent.SetEvent;
  if assigned(fOwner.fOnConnected) then begin
    if fOwner.fSynchronizeEvents then
      fOwner.fEventThreadPool.QueueItem(TROSBEventTrigger.Create(fOwner, fOwner.fOnconnected))
    else
      fOwner.fOnconnected(fOwner);
  end;
end;

constructor TROSCClientWorker.Create(aOwner: TROCustomSuperTCPChannel;
  aConnection: TIdTCPConnection);
begin
  fOwner := aOwner;
  inherited Create(aConnection);
  PingFrequency := fOwner.fPingSecs;
  PingTimeout := PingFrequency * 15 div 10;
end;

procedure TROSCClientWorker.Disconnected(var RestartLoop: Boolean);
// restartloop is false by default
begin
  inherited;

  try
    fOwner.fConnection.Disconnect;
  except
  end;
  if assigned(fOwner.fOnDisconnected) then begin
    if fOwner.fSynchronizeEvents then
      fOwner.fEventThreadPool.QueueItem(TROSBEventTrigger.Create(fOwner, fOwner.fOnDisconnected))
    else
      fOwner.fOnDisconnected(fOwner);
  end;
  if fOwner.fActive and fOwner.fAutoReconnect and not fSkipReconnect then
    fOwner.fState := scReconnecting
  else begin
    fOwner.fState := scNotConnected;
    fOwner.fActive := false;
    fOwner.fConnectEvent.ResetEvent;
    exit;
  end;

  fOwner.fReconnectEvent.ResetEvent;
  fOwner.fConnectEvent.ResetEvent;
  while fOwner.fActive and fOwner.fAutoReconnect and not fSkipReconnect do
  begin
    fOwner.fReconnectEvent.WaitFor(fOwner.fReconnectDelay); // don't want to create a tight loop
    try
      fOwner.fReconnectEvent.ResetEvent;
      fOwner.fConnection.Connect;
      RestartLoop := True;
      Break;
    except
      // we failed, retry in a few
    end;
  end;
  if RestartLoop then
    fOwner.fState := scConnecting
  else begin
    fowner.fState := scNotConnected;
    fOwner.fActive := false;
    fOwner.fConnectEvent.ResetEvent;
  end;
end;

procedure TROSCClientWorker.Idle;
begin
  IF fOwner.IdleTimeoutMinutes > 0 then begin
    if Now > LastData + ((1.0 / 24 / 60) * fOwner.IdleTimeoutMinutes) then begin
      Disconnect;
      fSkipReconnect := true;
    end;
  end;

end;

procedure TROSCClientWorker.IncomingData(Id: Integer; aData: TStream);
begin
  fOwner.HasData(id, aData);
end;

procedure TROSCClientWorker.SetAckDetails(Id: Integer; Oke: Boolean;
  ErrorNo: Integer);
var
  lList: TList;
  i: Integer;
  lReq: TROWaitingRequest;
begin
  if Oke then begin
    inherited;
    exit;
  end;
  lList := FOwner.fWaitingRequests.LockList;
  try
    lReq := nil;
    for i := lList.Count -1 downto 0 do
    begin
      if TROWaitingRequest(lList[i]).Id = Id then
      begin
        lReq := TROWaitingRequest(lList[i]);
        break;
      end;
    end;
    if lReq = nil then
      inherited
    else begin
      lReq.fResultErrorCode := ErrorNo;
      lReq.Event.SetEvent;
    end;
  finally
    fOwner.fWaitingRequests.UnlockList;
  end;
end;

{ TROClientThread }

constructor TROClientThread.Create(aChannel: TROSCClientWorker);
begin
  inherited Create(True);
  fChannel := aChannel;
  FreeOnTerminate := false;
  Resume;
end;

procedure TROClientThread.Execute;
var
  lRet: Boolean;
begin
  TIdTCPClient(fChannel.Connection).Host := fChannel.Owner.fHost;
  TIdTCPClient(fChannel.Connection).Port := fChannel.Owner.fPort;
  lRet := true;
  fConnecting := True;
  while lRet do begin
    lRet := false;
    try
      TIdTCPClient(fChannel.Connection).Connect;
    except
      on e: Exception do begin
        if fChannel.Owner.AutoReconnect then begin
           lRet := true;
           fChannel.fOwner.fReconnectEvent.WaitFor(fChannel.fOwner.fReconnectDelay);
        end;
        if assigned(fChannel.Owner.OnException) then fChannel.Owner.OnException(fChannel.Owner, e, lRet);
        if not lRet then begin
          fConnecting := False;
          exit;
        end;
      end;
    end;
  end;
  fChannel.DoExecute;
end;

{ TROWaitingRequest }

constructor TROWaitingRequest.Create(Id: Integer);
begin
  inherited Create;
  fId := Id;
  fEvent := TROEvent.Create(nil, true, false, '');
  fFreeEvent := True;
  fResultErrorCode := -1;
end;

constructor TROWaitingRequest.Create(Id: Integer; Ev: TROEvent);
begin
  inherited Create;
  fId := Id;
  fEvent := ev;
  fResultErrorCode := -1;
end;

destructor TROWaitingRequest.Destroy;
begin
  fResultData.Free;
  if fFreeEvent then
    fEvent.Free;
  inherited Destroy;
end;

{ TROPooledEvent }

procedure TROPooledEvent.Callback(Caller: TROThreadPool; Thread: TThread);
begin
  if fOwner.fEventReceiver <> nil then
  begin
    fOwner.fEventReceiver.Dispatch(fData, Thread);
  end;
end;

constructor TROPooledEvent.Create(aData: TStream;
  aOwner: TROCustomSuperTCPChannel);
begin
  inherited Create;
  fOwner := aOwner;
  fData := aData;
end;

destructor TROPooledEvent.Destroy;
begin
  fData.Free;
  inherited Destroy;
end;

{ TROSBEventTrigger }

procedure TROSBEventTrigger.Callback(Caller: TROThreadPool;
  aThread: TThread);
begin
  try
    TROClientThread(aThread).Synchronize(Execute);
  except
    // exceptions cannot pass back to the pool
  end;
end;

constructor TROSBEventTrigger.Create(aSender: TObject;
  aEvent: TNotifyEvent);
begin
  inherited Create;
  fSender := aSender;
  fEvent := aEvent;
end;

procedure TROSBEventTrigger.Execute;
begin
  if assigned(fEvent) then
    fEvent(fSender);
end;

initialization
  RegisterTransportChannelClass(TROSuperTcpChannel);

finalization
  UnRegisterTransportChannelClass(TROSuperTcpChannel);

end.