Componentes.Terceros.RemObjects/official/5.0.35.741/RemObjects SDK for Delphi/Source/uROIcsAsyncSuperTcpServer.pas

unit uROIcsAsyncSuperTcpServer;

{$I RemObjects.inc}
interface

uses
  Classes, Messages, SySutils, SyncObjs, Contnrs,
  uROAsyncSuperTcpServer, uROAsyncSCHelpers, uROClientIntf, uROServerIntf,
  uROThreadPool, uROSessions
  {$IFDEF RemObjects_ICS_v5} , WSocket, WSocketS {$ENDIF}
  {$IFDEF RemObjects_ICS_v6} , OverbyteIcsWSocket, OverbyteIcsWSocketS {$ENDIF}
  ;

type
  // forward declarations
  TROIcsTCPConnection = class;
  TROAsyncSuperTcpServerSocketClient = class;

  // A thread that reads messages for a given number of sockets
  TROIcsMessagePumpThread = class(TROInitializedThread)
  private
    FAddedSocketsSection: TCriticalSection;
    FRemovedSocketsSection: TCriticalSection;
    FSockets: TObjectList;
    FAddedSockets: TObjectList;
    FRemovedSockets: TObjectList;

    function GetSocket(Index: Integer): TCustomWSocket;
    property Sockets[Index: Integer]: TCustomWSocket read GetSocket;

    procedure InternalRemoveSocket(ASocket: TCustomWSocket);

    procedure LockAddedSockets;
    procedure UnlockAddedSockets;
    procedure LockRemovedSockets;
    procedure UnlockRemovedSockets;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Execute; override;

    procedure AddSocket(ASocket: TCustomWSocket);
    procedure RemoveSocket(ASocket: TCustomWSocket);
  end;

  // A server socket
  TROWSocketServer = class(TCustomWSocketServer)
  protected
    FMessagePumpThread: TROIcsMessagePumpThread;
    
    procedure WndProc(var MsgRec: TMessage); override;
    procedure InternalClose(bShut : Boolean; Error : Word); override;
    procedure TriggerClientConnect(Client : TWSocketClient; Error : Word); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Listen; override;
    property ClientCount;
    property Client;
  end;

  // Server component
  TROCustomIcsAsyncSuperTcpServer = class(TROBaseAsyncSuperTcpServer)
  private
    fPort: Integer;
    FServerSocket: TROWSocketServer;
    FWorkers: TObjectList;
    fAutoRegisterSession: Boolean;

    procedure SetPort(const Value: Integer);
    procedure ServerSocketClientCreate(Sender: TObject; Client: TWSocketClient);
    procedure ServerSocketClientConnect(Sender: TObject; Client: TWSocketClient; Error: Word);
    procedure ServerSocketClientDisconnect(Sender: TObject; Client: TWSocketClient; Error: Word);
    procedure ServerSocketBgException(Sender: TObject; E: Exception; var CanClose: Boolean);
  protected
    procedure IntSetActive(const Value: boolean); override;
    function IntGetActive: boolean; override;

    procedure Connect;
    procedure Disconnect;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    property Port: Integer read fPort write SetPort default 8095;
    property ServerSocket: TROWSocketServer read FServerSocket;
    property AutoRegisterSession: Boolean read fAutoRegisterSession write fAutoRegisterSession default true;
  end;

  TROIcsAsyncSuperTCPServer = class(TROCustomIcsAsyncSuperTcpServer)
  published
    property Port;
    property AutoRegisterSession;
  end;

  // Server component worker
  TROIcsAsyncSuperChannelWorker = class(TROAsyncSuperChannelWorker, IROTCPTransport, IROActiveEventServer)
  private
    FServer: TROCustomIcsAsyncSuperTcpServer;
    FClient: TROAsyncSuperTcpServerSocketClient;
    FEventManager: IROSessionsChangesListener;
  protected
    { IROTCPTransport }
    function GetClientAddress : string;

    { IROActiveEventServer }
    procedure EventsRegistered(aSender : TObject; aClient: TGUID);
    procedure DispatchEvent(anEventDataItem : TROEventData; aSessionReference : TGUID; aSender: TObject);

    // overriden methods
    procedure IncomingData(Id: Integer; aData: TByteArray); override;
    procedure Connected; override;
    procedure Disconnected(var RestartLoop: Boolean); override;
  public
    constructor Create(AServer: TROCustomIcsAsyncSuperTcpServer; AClient: TROAsyncSuperTcpServerSocketClient);
    destructor Destroy; override;
  end;

  // Client socket
  TROAsyncSuperTcpServerSocketClient = class(TWSocketClient)
  private
    FAbstractTCPConnection: TROIcsTCPConnection;
    FWorker: TROIcsAsyncSuperChannelWorker;

    FOnDisconnected: TROAsyncCallback;
    FOnHaveIncompleteData: TROAsyncCallback;

    FInternalReceiveBuffer: array of Byte;
    FInternalReceivedBytes: Integer;

    FRequestedReceiveBytes: Integer;
    FReceiveBuffer: Pointer;
    FReceivedBytes: Integer;
    FReceiveCallback: TROAsyncCallback;

    FSentBytes: Integer;
    FSendCallback: TROAsyncCallback;

    FError: Boolean;
    FConnectCallback: TROAsyncCallback;
    FDisconnectCallback: TROAsyncCallback;

    FMessagePumpThread: TROIcsMessagePumpThread;

    procedure ReceiveBytes;
    function InternalReceive(Buffer : Pointer; BufferSize: Integer): Integer; 

    procedure DoSendCallback;
    procedure DoConnectCallback;
    procedure DoDisconnectCallback;
    procedure DoReceiveCallback;
    procedure DoOnDisconnected;
    procedure DoOnHaveIncompleteData;
  protected
    // overriden from TWSocket
    procedure TriggerDataSent(Error: Word); override;
    procedure TriggerSessionConnectedSpecial(Error : Word); override;
    procedure TriggerSessionConnected(Error: Word); override;
    procedure TriggerError; override;
    function TriggerDataAvailable(Error: Word): Boolean; override;

    // These ones are event handlers because there is no TriggerXXX for them
    procedure HandleBgException(Sender: TObject; E: Exception; var CanClose: Boolean);
  public
    // overriden from TWSocket
    procedure TriggerSessionClosed(Error: Word); override;
    procedure StartConnection; override;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function GetAbstractTCPConnection: IROAbstractTCPConnection;
  end;

  IROAsyncICSSocket = interface
  ['{969B866F-9487-4359-86A7-2B1B098D2D38}']
    function GetSelf: TROIcsTCPConnection;
  end;

  // Class for interface
  TROIcsTCPConnection = class(TInterfacedObject, IROAbstractTCPConnection, IROAsyncICSSocket)
  private
    FClientSocket: TROAsyncSuperTcpServerSocketClient;
  protected
    { IROAbstractTCPConnection }
    procedure BeginReceive(aData: Pointer; aSize: Integer; aCallback: TROAsyncCallback);
    procedure BeginSend(aData: Pointer; aSize: Integer; aCallback: TROAsyncCallback);

    function EndReceive: Integer;
    function EndSend: Integer;

    procedure BeginDisconnect(aForce: Boolean; aCallback: TROAsyncCallback);
    procedure EndDisconnect;

    procedure BeginConnect(const aAdress: string; aPort: Integer; aCallback: TROAsyncCallback);
    function EndConnect: Boolean;

    procedure SetOnDisconnected(aCallback: TROAsyncCallback);
    function GetOnDisconnected: TROAsyncCallback;

    procedure SetOnHaveIncompleteData(aCallback: TROAsyncCallback);
    function GetOnHaveIncompleteData: TROAsyncCallback;
    function GetSelf: TROIcsTCPConnection;
  public
    constructor Create(ClientSocket: TROAsyncSuperTcpServerSocketClient);
    destructor Destroy; override;
  end;

implementation

uses
  Math, Windows, Winsock, uROClasses, uROEventRepository, uROTypes;

const
  InternalReceiveBufferSize = 1024;  // Size in bytes of the internal receive buffer, for each client socket

var
  FServerSocketsMessagePump: TROIcsMessagePumpThread;
  FClientSocketsMessagePump: TROIcsMessagePumpThread;

function GetServerSocketMessagePump(ASocket: TCustomWSocket): TROIcsMessagePumpThread;
begin
  if not Assigned(FServerSocketsMessagePump) then
    FServerSocketsMessagePump := TROIcsMessagePumpThread.Create;

  Result := FServerSocketsMessagePump;
//  Result.FForClients := False;
  Result.AddSocket(ASocket);
end;

function GetClientSocketMessagePump(ASocket: TCustomWSocket): TROIcsMessagePumpThread;
begin
  if not Assigned(FClientSocketsMessagePump) then
    FClientSocketsMessagePump := TROIcsMessagePumpThread.Create;

  Result := FClientSocketsMessagePump;
//  Result.FForClients := True;
  Result.AddSocket(ASocket);
end;

{ TROWSocketServer }

procedure TROWSocketServer.InternalClose(bShut: Boolean; Error: Word);
var
  I: Integer;
begin
  inherited InternalClose(bShut, Error);

  // to mimick what Indy is doing, we disconnect all clients
  for I := 0 to ClientCount - 1 do
    Client[I].CloseDelayed;
end;

procedure TROWSocketServer.Listen;
begin
  inherited Listen;
end;

procedure TROWSocketServer.TriggerClientConnect(Client: TWSocketClient;
  Error: Word);
var
  optval: Integer;
  iStatus: Integer;
begin
  inherited TriggerClientConnect(Client, Error);

  if wsoTcpNoDelay in FComponentOptions then
  begin
    optval := -1; { true, 0=false }
    iStatus := WSocket_setsockopt(Client.HSocket, IPPROTO_TCP, TCP_NODELAY, @optval, SizeOf(optval));
    if iStatus <> 0 then
    begin
      SocketError('setsockopt(IPPROTO_TCP, TCP_NODELAY)');
      Exit;
    end;
  end;
end;

constructor TROWSocketServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ComponentOptions := ComponentOptions + [wsoTcpNoDelay];
end;

destructor TROWSocketServer.Destroy;
begin
  inherited Destroy;

  // Done after because the inherited Destroy might want to do some network cleanup
  if Assigned(FMessagePumpThread) then
    FMessagePumpThread.RemoveSocket(Self);
end;

procedure TROWSocketServer.WndProc(var MsgRec: TMessage);
begin
  inherited WndProc(MsgRec);
end;

{ TROCustomIcsAsyncSuperTcpServer }

procedure TROCustomIcsAsyncSuperTcpServer.Connect;
begin
  // Assign properties here as Close clears them
  FServerSocket.Port := IntToStr(fPort);
  FServerSocket.Proto := 'tcp';
  FServerSocket.Addr := '0.0.0.0';  // Listen on any interface 
  FServerSocket.Listen;
end;

constructor TROCustomIcsAsyncSuperTcpServer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);

  fPort := 8095;

  FWorkers := TObjectList.Create;

  FServerSocket := TROWSocketServer.Create(nil);
  FServerSocket.ClientClass := TROAsyncSuperTcpServerSocketClient;
  FServerSocket.Banner := '';
  FServerSocket.BannerTooBusy := '';
  FServerSocket.OnClientCreate := ServerSocketClientCreate;
  FServerSocket.OnClientConnect := ServerSocketClientConnect;
  FServerSocket.OnClientDisconnect := ServerSocketClientDisconnect;
  FServerSocket.OnBgException := ServerSocketBgException;
  FServerSocket.FMessagePumpThread := GetServerSocketMessagePump(FServerSocket);
  fAutoRegisterSession:= False;
end;

destructor TROCustomIcsAsyncSuperTcpServer.Destroy;
var
  i: Integer;
begin
  for i := FWorkers.Count -1 downto 0 do begin
    fWorkers[i] := nil;
  end;
  inherited Destroy;

  // Done after because the inherited Destroy sets Active to False which
  // tries to disconnect the socket
  FServerSocket.Free;
  FWorkers.Free;
end;

procedure TROCustomIcsAsyncSuperTcpServer.Disconnect;
begin
  FServerSocket.Close;
end;

function TROCustomIcsAsyncSuperTcpServer.IntGetActive: boolean;
begin
  Result := not (FServerSocket.State in [wsClosed, wsInvalidState]); 
end;

procedure TROCustomIcsAsyncSuperTcpServer.IntSetActive(const Value: boolean);
begin
  if Value <> Active then
  begin
    if fThreadPool = nil then begin
      fThreadPool := TROThreadPool.Create(nil);
      fOwnsThreadpool := true;
    end;

    if Value then
      Connect
    else
      Disconnect;
  end;
end;

// This handler is called when a listening (server) socket experienced a
// background exception. Should normally never occurs.
procedure TROCustomIcsAsyncSuperTcpServer.ServerSocketBgException(
  Sender: TObject; E: Exception; var CanClose: Boolean);
begin
  raise EROException.CreateFmt('Server exception %s occured: %s', [E.ClassName, E.Message]);
  CanClose := False;  // Let's hope server can still continue
end;

procedure TROCustomIcsAsyncSuperTcpServer.ServerSocketClientConnect(
  Sender: TObject; Client: TWSocketClient; Error: Word);
var
  Worker: TROIcsAsyncSuperChannelWorker;
begin
  Worker := TROIcsAsyncSuperChannelWorker.Create(Self, Client as TROAsyncSuperTcpServerSocketClient);
  Worker.DoSetup;
  
  FWorkers.Add(Worker);
end;

procedure TROCustomIcsAsyncSuperTcpServer.ServerSocketClientCreate(
  Sender: TObject; Client: TWSocketClient);
begin
  TROAsyncSuperTcpServerSocketClient(Client).FMessagePumpThread := GetClientSocketMessagePump(Client);
end;

procedure TROCustomIcsAsyncSuperTcpServer.ServerSocketClientDisconnect(
  Sender: TObject; Client: TWSocketClient; Error: Word);
begin
  // Wait for client to be actually disconnected before removing the worker
  while Client.State <> wsClosed do
    SleepEx(5, True);
  
  FWorkers.Remove((Client as TROAsyncSuperTcpServerSocketClient).FWorker);
end;

procedure TROCustomIcsAsyncSuperTcpServer.SetPort(const Value: Integer);
begin
  if fPort <> Value then
  begin
    fPort := Value;
    FServerSocket.Port := IntToStr(fPort);
  end;
end;

{ TROAsyncSuperTcpServerSocketClient }

constructor TROAsyncSuperTcpServerSocketClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  // No receive loop so that when the "TriggerDataAvailable" code could not
  // read all the data available, the message pump is not stopped and any other
  // client socket associated to it continues to work.
  ComponentOptions := ComponentOptions + [wsoNoReceiveLoop, wsoTcpNoDelay];

  SetLength(FInternalReceiveBuffer, InternalReceiveBufferSize);
  OnBgException := HandleBgException;
end;

destructor TROAsyncSuperTcpServerSocketClient.Destroy;
begin
  inherited Destroy;

  // Done after because the inherited Destroy might want to do some network cleanup
  if Assigned(FMessagePumpThread) then
    FMessagePumpThread.RemoveSocket(Self);

  if Assigned(FAbstractTCPConnection) then
    FAbstractTCPConnection.FClientSocket := nil;  

  SetLength(FInternalReceiveBuffer, 0);
end;

procedure TROAsyncSuperTcpServerSocketClient.DoConnectCallback;
begin
  if Assigned(FConnectCallback) then
    FConnectCallback(GetAbstractTcpConnection);
end;

procedure TROAsyncSuperTcpServerSocketClient.DoDisconnectCallback;
begin
  if Assigned(FDisconnectCallback) then
    FDisconnectCallback(GetAbstractTcpConnection);
end;

procedure TROAsyncSuperTcpServerSocketClient.DoOnDisconnected;
begin
  if Assigned(FOnDisconnected) then
    FOnDisconnected(GetAbstractTcpConnection);
end;

procedure TROAsyncSuperTcpServerSocketClient.DoOnHaveIncompleteData;
begin
  if Assigned(FOnHaveIncompleteData) then
    FOnHaveIncompleteData(GetAbstractTcpConnection);
end;

procedure TROAsyncSuperTcpServerSocketClient.DoReceiveCallback;
begin
  if Assigned(FReceiveCallback) then
    FReceiveCallback(GetAbstractTcpConnection);
end;

procedure TROAsyncSuperTcpServerSocketClient.DoSendCallback;
begin
  if Assigned(FSendCallback) then
    FSendCallback(GetAbstractTcpConnection);
end;

function TROAsyncSuperTcpServerSocketClient.GetAbstractTCPConnection: IROAbstractTCPConnection;
begin
  if not Assigned(FAbstractTCPConnection) then
    FAbstractTCPConnection := TROIcsTCPConnection.Create(Self);
    
  Result := FAbstractTCPConnection;
end;

// This event handler is called when a client socket experience a background
// exception. It is likely to occurs when client aborted connection and data
// has not been sent yet.
// Warning: This procedure is executed in worker thread context.
procedure TROAsyncSuperTcpServerSocketClient.HandleBgException(Sender: TObject;
  E: Exception; var CanClose: Boolean);
begin
  raise EROException.CreateFmt('Client exception %s occured: %s', [E.ClassName, E.Message]);
  CanClose := True;  // kill client connection
end;

function TROAsyncSuperTcpServerSocketClient.InternalReceive(Buffer: Pointer;
  BufferSize: Integer): Integer;
begin
  Result := Min(BufferSize, FInternalReceivedBytes);
  if Result > 0 then
  begin
    // Copy bytes into destination buffer
    CopyMemory(Buffer, FInternalReceiveBuffer, Result);

    // Shift remaining bytes (if any) in the internal buffer.
    Dec(FInternalReceivedBytes, Result);
    if FInternalReceivedBytes > 0 then
      MoveMemory(FInternalReceiveBuffer, @(FInternalReceiveBuffer[Result]), FInternalReceivedBytes);
  end;
end;

procedure TROAsyncSuperTcpServerSocketClient.ReceiveBytes;
var
  ReadBytes: Integer;
begin
  if Assigned(FReceiveBuffer) then
  begin
    // Retrieve the bytes from the internal buffer, if any are available
    ReadBytes := InternalReceive(FReceiveBuffer, FRequestedReceiveBytes - FReceivedBytes);
    if ReadBytes >= 0 then
    begin
      Inc(FReceivedBytes, ReadBytes);
      Inc(PByte(FReceiveBuffer), ReadBytes);
      if FReceivedBytes >= FRequestedReceiveBytes then
        DoReceiveCallback;
    end;
  end;
end;

procedure TROAsyncSuperTcpServerSocketClient.StartConnection;
begin
  inherited StartConnection;

  DoConnectCallback;
end;

function TROAsyncSuperTcpServerSocketClient.TriggerDataAvailable(
  Error: Word): Boolean;
var
  ReadBytes: Integer;
begin
  inherited TriggerDataAvailable(Error);

  // Read the available data into our internal buffer if it can hold more data
  if FInternalReceivedBytes < InternalReceiveBufferSize  then
  begin
    ReadBytes := Receive(@(FInternalReceiveBuffer[FInternalReceivedBytes]), InternalReceiveBufferSize - FInternalReceivedBytes);
    if ReadBytes >= 0 then
      Inc(FInternalReceivedBytes, ReadBytes);
  end;

  // Notify that we have data and immediately try to read them, the callback
  // might have requested it already. Note that this last part is not strictly
  // required as the message pump would do it, but it allows faster processing
  // and less stress on the data buffer when transferring large chunks of data.
  DoOnHaveIncompleteData;
  ReceiveBytes;

  // Return True to indicate that we have read the data.
  Result := True;
end;

procedure TROAsyncSuperTcpServerSocketClient.TriggerDataSent(Error: Word);
begin
  inherited TriggerDataSent(Error);

  DoSendCallback;
end;

procedure TROAsyncSuperTcpServerSocketClient.TriggerError;
begin
  inherited TriggerError;

  FError := True;
end;

procedure TROAsyncSuperTcpServerSocketClient.TriggerSessionClosed(Error: Word);
begin
  // The inherited call will notify the server socket through messaging. So
  // we do any cleanup before the server is notified as our cleanup must not
  // be disturbed by the server doing its own cleanup.
  DoDisconnectCallback;
  DoOnDisconnected;
  
  inherited TriggerSessionClosed(Error);
end;

procedure TROAsyncSuperTcpServerSocketClient.TriggerSessionConnected(
  Error: Word);
begin
  inherited TriggerSessionConnected(Error);
end;

procedure TROAsyncSuperTcpServerSocketClient.TriggerSessionConnectedSpecial(
  Error: Word);
begin
  inherited TriggerSessionConnectedSpecial(Error);
end;

{ TROIcsAsyncSuperChannelWorker }

procedure TROIcsAsyncSuperChannelWorker.Connected;
var
  data, rs: Binary;
  evd: TROEventData;
  i, len: Longint;
  fl: boolean;
begin
  if assigned(FServer.OnClientConnected) then
    FServer.OnClientConnected(Self, ClientID);
  FServer.fClients.LockList;
  try
    i := FServer.GuidToClientMap.IndexOf(GUIDToString(ClientId));
    if i = -1 then
      FServer.GuidToClientMap.AddObject(GUIDToString(ClientId), Self)
    else
      FServer.GuidToClientMap.Objects[i] := Self;
  finally
    FServer.fClients.UnlockList;
  end;
  if FServer.EventRepository <> nil then
  begin
    if FServer.AutoRegisterSession then begin
      fl := True;
      FServer.EventRepository.AddSession(ClientID, Self);
    end
    else begin
      fl := FServer.EventRepository.AddActiveListener(ClientID, Self);
    end;
    if fl then begin
      rs := Binary.Create;
      try
        FServer.EventRepository.GetEventData(ClientID, rs);
        rs.Position := 0;
        if rs.Read(len, sizeof(len)) <> sizeof(len) then exit;
        while true do begin
          if rs.Read(len, sizeof(len)) <> sizeof(len) then break;
          data := Binary.Create;
          data.CopyFrom(rs, Len);
          data.Position := 0;
          evd := TROEventData.Create(data);
          try
            DispatchEvent(evd, ClientID, FServer.EventRepository);
          finally
            data.Free;
          end;
        end;
      finally
        rs.Free;
      end;
    end;
  end;
end;

constructor TROIcsAsyncSuperChannelWorker.Create(
  AServer: TROCustomIcsAsyncSuperTcpServer; AClient: TROAsyncSuperTcpServerSocketClient);
begin
  inherited Create(AClient.GetAbstractTCPConnection);

  FServer := AServer;
  FClient := AClient;

  IsServer := True;
  FServer.FClients.Add(self);
  FClient.FWorker := Self;
end;

destructor TROIcsAsyncSuperChannelWorker.Destroy;
begin
  FServer.FClients.Remove(self);
  inherited Destroy;
end;

procedure TROIcsAsyncSuperChannelWorker.Disconnected(var RestartLoop: Boolean);
var
  i: Integer;
begin
  if fEventManager <> nil then
    fEventManager.SessionsChangedNotification(ClientID, saRemoveActiveListener, Self);
  FServer.fClients.LockList;
  try
    i := FServer.GuidToClientMap.IndexOf(GUIDToString(ClientId));
    if i <> -1 then
    begin
      if FServer.GuidToClientMap.Objects[i] = self then
        FServer.GuidToClientMap.Delete(i);
    end;
  finally
    FServer.fClients.UnlockList;
  end;
  if assigned(FServer.OnClientDisconnected) then FServer.OnClientDisconnected(Self, ClientID);
end;

procedure TROIcsAsyncSuperChannelWorker.DispatchEvent(
  anEventDataItem: TROEventData; aSessionReference: TGUID; aSender: TObject);
var
  se: TSendEvent;
begin
  se := TSendEvent.Create(FServer, aSessionReference, TROEventRepository(aSender), anEventDataItem);
  se.WorkerOverride := self;
  if FServer.BlockingEvents then
  begin
    try
      se.Callback(FServer.ThreadPool, nil);
    except
    end;
    se.Free;
  end
  else
  begin
    FServer.ThreadPool.QueueItem(se);
  end;
end;

procedure TROIcsAsyncSuperChannelWorker.EventsRegistered(aSender: TObject;
  aClient: TGUID);
var
  lNew : IROSessionsChangesListener;
begin
  Supports(aSender, IROSessionsChangesListener, lNew);
  if (fEventManager <> nil) and (lNew <> fEventManager) then
  begin
    fEventManager.SessionsChangedNotification(aClient, saRemoveActiveListener, Self);
  end;
  fEventManager := lNew;
end;

function TROIcsAsyncSuperChannelWorker.GetClientAddress: string;
begin
  if not (FClient.State in [wsInvalidState, wsConnecting, wsClosed]) then
    Result := FClient.PeerAddr
  else
    Result := '';
end;

procedure TROIcsAsyncSuperChannelWorker.IncomingData(Id: Integer;
  aData: uROAsyncSCHelpers.TByteArray);
var
  Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    Stream.Write(aData[0], Length(aData));
    FServer.HasData(Id, Self, Stream);
  except // only on failure
    Stream.Free;
    raise;
  end;
end;

{ TMessagePumpThread }

procedure TROIcsMessagePumpThread.AddSocket(ASocket: TCustomWSocket);
begin
  if not Assigned(ASocket) then
    Exit;

  // Detach from current thread
  ASocket.ThreadDetach;
  TWSocket(ASocket).MultiThreaded := True;

  // Add socket to list of sockets waiting to be added
  LockAddedSockets;
  try
    FAddedSockets.Add(ASocket);
  finally
    UnlockAddedSockets;
  end;

  // Wait for socket to be completely added
  while FAddedSockets.Count > 0 do
    SleepEx(1, True);
end;

constructor TROIcsMessagePumpThread.Create;
begin
  inherited Create(True);

  FAddedSocketsSection := TCriticalSection.Create;
  FRemovedSocketsSection := TCriticalSection.Create;

  FSockets := TObjectList.Create(False);
  FAddedSockets := TObjectList.Create(False);
  FRemovedSockets := TObjectList.Create(False);

  Resume;
end;

destructor TROIcsMessagePumpThread.Destroy;
begin
  inherited Destroy;

  FSockets.Free;
  FAddedSockets.Free;
  FRemovedSockets.Free;

  FAddedSocketsSection.Free;
  FRemovedSocketsSection.Free;
end;

type
  TAccessWSocket = class(TCustomWSocket);

procedure TROIcsMessagePumpThread.Execute;
var
  MsgRec: TMsg;
  I: Integer;
  CurSocket: TCustomWSocket;
  CanSleep: Boolean;
begin
  // Process messages until WM_QUIT has been received or Terminated set to True
  repeat
    CanSleep := True;

    // Got a message? Process it and do it first in the loop as its processing
    // can trigger code that adds sockets, removes some, requests bytes...
    if PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE) then
    begin
      TranslateMessage(MsgRec);
      DispatchMessage(MsgRec);
      CanSleep := False;
    end;

    // If new sockets are waiting, add them.
    if FAddedSockets.Count > 0 then
    begin
      LockAddedSockets;
      try
        while FAddedSockets.Count > 0 do
        begin
          // Attach client socket to this thread and inform main thread via the
          // removal of the socket from FAddedSockets.
          TCustomWSocket(FAddedSockets[0]).ThreadAttach;

          FSockets.Add(FAddedSockets[0]);
          FAddedSockets.Delete(0);

          // Now let main thread continue starting the connection. This little
          // pause avoids race condition.
          SleepEx(1, True);
        end;
      finally
        UnlockAddedSockets;
      end;
      CanSleep := False;
    end;

    // If sockets must be removed, remove them 
    if FRemovedSockets.Count > 0 then
    begin
      LockRemovedSockets;
      try
        while FRemovedSockets.Count > 0 do
        begin
          // Detach socket before removing it, which will notify main thread
          // that the socket is cleanly detached.
          InternalRemoveSocket(TCustomWSocket(FRemovedSockets[0]));
          FRemovedSockets.Delete(0);

          // Now let main thread continue closing the connection. This little
          // pause avoids race condition.
          SleepEx(1, True);
        end;
      finally
        UnlockRemovedSockets;
      end;
      CanSleep := False;
    end;

    // A client socket might have received more bytes than what the worker
    // class has requested at first, for instance received 6 and 5 were
    // initially requested. Those 5 are read by the OnHaveIncompleteData
    // callback, and analysed. This triggers the request for one more byte.
    // But if we did not call ReceiveBytes here, this byte would never be read
    // and would stay in the buffer in front of the next bytes received later
    // on. Then the OnHaveIncompleteData done at that later time would trigger
    // the request of N bytes and get this extra byte in front of them. This
    // extra byte would then prevent the correct processing of the other bytes.
    for I := 0 to FSockets.Count - 1 do
    begin
      CurSocket := Sockets[I];
      if (CurSocket is TROAsyncSuperTcpServerSocketClient) and
         (TROAsyncSuperTcpServerSocketClient(CurSocket).FInternalReceivedBytes > 0) then
      begin
        TROAsyncSuperTcpServerSocketClient(CurSocket).ReceiveBytes;
        CanSleep := False;
      end;
    end;

    // If no action was taken during this loop, then we can sleep. This way
    // we do not have 100% CPU usage when idling but still process everything as
    // fast as possible.
    if CanSleep then
    begin
      SleepEx(1, True);
    end;
      
  until Terminated or (MsgRec.message = WM_QUIT);

  // Indicate to all sockets that they are terminated
  for I := 0 to FSockets.Count - 1 do
    TAccessWSocket(Sockets[I]).FTerminated := True;
    
  // Detach all remaining sockets
  while FSockets.Count > 0 do
    InternalRemoveSocket(Sockets[0]);
  SleepEx(1, True);
end;

function TROIcsMessagePumpThread.GetSocket(Index: Integer): TCustomWSocket;
begin
  Result := FSockets[Index] as TCustomWSocket; 
end;

procedure TROIcsMessagePumpThread.InternalRemoveSocket(ASocket: TCustomWSocket);
begin
  if ASocket is TROWSocketServer then
    TROWSocketServer(ASocket).FMessagePumpThread := nil;
  if ASocket is TROAsyncSuperTcpServerSocketClient then
    TROAsyncSuperTcpServerSocketClient(ASocket).FMessagePumpThread := nil;

  ASocket.ThreadDetach;
  FSockets.Remove(ASocket);
end;

procedure TROIcsMessagePumpThread.LockAddedSockets;
begin
  FAddedSocketsSection.Acquire;
end;

procedure TROIcsMessagePumpThread.LockRemovedSockets;
begin
  FRemovedSocketsSection.Acquire;
end;

procedure TROIcsMessagePumpThread.RemoveSocket(ASocket: TCustomWSocket);
begin
  // Removal must be done in the context of the thread to which the socket is attached
  FRemovedSockets.Add(ASocket);

  while FRemovedSockets.Count > 0 do
    SleepEx(1, True);
end;

procedure TROIcsMessagePumpThread.UnlockAddedSockets;
begin
  FAddedSocketsSection.Release;
end;

procedure TROIcsMessagePumpThread.UnlockRemovedSockets;
begin
  FRemovedSocketsSection.Release;
end;

{ TROIcsTCPConnection }

procedure TROIcsTCPConnection.BeginConnect(const aAdress: string;
  aPort: Integer; aCallback: TROAsyncCallback);
begin
  FClientSocket.FConnectCallback := aCallback;
  FClientSocket.Addr := aAdress;
  FClientSocket.Port := IntToStr(aPort);
  FClientSocket.Connect;
end;

procedure TROIcsTCPConnection.BeginDisconnect(aForce: Boolean;
  aCallback: TROAsyncCallback);
begin
  FClientSocket.FDisconnectCallback := aCallback;
  FClientSocket.CloseDelayed;
end;

procedure TROIcsTCPConnection.BeginReceive(aData: Pointer;
  aSize: Integer; aCallback: TROAsyncCallback);
begin
  FClientSocket.FReceiveCallback := aCallback;
  FClientSocket.FRequestedReceiveBytes := aSize;
  FClientSocket.FReceiveBuffer := aData;
  FClientSocket.FReceivedBytes := 0;
end;

procedure TROIcsTCPConnection.BeginSend(aData: Pointer;
  aSize: Integer; aCallback: TROAsyncCallback);
begin
  FClientSocket.FSendCallback := aCallback;
  FClientSocket.Send(aData, aSize);
  FClientSocket.FSentBytes := aSize;
end;

constructor TROIcsTCPConnection.Create(
  ClientSocket: TROAsyncSuperTcpServerSocketClient);
begin
  inherited Create;

  FClientSocket := ClientSocket;
end;

destructor TROIcsTCPConnection.Destroy;
begin
  if Assigned(FClientSocket) then
    FClientSocket.FAbstractTCPConnection := nil;
  
  inherited Destroy;
end;

function TROIcsTCPConnection.EndConnect: Boolean;
begin
  FClientSocket.FConnectCallback := nil;
  Result := True;
end;

procedure TROIcsTCPConnection.EndDisconnect;
begin
  FClientSocket.FDisconnectCallback := nil;
end;

function TROIcsTCPConnection.EndReceive: Integer;
begin
  FClientSocket.FReceiveBuffer := nil;
  FClientSocket.FReceiveCallback := nil;
  Result := FClientSocket.FReceivedBytes;
end;

function TROIcsTCPConnection.EndSend: Integer;
begin
  FClientSocket.Flush;
  FClientSocket.FSendCallback := nil;
  Result := FClientSocket.FSentBytes;
end;

function TROIcsTCPConnection.GetOnDisconnected: TROAsyncCallback;
begin
  if Assigned(FClientSocket) then
    Result := FClientSocket.FOnDisconnected;
end;

function TROIcsTCPConnection.GetOnHaveIncompleteData: TROAsyncCallback;
begin
  if Assigned(FClientSocket) then
    Result := FClientSocket.FOnHaveIncompleteData;
end;

function TROIcsTCPConnection.GetSelf: TROIcsTCPConnection;
begin
  Result := Self;
end;

procedure TROIcsTCPConnection.SetOnDisconnected(aCallback: TROAsyncCallback);
begin
  if Assigned(FClientSocket) then
    FClientSocket.FOnDisconnected := aCallback;
end;

procedure TROIcsTCPConnection.SetOnHaveIncompleteData(
  aCallback: TROAsyncCallback);
begin
  if Assigned(FClientSocket) then
    FClientSocket.FOnHaveIncompleteData := aCallback;
end;

initialization

finalization
  FServerSocketsMessagePump.Free;
  FClientSocketsMessagePump.Free;

end.