Componentes.Terceros.RemObjects/internal/6.0.43.801/1/RemObjects SDK for Delphi/Source/uROIcsAsyncSuperTcpServer.pas

unit uROIcsAsyncSuperTcpServer;

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

{$IFDEF RemObjects_ICS_v6}
  {$UNDEF RemObjects_ICS_v5}
{$ENDIF}
uses
  Classes, Messages, SySutils, SyncObjs, Contnrs,
  uROAsyncSuperTcpServer, uROAsyncSCHelpers, uROClientIntf, uROServerIntf,
  uROClasses, uROThreadPool, uROSessions
  {$IFDEF RemObjects_ICS_v5}, WSocket, WSocketS {$ENDIF}
  {$IFDEF RemObjects_ICS_v6}, OverbyteICSWSocket, OverbyteICSWSocketS, OverbyteIcsWndControl {$ENDIF}
  ;
const
  // Default number of client message pumps for each server component
  DefaultMinClientMessagePumps = 1;

type
  // forward declarations
  TROIcsTCPConnection = class;
  TROAsyncSuperTCPServerSocketClient = class;
  TROCustomIcsAsyncSuperTCPServer = class;
  TROIcsMessagePumpThreadList = class;

  TROIcsMessagePumpSocketActionKind = (akAdd, akRemove);
  TROIcsMessagePumpSocketActionStatus = (asPending, asSuccess, asError);

  // A class that contains indication for an action to be performed by a message
  // pump thread on a given socket.
  TROIcsMessagePumpSocketAction = class
  private
    FSocket: TCustomWSocket;
    FActionKind: TROIcsMessagePumpSocketActionKind;
    FStatus: TROIcsMessagePumpSocketActionStatus;
    FErrorMessage: string;
  public
    constructor Create(ASocket: TCustomWSocket; AActionKind: TROIcsMessagePumpSocketActionKind);

    property Status: TROIcsMessagePumpSocketActionStatus read FStatus write FStatus;
    property ErrorMessage: string read FErrorMessage write FErrorMessage;
    property Socket: TCustomWSocket read FSocket;
    property ActionKind: TROIcsMessagePumpSocketActionKind read FActionKind;
  end;

  // A thread that reads messages for a given number of sockets
  TROIcsMessagePumpThread = class(TROInitializedThread)
  private
    FSockets: TObjectList;
    {$IFDEF RemObjects_ICS_v6}
    FICSHandleHolder: TIcsWndControl;
    {$ENDIF}
    FOwner: TROIcsMessagePumpThreadList;

    FPendingActionsSection: TCriticalSection;
    FPendingActions: TObjectList;

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

    procedure InternalRemoveSocket(ASocket: TCustomWSocket);

    procedure LockPendingActions;
    procedure UnlockPendingActions;
    procedure DoMessagePumpException(E: TObject);
  protected
    procedure DoTerminate; override;
  public
    constructor Create(AOwner: TROIcsMessagePumpThreadList);
    destructor Destroy; override;

    procedure Execute; override;

    function AddSocket(ASocket: TCustomWSocket; out ErrorMessage: string): Boolean;
    function RemoveSocket(ASocket: TCustomWSocket; out ErrorMessage: string): Boolean;
    property SocketCount: Integer read GetSocketCount;
  end;

  // A list of message pumps
  TROIcsMessagePumpThreadList = class(TObjectList)
  private
    FMinCount: Integer;
    FMaxClientsPerPump: Integer;
    
    function GetItem(Index: Integer): TROIcsMessagePumpThread;
    procedure SetItem(Index: Integer; const Value: TROIcsMessagePumpThread);
    procedure SetMinCount(const Value: Integer);
    procedure SetMaxClientsPerPump(const Value: Integer);
  public
    // Returns the first available pump and attaches the given socket to it.
    function GetMessagePump(ASocket: TCustomWSocket): TROIcsMessagePumpThread;

    property Items[Index: Integer]: TROIcsMessagePumpThread read GetItem write SetItem; default;
    property MinCount: Integer read FMinCount write SetMinCount;
    property MaxClientsPerPump: Integer read FMaxClientsPerPump write SetMaxClientsPerPump; 
  end;

  // A server socket
  TROWSocketServer = class(TCustomWSocketServer)
  protected
    FDisposed: Boolean;
    
    FMessagePumpThread: TROIcsMessagePumpThread;
    FServer: TROCustomIcsAsyncSuperTCPServer;
    
    procedure WndProc(var MsgRec: TMessage); override;
    procedure InternalClose(bShut : Boolean; Error : Word); override;
    procedure TriggerClientConnect(Client : TWSocketClient; Error : Word); override;
    {$IFDEF RemObjects_ICS_v6}
    procedure Dispose(Disposing: Boolean); override;
    {$ENDIF}
  public
    constructor Create(AServer: TROCustomIcsAsyncSuperTCPServer); reintroduce;
    destructor Destroy; override;
    procedure Listen; override;
    property ClientCount;
    property Client;

    property MessagePumpThread: TROIcsMessagePumpThread read FMessagePumpThread write FMessagePumpThread;
    property Server: TROCustomIcsAsyncSuperTCPServer read FServer;
  end;

  // Server component
  TServerSocketBackgroundException = procedure(Sender: TObject; Socket: TROWSocketServer; E: TObject) of object;
  TClientSocketBackgroundException = procedure(Sender: TObject; Socket: TROAsyncSuperTCPServerSocketClient; E: TObject) of object;
  TServerSocketSessionClosed = procedure (Sender: TObject; Socket: TROWSocketServer; ErrCode: Word) of object;
  TROCustomIcsAsyncSuperTCPServer = class(TROBaseAsyncSuperTCPServer)
  private
    fPort: Integer;
    FServerSocket: TROWSocketServer;
    FWorkers: TObjectList;
    FOnServerSocketSessionClosed: TServerSocketSessionClosed;
    FOnServerSocketBackgroundException: TServerSocketBackgroundException;
    FOnClientSocketBackgroundException: TClientSocketBackgroundException;
    FClientMessagePumps: TROIcsMessagePumpThreadList;
    fAutoRegisterSession: Boolean;

    procedure SetPort(const Value: Integer);
    procedure ServerSocketClientConnect(Sender: TObject; Client: TWSocketClient; Error: Word);
    procedure ServerSocketClientDisconnect(Sender: TObject; Client: TWSocketClient; Error: Word);
    procedure ServerSocketSessionClosed(Sender: TObject; ErrCode: Word);
    procedure ServerSocketBgException(Sender: TObject; E: Exception; var CanClose: Boolean);

    procedure DoClientSocketException(Socket: TROAsyncSuperTCPServerSocketClient; E: TObject);
    procedure SetMinClientMessagePumps(const Value: Integer);
    function GetMinClientMessagePumps: Integer;
    function GetMaxClientsPerPump: Integer;
    procedure SetMaxClientsPerPump(const Value: Integer);
  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 ServerSocket: TROWSocketServer read FServerSocket;

    property Port: Integer read fPort write SetPort default 8095;
    property AutoRegisterSession: Boolean read fAutoRegisterSession write fAutoRegisterSession default true;
    property MinClientMessagePumps: Integer read GetMinClientMessagePumps write SetMinClientMessagePumps default DefaultMinClientMessagePumps;
    property MaxClientsPerPump: Integer read GetMaxClientsPerPump write SetMaxClientsPerPump; 

    property OnServerSocketSessionClosed: TServerSocketSessionClosed read FOnServerSocketSessionClosed write FOnServerSocketSessionClosed;
    property OnServerSocketBackgroundException: TServerSocketBackgroundException read FOnServerSocketBackgroundException write FOnServerSocketBackgroundException;
    property OnClientSocketBackgroundException: TClientSocketBackgroundException read FOnClientSocketBackgroundException write FOnClientSocketBackgroundException;  
  end;

  TROIcsAsyncSuperTCPServer = class(TROCustomIcsAsyncSuperTCPServer)
  published
    property Port;
    property DefaultResponse;    
    property AutoRegisterSession;
    
    property OnServerSocketSessionClosed;
    property OnServerSocketBackgroundException;
    property OnClientSocketBackgroundException;
  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;
    function GetDefaultResponse: string; override;
  public
    constructor Create(AServer: TROCustomIcsAsyncSuperTCPServer; AClient: TROAsyncSuperTCPServerSocketClient);
    destructor Destroy; override;
  end;

  // Client socket
  TROAsyncSuperTCPServerSocketClient = class(TWSocketClient)
  private
    FTCPConnection: 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;
    
    function GetAbstractTCPConnection: IROAbstractTCPConnection;
  protected
    FDisposed: Boolean;

    procedure WndProc(var MsgRec: TMessage); override;

    // 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;
    {$IFDEF RemObjects_ICS_v6}
    procedure Dispose(Disposing: Boolean); override;
    {$ENDIF}

    // 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;

    procedure DetachFromThread;
    procedure ClearROIcsTCPConnection;

    property AbstractTCPConnection: IROAbstractTCPConnection read GetAbstractTCPConnection;
    property Worker: TROIcsAsyncSuperChannelWorker read FWorker write FWorker;
    property MessagePumpThread: TROIcsMessagePumpThread read FMessagePumpThread write FMessagePumpThread;

    property OnDisconnected: TROAsyncCallback read FOnDisconnected write FOnDisconnected;
    property OnHaveIncompleteData: TROAsyncCallback read FOnHaveIncompleteData write FOnHaveIncompleteData;

    property ConnectCallback: TROAsyncCallback read FConnectCallback write FConnectCallback;
    property DisconnectCallback: TROAsyncCallback read FDisconnectCallback write FDisconnectCallback;

    property RequestedReceiveBytes: Integer read FRequestedReceiveBytes write FRequestedReceiveBytes;
    property ReceiveBuffer: Pointer read FReceiveBuffer write FReceiveBuffer;
    property ReceivedBytes: Integer read FReceivedBytes write FReceivedBytes;
    property ReceiveCallback: TROAsyncCallback read FReceiveCallback write FReceiveCallback;

    property SentBytes: Integer read FSentBytes write FSentBytes;
    property SendCallback: TROAsyncCallback read FSendCallback write FSendCallback;
  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;

    { IROAsyncICSSocket }
    function GetSelf: TROIcsTCPConnection;
  public
    constructor Create(ClientSocket: TROAsyncSuperTCPServerSocketClient);
    destructor Destroy; override;

    procedure ClearClientSocket;
  end;

// Under rare conditions an exception may occur inside the Execute method of
// message pumps, outside of any work done by a socket they handle message for.
// Message pumps deal with multiple objects and as such, it is not possible for
// them to notify one more than the other.
// However, it may be useful to be notified of such exceptions, which is the
// reason why the type and procedure below are defined. Give a handler and you
// will get notified when such an exception occur.
//
// WARNING: The parameter named "E" might be nil if the exception does not
//          inherit from TObject. This would happen for instance if it is a
//          system exception that is not managed by the RTL itself.
type
  TOnMessagePumpException = procedure(E: TObject; IsServerSocketsMessagePump: Boolean) of object;

procedure SetOnMessagePumpException(Value: TOnMessagePumpException);

// Use the type and method below to get notified when a message pump is terminated
type
  TOnMessagePumpTerminated = procedure(IsServerSocketsMessagePump: Boolean) of object;

procedure SetOnMessagePumpTerminated(Value: TOnMessagePumpTerminated);

// Write log. To be removed when things settle down
procedure WriteICSLog(const Msg: string; IsServer: Boolean); overload;

// Get access to the list of server socket message pumps. Useful to set the
// properties on it, like MinCount and MaxPerCount
function ServerSocketsMessagePumps: TROIcsMessagePumpThreadList;

implementation

uses
  {$IFDEF ICS_LOG}
  ServerParameters, ServerLogging, DBObjectsHelpers,
  {$ENDIF ICS_LOG}
  Math, Windows, Winsock, uROEventRepository, uROTypes;

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

var
  FServerSocketsMessagePumps: TROIcsMessagePumpThreadList;
  FOnMessagePumpException: TOnMessagePumpException;
  FOnMessagePumpTerminated: TOnMessagePumpTerminated;

procedure SetOnMessagePumpException(Value: TOnMessagePumpException);
begin
  FOnMessagePumpException := Value;
end;

procedure SetOnMessagePumpTerminated(Value: TOnMessagePumpTerminated);
begin
  FOnMessagePumpTerminated := Value;
end;

function ServerSocketsMessagePumps: TROIcsMessagePumpThreadList;
begin
  if not Assigned(FServerSocketsMessagePumps) then
    FServerSocketsMessagePumps := TROIcsMessagePumpThreadList.Create;

  Result := FServerSocketsMessagePumps;
end;

procedure WriteICSLog(const Msg: string; IsServer: Boolean); overload;
{$IFDEF ICS_LOG}
var
  LogFileName: string;
  stream: TFileStream;
  FullMsg: string;
{$ENDIF ICS_LOG}
begin
  {$IFDEF ICS_LOG}
  try
    LogFileName := ServerParams.LogFilePath + ServerParams.LogFileBaseName + '_ics_thread_';
    if IsServer then
      LogFileName := LogFileName + 'serveurs'
    else
      LogFileName := LogFileName + 'clients';
    LogFileName := LogFileName + '_' +
                   FormatDateTime('yyyymmdd', Now) + '.log';

    FullMsg := DateTimeToStr(Now) + ' : ' + Msg + #13#10;

    if not FileExists(LogFileName) then
      stream := TFileStream.Create(LogFileName, fmCreate or fmShareDenyWrite)
    else
      stream := TFileStream.Create(LogFileName, fmOpenReadWrite or fmShareDenyWrite);
    try
      stream.Position := stream.Size;
      stream.Write(PChar(FullMsg)^, Length(FullMsg));
    finally
      stream.Free;
    end;
  except
    // en cas d'exception <20> l'<27>criture, on <20>vite de killer l'appelant
  end;
  {$ENDIF ICS_LOG}
end;

procedure WriteICSLog(const Msg: string; Pump: TROIcsMessagePumpThread); overload;
begin
  if Assigned(Pump) then
    WriteICSLog(Msg, Pump.FOwner = FServerSocketsMessagePumps)
  else
    WriteICSLog(Msg, False);
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
  WriteICSLog('                TROWSocketServer.TriggerClientConnect: Entering...', True);
  Client.ComponentOptions := Client.ComponentOptions + ComponentOptions;

  if wsoTCPNoDelay in Client.ComponentOptions 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)');
      WriteICSLog('                  Error setting socket option, exiting...', True);
      Exit;
    end;
  end;

  WriteICSLog('                  Calling inherited...', True);
  inherited TriggerClientConnect(Client, Error);
  WriteICSLog('                TROWSocketServer.TriggerClientConnect: Normal end.', True);
end;

constructor TROWSocketServer.Create(AServer: TROCustomIcsAsyncSuperTCPServer);
begin
  inherited Create(nil);

  FServer := AServer;
  ComponentOptions := ComponentOptions + [wsoTCPNoDelay];
end;

destructor TROWSocketServer.Destroy;
begin
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Freeing server socket...');
  {$ENDIF ICS_LOG}
  inherited Destroy;
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Server socket freed.');
  {$ENDIF ICS_LOG}
end;

{$IFDEF RemObjects_ICS_v6}
procedure TROWSocketServer.Dispose(Disposing: Boolean);
var
  ErrorMessage: string;
begin
  if not FDisposed then
  begin
    if Assigned(FMessagePumpThread) then
      FMessagePumpThread.RemoveSocket(Self, ErrorMessage);

    FDisposed := True;
  end;

  inherited Dispose(Disposing);
end;
{$ENDIF}
procedure TROWSocketServer.WndProc(var MsgRec: TMessage);
begin
  WriteICSLog('TROWSocketServer.WndProc: Processing a message...', FMessagePumpThread);
  WriteICSLog(Format('  MsgRec.Msg=$%.4x', [MsgRec.Msg]), FMessagePumpThread);
  WriteICSLog(Format('  MsgRec.wParam=$%.8x  -  FHSocket=$%.8x', [MsgRec.wParam, FHSocket]), FMessagePumpThread);
  WriteICSLog(Format('  MsgRec.lParamLo=$%.2x', [MsgRec.lParamLo]), FMessagePumpThread);
  WriteICSLog(Format('  FPaused=%s', [BoolToStr(FPaused, True)]), FMessagePumpThread);
  inherited WndProc(MsgRec);
  WriteICSLog('TROWSocketServer.WndProc: Message processed.', FMessagePumpThread);
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;
  FClientMessagePumps := TROIcsMessagePumpThreadList.Create;

  MinClientMessagePumps := DefaultMinClientMessagePumps;

  FServerSocket := TROWSocketServer.Create(Self);
  FServerSocket.ClientClass := TROAsyncSuperTCPServerSocketClient;
  FServerSocket.Banner := '';
  FServerSocket.BannerTooBusy := '';
  FServerSocket.OnClientConnect := ServerSocketClientConnect;
  FServerSocket.OnClientDisconnect := ServerSocketClientDisconnect;
  FServerSocket.OnBgException := ServerSocketBgException;
  FServerSocket.OnSessionClosed := ServerSocketSessionClosed;
  DefaultResponse := 'ROSC:Invalid connection string';  
  fAutoRegisterSession := True;
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Adding server socket...');
  {$ENDIF ICS_LOG}
  FServerSocket.MessagePumpThread := ServerSocketsMessagePumps.GetMessagePump(FServerSocket);
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Server socket added.');
  {$ENDIF ICS_LOG}
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;
  FClientMessagePumps.Free;
  FWorkers.Free;
end;

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

procedure TROCustomIcsAsyncSuperTCPServer.DoClientSocketException(
  Socket: TROAsyncSuperTCPServerSocketClient; E: TObject);
begin
  if Assigned(FOnClientSocketBackgroundException) then
    OnClientSocketBackgroundException(Self, Socket, E);
end;

function TROCustomIcsAsyncSuperTCPServer.GetMaxClientsPerPump: Integer;
begin
  Result := FClientMessagePumps.MaxClientsPerPump;
end;

function TROCustomIcsAsyncSuperTCPServer.GetMinClientMessagePumps: Integer;
begin
  Result := FClientMessagePumps.MinCount;
end;

function TROCustomIcsAsyncSuperTCPServer.IntGetActive: boolean;
begin
  Result := Assigned(FServerSocket) and 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 occur.
procedure TROCustomIcsAsyncSuperTCPServer.ServerSocketBgException(
  Sender: TObject; E: Exception; var CanClose: Boolean);
begin
  CanClose := False;  // Let's hope server can still continue
  if Assigned(FOnServerSocketBackgroundException) then
    OnServerSocketBackgroundException(Self, Sender as TROWSocketServer, E);
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);
  
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Adding client socket...');
  {$ENDIF ICS_LOG}
  // Only attach here and not in "ClientCreate" so that if the socket cannot
  // be attached, it can at least be closed.
  TROAsyncSuperTCPServerSocketClient(Client).MessagePumpThread := FClientMessagePumps.GetMessagePump(Client); //GetClientSocketMessagePump(Client);
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Client socket added.');
  {$ENDIF ICS_LOG}
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).Worker);
end;

procedure TROCustomIcsAsyncSuperTCPServer.ServerSocketSessionClosed(
  Sender: TObject; ErrCode: Word);
begin
  if Assigned(OnServerSocketSessionClosed) then
    OnServerSocketSessionClosed(Self, Sender as TROWSocketServer, ErrCode);
end;

procedure TROCustomIcsAsyncSuperTCPServer.SetMaxClientsPerPump(
  const Value: Integer);
begin
  FClientMessagePumps.MaxClientsPerPump := Value;
end;

procedure TROCustomIcsAsyncSuperTCPServer.SetMinClientMessagePumps(
  const Value: Integer);
begin
  FClientMessagePumps.MinCount := Value;
end;

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

{ TROAsyncSuperTCPServerSocketClient }

procedure TROAsyncSuperTCPServerSocketClient.ClearROIcsTCPConnection;
begin
  FTCPConnection := nil;
end;

constructor TROAsyncSuperTCPServerSocketClient.Create(AOwner: TComponent);
begin
  try
    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;
  except
    on E: TObject do
    begin
      FState := wsClosed;
      raise;
    end
    else
    begin
      FState := wsClosed;
      raise;
    end;
  end;
end;

destructor TROAsyncSuperTCPServerSocketClient.Destroy;
begin
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Freeing client socket...');
  {$ENDIF ICS_LOG}
  inherited Destroy;

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

  SetLength(FInternalReceiveBuffer, 0);
  {$IFDEF ICS_LOG}
  WriteLog('[ICS] Client freed...');
  {$ENDIF ICS_LOG}
end;

procedure TROAsyncSuperTCPServerSocketClient.DetachFromThread;
var
  ErrorMessage: string;
begin
  if Assigned(FMessagePumpThread) then
    FMessagePumpThread.RemoveSocket(Self, ErrorMessage);
end;

{$IFDEF RemObjects_ICS_v6}
procedure TROAsyncSuperTCPServerSocketClient.Dispose(Disposing: Boolean);
begin
  if not FDisposed then
  begin
    // Done here, just in case it was not done by the Worker instance
    // Note that if it has already been done, it's not a problem as ICS is
    // designed to ignore duplicate requests to detach a socket.
    DetachFromThread;

    FDisposed := True;
  end;

  inherited Dispose(Disposing);
end;
{$ENDIF}
procedure TROAsyncSuperTCPServerSocketClient.DoConnectCallback;
begin
  if Assigned(FConnectCallback) then
    FConnectCallback(AbstractTCPConnection);
end;

procedure TROAsyncSuperTCPServerSocketClient.DoDisconnectCallback;
begin
  if Assigned(FDisconnectCallback) then
    FDisconnectCallback(AbstractTCPConnection);
end;

procedure TROAsyncSuperTCPServerSocketClient.DoOnDisconnected;
begin
  if Assigned(FOnDisconnected) then
    FOnDisconnected(AbstractTCPConnection);
end;

procedure TROAsyncSuperTCPServerSocketClient.DoOnHaveIncompleteData;
begin
  if Assigned(FOnHaveIncompleteData) then
    FOnHaveIncompleteData(AbstractTCPConnection);
end;

procedure TROAsyncSuperTCPServerSocketClient.DoReceiveCallback;
begin
  if Assigned(FReceiveCallback) then
    FReceiveCallback(AbstractTCPConnection);
end;

procedure TROAsyncSuperTCPServerSocketClient.DoSendCallback;
begin
  if Assigned(FSendCallback) then
    FSendCallback(AbstractTCPConnection);
end;

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

// This event handler is called when a client socket experience a background
// exception. It is likely to occur 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
  // kill client connection if possible and necessary
  CanClose := not (State in [wsInvalidState, wsClosed]);
  (Server as TROWSocketServer).Server.DoClientSocketException(Self, E);
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
    repeat
      // 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
        begin
          FRequestedReceiveBytes := 0;
          DoReceiveCallback;
        end;
      end;

      // We are looping here because 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
      // call to ReceiveBytes inside the TriggerDataAvailable override, and
      // analysed via the DoReceiveCallback call above. This in turn might
      // trigger the request for more bytes.
      // But if we did not loop here, the available byte would never be read
      // and would stay in the buffer in front of the next bytes received
      // later on. Then the TriggerDataAvailable called 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.
    until (FInternalReceivedBytes <= 0) or (FRequestedReceiveBytes <= 0);
  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 it, the callback
  // might have requested it already. Note that this last part has to be done
  // so that the message pump can be left without any knowledge of sockets
  // waiting for data. This 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;

procedure TROAsyncSuperTCPServerSocketClient.WndProc(var MsgRec: TMessage);
begin
  WriteICSLog('TROAsyncSuperTCPServerSocketClient.WndProc: Processing a message...', FMessagePumpThread);
  WriteICSLog(Format('  MsgRec.Msg=$%.4x', [MsgRec.Msg]), FMessagePumpThread);
  WriteICSLog(Format('  MsgRec.wParam=$%.8x  -  FHSocket=$%.8x', [MsgRec.wParam, FHSocket]), FMessagePumpThread);
  WriteICSLog(Format('  MsgRec.lParamLo=$%.2x', [MsgRec.lParamLo]), FMessagePumpThread);
  WriteICSLog(Format('  FPaused=%s', [BoolToStr(FPaused, True)]), FMessagePumpThread);
  inherited WndProc(MsgRec);
  WriteICSLog('TROAsyncSuperTCPServerSocketClient.WndProc: Message processed.', FMessagePumpThread);
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.AbstractTCPConnection);

  FServer := AServer;
  FClient := AClient;

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

destructor TROIcsAsyncSuperChannelWorker.Destroy;
begin
  FServer.FClients.Remove(Self);

  // Detach from thread here to prevent the thread to call "write" or "read"
  // methods on a destroyed worker. 
  FClient.DetachFromThread;

  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;

function TROIcsAsyncSuperChannelWorker.GetDefaultResponse: string;
begin
  Result := FServer.DefaultResponse;
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;

{ TROIcsMessagePumpSocketAction }

constructor TROIcsMessagePumpSocketAction.Create(ASocket: TCustomWSocket;
  AActionKind: TROIcsMessagePumpSocketActionKind);
begin
  inherited Create;

  FSocket := ASocket;
  FActionKind := AActionKind;
  FStatus := asPending;
end;

{ TMessagePumpThread }

function TROIcsMessagePumpThread.AddSocket(ASocket: TCustomWSocket; out ErrorMessage: string): Boolean;
var
  Action: TROIcsMessagePumpSocketAction;
begin
  {$IFDEF ICS_LOG}
  WriteLog('[ICS]   Adding a socket...');
  {$ENDIF ICS_LOG}
  if not Assigned(ASocket) then
  begin
    Result := False;
    ErrorMessage := 'Attempted to add a nil socket';
    Exit;
  end;

  // Detach from current thread
  {$IFDEF ICS_LOG}
  WriteLog('[ICS]   Detaching socket...');
  {$ENDIF ICS_LOG}
  ASocket.ThreadDetach;
  TWSocket(ASocket).MultiThreaded := True;
  {$IFDEF ICS_LOG}
  WriteLog('[ICS]   Socket detached.');
  {$ENDIF ICS_LOG}

  // Add action to attach socket to message pump thread
  {$IFDEF ICS_LOG}
  WriteLog('[ICS]   Adding "add action" for socket to action list...');
  {$ENDIF ICS_LOG}
  Action := TROIcsMessagePumpSocketAction.Create(ASocket, akAdd);
  try
    LockPendingActions;
    try
      FPendingActions.Add(Action);
    finally
      {$IFDEF ICS_LOG}
      WriteLog('[ICS]   Unlocking pending actions list...');
      {$ENDIF ICS_LOG}
      UnlockPendingActions;
    end;
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Action added to list.');
    {$ENDIF ICS_LOG}

    // Wait for action to be performed
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Waiting for action to complete...');
    {$ENDIF ICS_LOG}
    while Action.Status = asPending do
      SleepEx(1, True);
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Action has been done.');
    {$ENDIF ICS_LOG}

    Result := Action.Status = asSuccess;
    ErrorMessage := Action.ErrorMessage;
  finally
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Freeing action.');
    {$ENDIF ICS_LOG}
    Action.Free;
  end;
  {$IFDEF ICS_LOG}
  WriteLog('[ICS]   Normal end.');
  {$ENDIF ICS_LOG}
end;

constructor TROIcsMessagePumpThread.Create(AOwner: TROIcsMessagePumpThreadLIst);
begin
  inherited Create(True);

  FOwner := AOwner;
  FPendingActionsSection := TCriticalSection.Create;

  FSockets := TObjectList.Create(False);
  FPendingActions := TObjectList.Create(False);
  {$IFDEF RemObjects_ICS_v6}
  FICSHandleHolder := TIcsWndControl.Create(nil);
  {$ENDIF}
  Suspended := False;
end;

destructor TROIcsMessagePumpThread.Destroy;
begin
  // Force thread to terminate
  Terminate;
  FSockets.Clear;

  inherited Destroy;
  {$IFDEF RemObjects_ICS_v6}
  FICSHandleHolder.Free;
  {$ENDIF}

  FSockets.Free;
  FPendingActions.Free;

  FPendingActionsSection.Free;
end;

procedure TROIcsMessagePumpThread.DoMessagePumpException(E: TObject);
begin
  try
    if Assigned(FOnMessagePumpException) then
      FOnMessagePumpException(E, FOwner = FServerSocketsMessagePumps);
  except
    ; // can't accept any exceptions here or it would kill the caller
  end;
end;

procedure TROIcsMessagePumpThread.DoTerminate;
begin
  try
    inherited DoTerminate;

    if Assigned(FOnMessagePumpTerminated) then
      FOnMessagePumpTerminated(FOwner = FServerSocketsMessagePumps);
  except
    ;  // can't accept any exception here or it would kill the caller
  end;
end;

type
  TAccessWSocket = class(TCustomWSocket);

procedure TROIcsMessagePumpThread.Execute;
var
  MsgRec: TMsg;
  I: Integer;
  pHandles: Pointer;
  Action: TROIcsMessagePumpSocketAction;
begin
  WriteICSLog('Start of Execute method.', Self);
  // Process messages until WM_QUIT has been received or Terminated set to True
  repeat
    try
      // Attach handle holder. Done inside the repeat loop so that we do not
      // have to duplicate the try..except handling in case the handle holder
      // cannot be attached.
      // We are using this handle holder so that ICS will create the handle
      // as early as possible and keep using it throughout the life of the
      // process. This way, if later in its life it would not be possible to
      // create new handles, we would have the one created here the first time
      // the loop goes through. Note that this situation (no more handles) is
      // more likely to happen with a very busy process using Indy for most of
      // its tasks as Indy uses a lot of resources.
      {$IFDEF RemObjects_ICS_v6}
      if FICSHandleHolder.Handle = 0 then
        FICSHandleHolder.ThreadAttach;
      {$ENDIF}

      // 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
        WriteICSLog(Format('Translating message $%.4x', [MsgRec.message]), Self);
        TranslateMessage(MsgRec);
        WriteICSLog(Format('Dispatching message $%.4x', [MsgRec.message]), Self);
        DispatchMessage(MsgRec);
        WriteICSLog('Message dispatched.', Self);
      end;

      // If socket actions are waiting, perform them
      if FPendingActions.Count > 0 then
      begin
        WriteICSLog('Processing socket actions...', Self);
        LockPendingActions;
        try
          while FPendingActions.Count > 0 do
          begin
            Action := TROIcsMessagePumpSocketAction(FPendingActions[0]);
            try
              try
                case Action.ActionKind of
                  akAdd:
                  begin
                    WriteICSLog('  Adding a socket...', Self);
                    Action.Socket.ThreadAttach;
                    FSockets.Add(Action.Socket);
                    WriteICSLog('  Socket added.', Self);
                  end;
                  akRemove:
                  begin
                    WriteICSLog('  Removing a socket...', Self);
                    InternalRemoveSocket(Action.Socket);
                    WriteICSLog('  Socket removed.', Self);
                  end;
                end;
                Action.Status := asSuccess;
              except
                on E: TObject do
                begin
                  Action.Status := asError;
                  Action.ErrorMessage := E.ClassName;
                  if E is Exception then
                    Action.ErrorMessage := Action.ErrorMessage + ', ' + Exception(E).Message;
                  raise;
                end;
                else
                begin
                  Action.Status := asError;
                  Action.ErrorMessage := 'Unknow exception';
                  raise;
                end;
              end;
            finally
              FPendingActions.Delete(0);
            end;
          end;
        finally
          WriteICSLog('Unlocking pending socket actions list...', Self);
          UnlockPendingActions;
        end;
        WriteICSLog('New socket actions processed.', Self);
      end;

      // If there are messages in the queue, then do not wait at all, else, wait
      // as little as possible, so as to avoid 100% CPU usage and still process
      // as fast as we possibly can.
      MsgWaitForMultipleObjectsEx(0, pHandles, 1, QS_ALLINPUT, MWMO_ALERTABLE);
    except
      // Ensure that no exception kills the message processing thread. If we
      // did not do that, the server would still respond to connection attempts
      // but would not reply to any bytes it would receive.
      on E: TObject do
        DoMessagePumpException(E);
      else
        DoMessagePumpException(nil);
    end;
  until Terminated or (MsgRec.message = WM_QUIT);

  WriteICSLog('Quitting execute method, cleaning up...', Self);
  // 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);

  // Detach handle holder
  {$IFDEF RemObjects_ICS_v6}
  if FICSHandleHolder.Handle <> 0 then
    FICSHandleHolder.ThreadDetach;
  {$ENDIF}  
  
  WriteICSLog('End of Execute method.', Self);
end;

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

function TROIcsMessagePumpThread.GetSocketCount: Integer;
begin
  Result := FSockets.Count;
end;

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

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

procedure TROIcsMessagePumpThread.LockPendingActions;
begin
  FPendingActionsSection.Acquire;
end;

function TROIcsMessagePumpThread.RemoveSocket(ASocket: TCustomWSocket; out ErrorMessage: string): Boolean;
var
  Action: TROIcsMessagePumpSocketAction;
begin
  // Add action to detach socket from message pump thread
  {$IFDEF ICS_LOG}
  WriteLog('[ICS]   Adding "remove action" for socket to action list...');
  {$ENDIF ICS_LOG}
  Action := TROIcsMessagePumpSocketAction.Create(ASocket, akRemove);
  try
    LockPendingActions;
    try
      FPendingActions.Add(Action);
    finally
      {$IFDEF ICS_LOG}
      WriteLog('[ICS]   Unlocking pending actions list...');
      {$ENDIF ICS_LOG}
      UnlockPendingActions;
    end;
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Action added to list.');
    {$ENDIF ICS_LOG}

    // Wait for action to be performed
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Waiting for action to complete...');
    {$ENDIF ICS_LOG}
    while Action.Status = asPending do
      SleepEx(1, True);
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Action has been done.');
    {$ENDIF ICS_LOG}

    Result := Action.Status = asSuccess;
    ErrorMessage := Action.ErrorMessage;
  finally
    {$IFDEF ICS_LOG}
    WriteLog('[ICS]   Freeing action.');
    {$ENDIF ICS_LOG}
    Action.Free;
  end;
  {$IFDEF ICS_LOG}
  WriteLog('[ICS]   Normal end.');
  {$ENDIF ICS_LOG}
end;

procedure TROIcsMessagePumpThread.UnlockPendingActions;
begin
  FPendingActionsSection.Release;
end;

{ TROIcsMessagePumpThreadList }

function TROIcsMessagePumpThreadList.GetMessagePump(
  ASocket: TCustomWSocket): TROIcsMessagePumpThread;
var
  ErrorMessage: string;
  MinCount: Integer;
  I: Integer;
  CurCount: Integer;
  LeastCountIndex: Integer;
begin
  // Let's find the pump that has the least number of sockets
  MinCount := MaxInt;
  LeastCountIndex := -1;
  for I := 0 to Count - 1 do
  begin
    CurCount := Items[I].SocketCount;
    if CurCount < MinCount then
    begin
      MinCount := CurCount;
      LeastCountIndex := I;  
    end;
  end;

  // Two cases:
  // 1. No pump found or found pump is full, create a new one
  // 2. No limit set or pump is not full, use the found pump
  if (LeastCountIndex = -1) or ((MaxClientsPerPump > 0) and (MinCount > MaxClientsPerPump)) then
    Result := Items[Add(TROIcsMessagePumpThread.Create(Self))]
  else
    Result := Items[LeastCountIndex];

  // Now that we have a pump, attach the socket to it
  if not Result.AddSocket(ASocket, ErrorMessage) then
    ASocket.Close;
end;

function TROIcsMessagePumpThreadList.GetItem(
  Index: Integer): TROIcsMessagePumpThread;
begin
  Result := TROIcsMessagePumpThread(inherited Items[Index]);
end;

procedure TROIcsMessagePumpThreadList.SetItem(Index: Integer;
  const Value: TROIcsMessagePumpThread);
begin
  inherited Items[Index] := Value;
end;

procedure TROIcsMessagePumpThreadList.SetMaxClientsPerPump(
  const Value: Integer);
var
  ConstrainedValue: Integer;
begin
  ConstrainedValue := Value;
  if ConstrainedValue < 0 then
    ConstrainedValue := 0;

  if FMaxClientsPerPump <> ConstrainedValue then
    FMaxClientsPerPump := ConstrainedValue;
end;

procedure TROIcsMessagePumpThreadList.SetMinCount(const Value: Integer);
var
  ConstrainedValue: Integer;
  I: Integer;
begin
  ConstrainedValue := Value;
  if ConstrainedValue < 1 then
    ConstrainedValue := 1;

  if FMinCount <> ConstrainedValue then
  begin
    FMinCount := ConstrainedValue;

    if Count < MinCount then
      for I := Count to MinCount - 1 do
        Add(TROIcsMessagePumpThread.Create(Self));
  end;
end;

{ TROIcsTCPConnection }

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

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

procedure TROIcsTCPConnection.BeginReceive(aData: Pointer;
  aSize: Integer; aCallback: TROAsyncCallback);
begin
  FClientSocket.ReceiveCallback := aCallback;
  FClientSocket.RequestedReceiveBytes := aSize;
  FClientSocket.ReceiveBuffer := aData;
  FClientSocket.ReceivedBytes := 0;
end;

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

procedure TROIcsTCPConnection.ClearClientSocket;
begin
  FClientSocket := nil;
end;

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

  FClientSocket := ClientSocket;
end;

destructor TROIcsTCPConnection.Destroy;
begin
  if Assigned(FClientSocket) then
    FClientSocket.ClearROIcsTCPConnection;
  
  inherited Destroy;
end;

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

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

function TROIcsTCPConnection.EndReceive: Integer;
begin
  FClientSocket.ReceiveBuffer := nil;
  FClientSocket.ReceiveCallback := nil;
  Result := FClientSocket.ReceivedBytes;
end;

function TROIcsTCPConnection.EndSend: Integer;
begin
  FClientSocket.Flush;
  FClientSocket.SendCallback := nil;
  Result := FClientSocket.SentBytes;
end;

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

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

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

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

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

initialization
  FServerSocketsMessagePumps := TROIcsMessagePumpThreadList.Create;

finalization
  FServerSocketsMessagePumps.Free;

end.