freepascal.compiler/utils/fppkg/lnet/lnet.pp

{ lNet v0.6.2

  CopyRight (C) 2004-2008 Ales Katona

  This library is Free software; you can rediStribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version.

  This program is diStributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a Copy of the GNU Library General Public License
  along with This library; if not, Write to the Free Software Foundation,
  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  
  This license has been modified. See File LICENSE.ADDON for more inFormation.
  Should you find these sources without a LICENSE File, please contact
  me at [email protected]
}

unit lNet;

{$mode objfpc}{$H+}{$T-}
{$interfaces corba}

interface

uses
  Classes, lEvents, lCommon,
  {$i sys/osunits.inc}

const
  { API compatibility, these had to be moved to prevent circular unit usage and a
    fpc bug with inline }
  LADDR_ANY   = lCommon.LADDR_ANY;
  LADDR_BR    = lCommon.LADDR_BR;
  LADDR_LO    = lCommon.LADDR_LO;
  LADDR6_ANY  = lCommon.LADDR6_ANY;
  LADDR6_LO   = lCommon.LADDR6_LO;

type
  TLSocket = class;
  TLComponent = class;
  TLConnection = class;
  TLSession = class;

  { Callback Event procedure for errors }
  TLSocketErrorEvent = procedure(const msg: string; aSocket: TLSocket) of object;

  { Callback Event procedure for others }
  TLSocketEvent = procedure(aSocket: TLSocket) of object;

  { Callback Event procedure for progress reports}
  TLSocketProgressEvent = procedure (aSocket: TLSocket; const Bytes: Integer) of object;

  { TLSocketState }
  TLSocketState = (ssServerSocket, ssBlocking, ssReuseAddress, ssCanSend,
                   ssCanReceive, ssSSLActive{, ssNoDelay});

  { TLSocketStates }
  TLSocketStates = set of TLSocketState;

  { TLSocketConnection }
  TLSocketConnectionStatus = (scNone, scConnecting, scConnected, scDisconnecting);

  { TLSocketOperation }
  TLSocketOperation = (soSend, soReceive);

  { TLSocket }

  TLSocket = class(TLHandle)
   protected
    FAddress: TLSocketAddress;
    FPeerAddress: TLSocketAddress;
    FReuseAddress: Boolean;
    FConnectionStatus: TLSocketConnectionStatus;
    FNextSock: TLSocket;
    FPrevSock: TLSocket;
    FSocketState: TLSocketStates;
    FOnFree: TLSocketEvent;
    FBlocking: Boolean;
    FListenBacklog: Integer;
    FProtocol: Integer;
    FSocketType: Integer;
    FSocketNet: Integer;
    FCreator: TLComponent;
    FSession: TLSession;
    FConnection: TLConnection;
    FMSGBufferSize: integer;
   protected
    function GetConnected: Boolean; virtual; deprecated;
    function GetConnecting: Boolean; virtual; deprecated;
    function GetConnectionStatus: TLSocketConnectionStatus; virtual;
    function GetIPAddressPointer: psockaddr;
    function GetIPAddressLength: TSocklen;

    function SetupSocket(const APort: Word; const Address: string): Boolean; virtual;
    
    function DoSend(const aData; const aSize: Integer): Integer; virtual;
    function DoGet(out aData; const aSize: Integer): Integer; virtual;

    function HandleResult(const aResult: Integer; aOp: TLSocketOperation): Integer; virtual;
    
    function GetLocalPort: Word;
    function GetPeerPort: Word;
    function GetPeerAddress: string;
    function GetLocalAddress: string;
    function SendPossible: Boolean; inline;
    function ReceivePossible: Boolean; inline;

    procedure SetOptions; virtual;
    procedure SetBlocking(const aValue: Boolean);
    procedure SetReuseAddress(const aValue: Boolean);
//    procedure SetNoDelay(const aValue: Boolean);

    procedure HardDisconnect(const NoShutdown: Boolean = False);
    procedure SoftDisconnect;

    function Bail(const msg: string; const ernum: Integer): Boolean;
    
    function LogError(const msg: string; const ernum: Integer): Boolean; virtual;
    
    property SocketType: Integer read FSocketType write FSocketType; // inherit and publicize if you need to set this outside
   public
    constructor Create; override;
    destructor Destroy; override;
    
    function SetState(const aState: TLSocketState; const TurnOn: Boolean = True): Boolean; virtual;
    
    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
    function Accept(const SerSock: TSocket): Boolean;
    function Connect(const Address: string; const APort: Word): Boolean;
    
    function Send(const aData; const aSize: Integer): Integer; virtual;
    function SendMessage(const msg: string): Integer;
    
    function Get(out aData; const aSize: Integer): Integer; virtual;
    function GetMessage(out msg: string): Integer;
    
    procedure Disconnect(const Forced: Boolean = True); virtual;
   public
    property Connected: Boolean read GetConnected; deprecated;
    property Connecting: Boolean read GetConnecting; deprecated;
    property ConnectionStatus: TLSocketConnectionStatus read GetConnectionStatus;
    property ListenBacklog: Integer read FListenBacklog write FListenBacklog;
    property Protocol: Integer read FProtocol write FProtocol;
    property SocketNet: Integer read FSocketNet write FSocketNet;
    property PeerAddress: string read GetPeerAddress;
    property PeerPort: Word read GetPeerPort;
    property LocalAddress: string read GetLocalAddress;
    property LocalPort: Word read GetLocalPort;
    property NextSock: TLSocket read FNextSock write FNextSock;
    property PrevSock: TLSocket read FPrevSock write FPrevSock;
    property SocketState: TLSocketStates read FSocketState;
    property Creator: TLComponent read FCreator;
    property Session: TLSession read FSession;
    Property MsgBufferSize: Integer Read FMsgBufferSize Write FMsgBufferSize;
  end;
  TLSocketClass = class of TLSocket;
  
  { this is the socket used by TLConnection }
  
  TLActionEnum = (acConnect, acAccept, acSend, acReceive, acError);

  { Base interface common to ALL connections }
  
  ILComponent = interface
    procedure Disconnect(const Forced: Boolean = True);
    procedure CallAction;
    
    property SocketClass: TLSocketClass;
    property Host: string;
    property Port: Word;
  end;
  
  { Interface for protools with direct send/get capabilities }

  ILDirect = interface
    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer;
    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer;

    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer;
    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer;
  end;
  
  { Interface for all servers }
  
  ILServer = interface
    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
  end;

  { Interface for all clients }
  
  ILClient = interface
    function Connect(const Address: string; const APort: Word): Boolean; overload;
    function Connect: Boolean; overload;
  end;
  
  { TLComponent }

  TLComponent = class(TComponent, ILComponent)
   protected
    FHost: string;
    FPort: Word;
    FCreator: TLComponent;
    FActive: Boolean;
    procedure SetCreator(AValue: TLComponent); virtual;
   public
    constructor Create(aOwner: TComponent); override;
    procedure Disconnect(const Forced: Boolean = True); virtual; abstract;
    procedure CallAction; virtual; abstract;
   public
    SocketClass: TLSocketClass;
    property Host: string read FHost write FHost;
    property Port: Word read FPort write FPort;
    property Creator: TLComponent read FCreator write SetCreator;
    property Active: Boolean read FActive;
  end;
  
  { TLConnection
    Common ancestor for TLTcp and TLUdp classes. Holds Event properties
    and common variables. }

  TLConnection = class(TLComponent, ILDirect, ILServer, ILClient)
   protected
    FTimeVal: TTimeVal;
    FOnReceive: TLSocketEvent;
    FOnAccept: TLSocketEvent;
    FOnConnect: TLSocketEvent;
    FOnDisconnect: TLSocketEvent;
    FOnCanSend: TLSocketEvent;
    FOnError: TLSocketErrorEvent;
    FRootSock: TLSocket;
    FIterator: TLSocket;
    FID: Integer; // internal number for server
    FEventer: TLEventer;
    FEventerClass: TLEventerClass;
    FTimeout: Integer;
    FListenBacklog: Integer;
    FSession: TLSession;
   protected
    function InitSocket(aSocket: TLSocket): TLSocket; virtual;
    
    function GetConnected: Boolean; virtual; abstract;
    function GetCount: Integer; virtual;
    function GetItem(const i: Integer): TLSocket;
    
    function GetTimeout: Integer;
    procedure SetTimeout(const AValue: Integer);
    
    procedure SetEventer(Value: TLEventer);
    procedure SetSession(aSession: TLSession);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    procedure ConnectAction(aSocket: TLHandle); virtual;
    procedure AcceptAction(aSocket: TLHandle); virtual;
    procedure ReceiveAction(aSocket: TLHandle); virtual;
    procedure SendAction(aSocket: TLHandle); virtual;
    procedure ErrorAction(aSocket: TLHandle; const msg: string); virtual;
    
    procedure ConnectEvent(aSocket: TLHandle); virtual;
    procedure DisconnectEvent(aSocket: TLHandle); virtual;
    procedure AcceptEvent(aSocket: TLHandle); virtual;
    procedure ReceiveEvent(aSocket: TLHandle); virtual;
    procedure CanSendEvent(aSocket: TLHandle); virtual;
    procedure ErrorEvent(aSocket: TLHandle; const msg: string); virtual;
    procedure EventerError(const msg: string; Sender: TLEventer);
    
    procedure RegisterWithEventer; virtual;
    
    procedure FreeSocks(const Forced: Boolean); virtual;
   public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    
    function Connect(const Address: string; const APort: Word): Boolean; virtual; overload;
    function Connect: Boolean; virtual; overload;
    
    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; virtual; abstract; overload;
    function Listen: Boolean; virtual; overload;
    
    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
    
    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
    
    function IterNext: Boolean; virtual; abstract;
    procedure IterReset; virtual; abstract;
   public
    property OnError: TLSocketErrorEvent read FOnError write FOnError;
    property OnReceive: TLSocketEvent read FOnReceive write FOnReceive;
    property OnDisconnect: TLSocketEvent read FOnDisconnect write FOnDisconnect;
    property OnCanSend: TLSocketEvent read FOnCanSend write FOnCanSend;
    property Socks[index: Integer]: TLSocket read GetItem; default;
    property Count: Integer read GetCount;
    property Connected: Boolean read GetConnected;
    property ListenBacklog: Integer read FListenBacklog write FListenBacklog;
    property Iterator: TLSocket read FIterator;
    property Timeout: Integer read GetTimeout write SetTimeout;
    property Eventer: TLEventer read FEventer write SetEventer;
    property EventerClass: TLEventerClass read FEventerClass write FEventerClass;
    property Session: TLSession read FSession write SetSession;
  end;
  
  { TLUdp }

  TLUdp = class(TLConnection)
   protected
    function InitSocket(aSocket: TLSocket): TLSocket; override;
    
    function GetConnected: Boolean; override;
    
    procedure ReceiveAction(aSocket: TLHandle); override;
    procedure ErrorAction(aSocket: TLHandle; const msg: string); override;
    
    function Bail(const msg: string): Boolean;
    
    procedure SetAddress(const Address: string);
   public
    constructor Create(aOwner: TComponent); override;
    
    function Connect(const Address: string; const APort: Word): Boolean; override;
    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; override;
    
    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;
    
    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
    function SendMessage(const msg: string; const Address: string): Integer; overload;
    
    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
    function Send(const aData; const aSize: Integer; const Address: string): Integer; overload;
    
    function IterNext: Boolean; override;
    procedure IterReset; override;

    procedure Disconnect(const Forced: Boolean = True); override;

    procedure CallAction; override;
  end;
  
  { TLTcp }

  TLTcp = class(TLConnection)
   protected
    FSocketNet: Integer;
    FCount: Integer;
    FReuseAddress: Boolean;
    FMsgBufferSize: integer;
    function InitSocket(aSocket: TLSocket): TLSocket; override;

    function GetConnected: Boolean; override;
    function GetConnecting: Boolean;
    function GetCount: Integer; override;
    function GetValidSocket: TLSocket;

    procedure SetReuseAddress(const aValue: Boolean);
    procedure SetSocketNet(const aValue: Integer);

    procedure ConnectAction(aSocket: TLHandle); override;
    procedure AcceptAction(aSocket: TLHandle); override;
    procedure ReceiveAction(aSocket: TLHandle); override;
    procedure SendAction(aSocket: TLHandle); override;
    procedure ErrorAction(aSocket: TLHandle; const msg: string); override;

    function Bail(const msg: string; aSocket: TLSocket): Boolean;

    procedure SocketDisconnect(aSocket: TLSocket);
   public
    constructor Create(aOwner: TComponent); override;

    function Connect(const Address: string; const APort: Word): Boolean; override;
    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; override;

    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;

    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;

    function IterNext: Boolean; override;
    procedure IterReset; override;

    procedure CallAction; override;

    procedure Disconnect(const Forced: Boolean = True); override;
   public
    property Connecting: Boolean read GetConnecting;
    property OnAccept: TLSocketEvent read FOnAccept write FOnAccept;
    property OnConnect: TLSocketEvent read FOnConnect write FOnConnect;
    property ReuseAddress: Boolean read FReuseAddress write SetReuseAddress;
    property SocketNet: Integer read FSocketNet write SetSocketNet;
    property MsgBufferSize: integer read FMsgBufferSize write FMsgBufferSize;
  end;

  { TLSession }

  TLSession = class(TComponent)
   protected
    FActive: Boolean;
   public
    procedure RegisterWithComponent(aConnection: TLConnection); virtual;

    procedure InitHandle(aHandle: TLHandle); virtual;

    procedure ReceiveEvent(aHandle: TLHandle); virtual;
    procedure SendEvent(aHandle: TLHandle); virtual;
    procedure ErrorEvent(aHandle: TLHandle; const msg: string); virtual;
    procedure ConnectEvent(aHandle: TLHandle); virtual;
    procedure AcceptEvent(aHandle: TLHandle); virtual;
    procedure DisconnectEvent(aHandle: TLHandle); virtual;

    procedure CallReceiveEvent(aHandle: TLHandle); inline;
    procedure CallSendEvent(aHandle: TLHandle); inline;
    procedure CallErrorEvent(aHandle: TLHandle; const msg: string); inline;
    procedure CallConnectEvent(aHandle: TLHandle); inline;
    procedure CallAcceptEvent(aHandle: TLHandle); inline;
    procedure CallDisconnectEvent(aHandle: TLHandle); inline;
   public
    property Active: Boolean read FActive;
  end;

implementation

//********************************TLSocket*************************************

constructor TLSocket.Create;
begin
  inherited Create;
  FHandle := INVALID_SOCKET;
  FListenBacklog := LDEFAULT_BACKLOG;
  FPrevSock := nil;
  FNextSock := nil;
  FSocketState := [ssCanSend];
  FConnectionStatus := scNone;
  FSocketType := SOCK_STREAM;
  FSocketNet := LAF_INET;
  FProtocol := LPROTO_TCP;
  FMSGBufferSize := 0;
end;

destructor TLSocket.Destroy;
begin
  if Assigned(FOnFree) then
    FOnFree(Self);

  inherited Destroy; // important! must be called before disconnect
  Disconnect(True);
end;

function TLSocket.SetState(const aState: TLSocketState; const TurnOn: Boolean = True): Boolean;
begin
  Result := False;

  case aState of
    ssServerSocket      : if TurnOn then
                            FSocketState := FSocketState + [aState]
                          else
                            raise Exception.Create('Can not turn off server socket feature');
                            
    ssBlocking          : SetBlocking(TurnOn);
    ssReuseAddress      : SetReuseAddress(TurnOn);

    ssCanSend,
    ssCanReceive        : if TurnOn then
                            FSocketState := FSocketState + [aState]
                          else
                            FSocketState := FSocketState - [aState];
    
    ssSSLActive         : raise Exception.Create('Can not turn SSL/TLS on in TLSocket instance');
{    ssNoDelay           : SetNoDelay(TurnOn);}
  end;
  
  Result := True;
end;

procedure TLSocket.Disconnect(const Forced: Boolean = True);
begin
  if Forced then
    HardDisconnect
  else
    SoftDisconnect;
end;

function TLSocket.LogError(const msg: string; const ernum: Integer): Boolean;
begin
  Result := False;
  if Assigned(FOnError) then
    if ernum > 0 then
      FOnError(Self, msg + LStrError(ernum))
    else
      FOnError(Self, msg);
end;

function TLSocket.Bail(const msg: string; const ernum: Integer): Boolean;
begin
  Result := False; // return the result for the caller
  if FDispose then // why?
    Exit;
  Disconnect(True);
  LogError(msg, ernum);
end;

function TLSocket.GetPeerAddress: string;
begin
  Result := '';
  if FSocketType = SOCK_STREAM then
    Result := NetAddrtoStr(FAddress.IPv4.sin_addr)
  else
    Result := NetAddrtoStr(FPeerAddress.IPv4.sin_addr);
end;

function TLSocket.GetLocalAddress: string;
var
  a: TSockAddr;
  l: Integer;
begin
  Result := '';
  l := SizeOf(a);
  if fpGetSockName(FHandle, @a, @l) = 0 then
    Result := NetAddrToStr(a.sin_addr);
end;

function TLSocket.SendPossible: Boolean; inline;
begin
  Result := True;
  if FConnectionStatus <> scConnected then
    Exit(LogError('Can''t send when not connected', -1));

  if not (ssCanSend in FSocketState) then begin
    if not Assigned(FConnection)
    or not Assigned(FConnection.FOnCanSend) then
      LogError('Send buffer full, try again later', -1);
    Exit(False);
  end;

  if ssServerSocket in FSocketState then
    Exit(LogError('Can''t send on server socket', -1));
end;

function TLSocket.ReceivePossible: Boolean; inline;
begin
  Result := (FConnectionStatus in [scConnected, scDisconnecting])
    and (ssCanReceive in FSocketState) and not (ssServerSocket in FSocketState);
end;

procedure TLSocket.SetOptions;
begin
  SetBlocking(FBlocking);
end;

procedure TLSocket.SetBlocking(const aValue: Boolean);
begin
  if FHandle >= 0 then // we already set our socket
    if not lCommon.SetBlocking(FHandle, aValue) then
      Bail('Error on SetBlocking', LSocketError)
    else begin
      FBlocking := aValue;
      if aValue then
        FSocketState := FSocketState + [ssBlocking]
      else
        FSocketState := FSocketState - [ssBlocking];
    end;
end;

procedure TLSocket.SetReuseAddress(const aValue: Boolean);
begin
  if FConnectionStatus = scNone then begin
    FReuseAddress := aValue;
    if aValue then
      FSocketState := FSocketState + [ssReuseAddress]
    else
      FSocketState := FSocketState - [ssReuseAddress];
  end;
end;

procedure TLSocket.HardDisconnect(const NoShutdown: Boolean = False);
var
  NeedsShutdown: Boolean;
begin
  NeedsShutdown := (FConnectionStatus = scConnected) and (FSocketType = SOCK_STREAM)
               and (not (ssServerSocket in FSocketState));
  if NoShutdown then
    NeedsShutdown := False;

  FDispose := True;
  FSocketState := FSocketState + [ssCanSend, ssCanReceive];
  FIgnoreWrite := True;
  if FConnectionStatus in [scConnected, scConnecting] then begin
    FConnectionStatus := scNone;
    if NeedsShutdown then
      if fpShutDown(FHandle, SHUT_RDWR) <> 0 then
        LogError('Shutdown error', LSocketError);

    if Assigned(FEventer) then
      FEventer.UnregisterHandle(Self);

    if CloseSocket(FHandle) <> 0 then
      LogError('Closesocket error', LSocketError);
    FHandle := INVALID_SOCKET;
  end;
end;

procedure TLSocket.SoftDisconnect;
begin
  if FConnectionStatus in [scConnected, scConnecting] then begin
    if  (FConnectionStatus = scConnected) and (not (ssServerSocket in FSocketState))
    and (FSocketType = SOCK_STREAM) then begin
      FConnectionStatus := scDisconnecting;
      if fpShutDown(FHandle, SHUT_WR) <> 0 then
        LogError('Shutdown error', LSocketError);
    end else
      HardDisconnect; // UDP or ServerSocket
  end;
end;

{procedure TLSocket.SetNoDelay(const aValue: Boolean);
begin
  if FHandle >= 0 then // we already set our socket
    if not lCommon.SetNoDelay(FHandle, aValue) then
      Bail('Error on SetNoDelay', LSocketError)
    else begin
      if aValue then
        FSocketState := FSocketState + [ssNoDelay]
      else
        FSocketState := FSocketState - [ssNoDelay];
    end;
end;}

function TLSocket.GetMessage(out msg: string): Integer;
begin
  Result := 0;
  SetLength(msg, BUFFER_SIZE);
  SetLength(msg, Get(PChar(msg)^, Length(msg)));
  Result := Length(msg);
end;

function TLSocket.Get(out aData; const aSize: Integer): Integer;
begin
  Result := 0;
  
  if aSize = 0 then
    raise Exception.Create('Invalid buffer size 0 in Get');

  if ReceivePossible then begin
    Result := DoGet(aData, aSize);

    if Result = 0 then
    begin
      FConnectionStatus := scNone;
      if FSocketType = SOCK_STREAM then
        Disconnect(True)
      else begin
        Bail('Receive Error [0 on recvfrom with UDP]', 0);
        Exit(0);
      end;
    end;

    Result := HandleResult(Result, soReceive);
  end;
end;

function TLSocket.GetConnected: Boolean;
begin
  Result := (FConnectionStatus = scConnected);
end;

function TLSocket.GetConnecting: Boolean;
begin
  Result := FConnectionStatus = scConnecting;
end;

function TLSocket.GetConnectionStatus: TLSocketConnectionStatus;
begin
  Result := FConnectionStatus;
end;

function TLSocket.GetIPAddressPointer: psockaddr;
begin
  case FSocketNet of
    LAF_INET  : Result := psockaddr(@FAddress.IPv4);
    LAF_INET6 : Result := psockaddr(@FAddress.IPv6);
  else
    raise Exception.Create('Unknown socket network type (not IPv4 or IPv6)');
  end;
end;

function TLSocket.GetIPAddressLength: TSocklen;
begin
  case FSocketNet of
    LAF_INET  : Result := SizeOf(FAddress.IPv4);
    LAF_INET6 : Result := SizeOf(FAddress.IPv6);
  else
    raise Exception.Create('Unknown socket network type (not IPv4 or IPv6)');
  end;
end;

function TLSocket.SetupSocket(const APort: Word; const Address: string): Boolean;
var
  Done: Boolean;
  Arg, Opt: Integer;
begin
  Result := false;
  if FConnectionStatus = scNone then begin
    Done := true;
    FHandle := fpSocket(FSocketNet, FSocketType, FProtocol);
    if FHandle = INVALID_SOCKET then
      Exit(Bail('Socket error', LSocketError));
    SetOptions;

    Arg := 1;
    if FSocketType = SOCK_DGRAM then begin
      if fpsetsockopt(FHandle, SOL_SOCKET, SO_BROADCAST, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
        Exit(Bail('SetSockOpt error', LSocketError));
    end else if FReuseAddress then begin
      Opt := SO_REUSEADDR;
      {$ifdef WIN32} // I expect 64 has it oddly, so screw them for now
      if (Win32Platform = 2) and (Win32MajorVersion >= 5) then
        Opt := Integer(not Opt);
      {$endif}
      if fpsetsockopt(FHandle, SOL_SOCKET, Opt, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
        Exit(Bail('SetSockOpt error setting reuseaddr', LSocketError));
    end;
    
    {$ifdef darwin}
    Arg := 1;
    if fpsetsockopt(FHandle, SOL_SOCKET, SO_NOSIGPIPE, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
      Exit(Bail('SetSockOpt error setting nosigpipe', LSocketError));
    {$endif}
    
    FillAddressInfo(FAddress, FSocketNet, Address, aPort);
    FillAddressInfo(FPeerAddress, FSocketNet, LADDR_BR, aPort);
    if FMSGBufferSize>0 then
      begin
      if fpsetsockopt(Handle, SOL_SOCKET, SO_RCVBUF, @FMSGBufferSize, Sizeof(integer))
        = SOCKET_ERROR then
        Exit(Bail('SetSockOpt error setting rcv buffer size', LSocketError));
      if fpsetsockopt(Handle, SOL_SOCKET, SO_SNDBUF, @FMSGBufferSize, Sizeof(integer))
        = SOCKET_ERROR then
        Exit(Bail('SetSockOpt error setting snd buffer size', LSocketError));
      end;
    Result  :=  Done;
  end;
end;

function TLSocket.DoSend(const aData; const aSize: Integer): Integer;
var
  AddressLength: Longint = SizeOf(FPeerAddress.IPv4);
  
begin
  if FSocketType = SOCK_STREAM then
    Result := Sockets.fpSend(FHandle, @aData, aSize, LMSG)
  else 
    Result := sockets.fpsendto(FHandle, @aData, aSize, LMSG, @FPeerAddress, AddressLength);
end;

function TLSocket.DoGet(out aData; const aSize: Integer): Integer;
var
  AddressLength: Longint = SizeOf(FPeerAddress.IPv4);
begin
  if FSocketType = SOCK_STREAM then
    Result := sockets.fpRecv(FHandle, @aData, aSize, LMSG)
  else
    Result := sockets.fpRecvfrom(FHandle, @aData, aSize, LMSG, @FPeerAddress, @AddressLength);
end;

function TLSocket.HandleResult(const aResult: Integer; aOp: TLSocketOperation): Integer;
const
  GSStr: array[TLSocketOperation] of string = ('Send', 'Get');
var
  LastError: Longint;
begin
  Result := aResult;
  if Result = SOCKET_ERROR then begin
    LastError := LSocketError;
    if IsBlockError(LastError) then case aOp of
      soSend:
         begin
           FSocketState := FSocketState - [ssCanSend];
           IgnoreWrite := False;
         end;
      soReceive:
         begin
           FSocketState := FSocketState - [ssCanReceive];
           IgnoreRead := False;
         end;
    end else if IsNonFatalError(LastError) then
      LogError(GSStr[aOp] + ' error', LastError) // non fatals don't cause disconnect
    else if (aOp = soSend) and IsPipeError(LastError) then begin
      LogError(GSStr[aOp] + ' error', LastError);
      HardDisconnect(True); {$warning check if we need aOp = soSend in the IF, perhaps bad recv is possible?}
    end else
      Bail(GSStr[aOp] + ' error', LastError);
      
    Result := 0;
  end;
end;

function TLSocket.GetLocalPort: Word;
begin
  Result := ntohs(FAddress.IPv4.sin_port);
end;

function TLSocket.GetPeerPort: Word;
begin
  if FSocketType = SOCK_STREAM then
    Result := ntohs(FAddress.IPv4.sin_port)
  else
    Result := ntohs(FPeerAddress.IPv4.sin_port);
end;

function TLSocket.Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
begin
  Result := False;

  if FConnectionStatus <> scNone then
    Disconnect(True);

  SetupSocket(APort, AIntf);
  if fpBind(FHandle, GetIPAddressPointer, GetIPAddressLength) = SOCKET_ERROR then
    Bail('Error on bind', LSocketError)
  else
    Result := true;

  if (FSocketType = SOCK_STREAM) and Result then
    if fpListen(FHandle, FListenBacklog) = SOCKET_ERROR then
      Result := Bail('Error on Listen', LSocketError)
    else
      Result := true;
end;

function TLSocket.Accept(const sersock: TSocket): Boolean;
var
  AddressLength: tsocklen;
begin
  Result := false;
  AddressLength := GetIPAddressLength;

  if FConnectionStatus <> scNone then
    Disconnect(True);

  FHandle := fpAccept(sersock, GetIPAddressPointer, @AddressLength);
  if FHandle <> INVALID_SOCKET then begin
    SetOptions;
    Result := true;
  end else
    Bail('Error on accept', LSocketError);
end;

function TLSocket.Connect(const Address: string; const aPort: Word): Boolean;
begin
  Result := False;
  
  if FConnectionStatus <> scNone then
    Disconnect(True);

  if SetupSocket(APort, Address) then begin
    fpConnect(FHandle, GetIPAddressPointer, GetIPAddressLength);
    FConnectionStatus := scConnecting;
    Result := True;
  end;
end;

function TLSocket.SendMessage(const msg: string): Integer;
begin
  Result := Send(PChar(msg)^, Length(msg));
end;

function TLSocket.Send(const aData; const aSize: Integer): Integer;
begin
  Result := 0;
  
  if aSize = 0 then
    raise Exception.Create('Invalid buffersize 0 in Send');

  if SendPossible then begin
    if aSize <= 0 then begin
      LogError('Send error: Size <= 0', -1);
      Exit(0);
    end;

    Result := HandleResult(DoSend(aData, aSize), soSend);
  end;
end;

//*******************************TLComponent*********************************

procedure TLComponent.SetCreator(AValue: TLComponent);
begin
  FCreator := aValue;
end;

constructor TLComponent.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FCreator := Self;
end;

//*******************************TLConnection*********************************

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

  FHost := '';
  FPort := 0;
  FListenBacklog := LDEFAULT_BACKLOG;
  FTimeout := 0;
  SocketClass := TLSocket;
  FOnReceive := nil;
  FOnError := nil;
  FOnDisconnect := nil;
  FOnCanSend := nil;
  FOnConnect := nil;
  FOnAccept := nil;
  FTimeVal.tv_sec := 0;
  FTimeVal.tv_usec := 0;
  FIterator := nil;
  FEventer := nil;
  FEventerClass := BestEventerClass;
end;

destructor TLConnection.Destroy;
begin
  FreeSocks(True);
  if Assigned(FEventer) then
    FEventer.DeleteRef;
  inherited Destroy;
end;

function TLConnection.Connect(const Address: string; const APort: Word
  ): Boolean;
begin
  FHost := Address;
  FPort := aPort;
  Result := False;
end;

function TLConnection.Connect: Boolean;
begin
  Result := Connect(FHost, FPort);
end;

function TLConnection.Listen: Boolean;
begin
  Result := Listen(FPort, FHost);
end;

procedure TLConnection.SetSession(aSession: TLSession);
begin
  if FSession = aSession then Exit;

  if FActive then
    raise Exception.Create('Cannot change session on active component');

  FSession := aSession;
  if Assigned(FSession) then begin
    FSession.FreeNotification(Self);
    FSession.RegisterWithComponent(Self);
  end;
end;

procedure TLConnection.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  
  if (Operation = opRemove) and (AComponent = FSession) then
    FSession := nil;
end;

function TLConnection.InitSocket(aSocket: TLSocket): TLSocket;
begin
  FActive := True; // once we got a socket, we're considered active
  aSocket.OnRead := @ReceiveAction;
  aSocket.OnWrite := @SendAction;
  aSocket.OnError := @ErrorAction;
  aSocket.ListenBacklog := FListenBacklog;
  aSocket.FCreator := FCreator;
  aSocket.FConnection := Self;
  aSocket.FSession := FSession;
  if Assigned(FSession) then
    FSession.InitHandle(aSocket);
  Result := aSocket;
end;

function TLConnection.GetCount: Integer;
begin
  Result := 1;
end;

function TLConnection.GetItem(const i: Integer): TLSocket;
var
  Tmp: TLSocket;
  Jumps: Integer;
begin
  Result := nil;
  Tmp := FRootSock;
  Jumps := 0;
  while Assigned(Tmp.NextSock) and (Jumps < i) do begin
    Tmp := Tmp.NextSock;
    Inc(Jumps);
  end;
  if Jumps = i then
    Result := Tmp;
end;

function TLConnection.GetTimeout: Integer;
begin
  if Assigned(FEventer) then
    Result := FEventer.Timeout
  else
    Result := FTimeout;
end;

procedure TLConnection.ConnectAction(aSocket: TLHandle);
begin
end;

procedure TLConnection.AcceptAction(aSocket: TLHandle);
begin
end;

procedure TLConnection.ReceiveAction(aSocket: TLHandle);
begin
end;

procedure TLConnection.SendAction(aSocket: TLHandle);
begin
  with TLSocket(aSocket) do begin
    SetState(ssCanSend);
    IgnoreWrite := True;

    if Assigned(FSession) then
      FSession.SendEvent(aSocket)
    else
      CanSendEvent(aSocket);
  end;
end;

procedure TLConnection.ErrorAction(aSocket: TLHandle; const msg: string);
begin
end;

procedure TLConnection.ConnectEvent(aSocket: TLHandle);
begin
  if Assigned(FOnConnect) then
    FOnConnect(TLSocket(aSocket));
end;

procedure TLConnection.DisconnectEvent(aSocket: TLHandle);
begin
  if Assigned(FOnDisconnect) then
    FOnDisconnect(TLSocket(aSocket));
end;

procedure TLConnection.AcceptEvent(aSocket: TLHandle);
begin
  if Assigned(FOnAccept) then
    FOnAccept(TLSocket(aSocket));
end;

procedure TLConnection.ReceiveEvent(aSocket: TLHandle);
begin
  if Assigned(FOnReceive) then
    FOnReceive(TLSocket(aSocket));
end;

procedure TLConnection.CanSendEvent(aSocket: TLHandle);
begin
  if Assigned(FOnCanSend) then
    FOnCanSend(TLSocket(aSocket));
end;

procedure TLConnection.ErrorEvent(aSocket: TLHandle; const msg: string);
begin
  if Assigned(FOnError) then
    FOnError(msg, TLSocket(aSocket));
end;

procedure TLConnection.SetTimeout(const AValue: Integer);
begin
  if Assigned(FEventer) then
    FEventer.Timeout := aValue;
  FTimeout := aValue;
end;

procedure TLConnection.SetEventer(Value: TLEventer);
begin
  if Assigned(FEventer) then
    FEventer.DeleteRef;
  FEventer := Value;
  FEventer.AddRef;
end;

procedure TLConnection.EventerError(const msg: string; Sender: TLEventer);
begin
  ErrorEvent(nil, msg);
end;

procedure TLConnection.RegisterWithEventer;
begin
  if not Assigned(FEventer) then begin
    FEventer := FEventerClass.Create;
    FEventer.OnError := @EventerError;
  end;

  if Assigned(FRootSock) then
    FEventer.AddHandle(FRootSock);

  if (FEventer.Timeout = 0) and (FTimeout <> 0) then
    FEventer.Timeout := FTimeout
  else
    FTimeout := FEventer.Timeout;
end;

procedure TLConnection.FreeSocks(const Forced: Boolean);
var
  Tmp, Tmp2: TLSocket;
begin
  Tmp := FRootSock;
  while Assigned(Tmp) do begin
    Tmp2 := Tmp;
    Tmp := Tmp.NextSock;
    Tmp2.Disconnect(Forced);
    if Forced then
      Tmp2.Free;
  end;
end;

//*******************************TLUdp*********************************

constructor TLUdp.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FTimeVal.tv_usec := 0;
  FTimeVal.tv_sec := 0;
end;

procedure TLUdp.Disconnect(const Forced: Boolean = True);
begin
  if Assigned(FRootSock) then begin
    FRootSock.Disconnect(True);
    FRootSock := nil; // even if the old one exists, eventer takes care of it
  end;
end;

function TLUdp.Connect(const Address: string; const APort: Word): Boolean;
begin
  Result := inherited Connect(Address, aPort);

  if Assigned(FRootSock) and (FRootSock.FConnectionStatus <> scNone) then
    Disconnect(True);

  FRootSock := InitSocket(SocketClass.Create);
  FIterator := FRootSock;

  Result := FRootSock.SetupSocket(APort, LADDR_ANY);
  
  if Result then begin
    FillAddressInfo(FRootSock.FPeerAddress, FRootSock.FSocketNet, Address, aPort);
    FRootSock.FConnectionStatus := scConnected;
    RegisterWithEventer;
  end;
end;

function TLUdp.Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
begin
  Result := False;

  if Assigned(FRootSock) and (FRootSock.FConnectionStatus <> scNone) then
    Disconnect(True);

  FRootSock := InitSocket(SocketClass.Create);
  FIterator := FRootSock;
  
  if FRootSock.Listen(APort, AIntf) then begin
    FillAddressInfo(FRootSock.FPeerAddress, FRootSock.FSocketNet, LADDR_BR, aPort);
  
    FRootSock.FConnectionStatus := scConnected;
    RegisterWithEventer;
    Result := True;
  end;
end;

function TLUdp.Bail(const msg: string): Boolean;
begin
  Result := False;

  Disconnect(True);

  if Assigned(FSession) then
    FSession.ErrorEvent(nil, msg)
  else
    ErrorEvent(FRootSock, msg);
end;

procedure TLUdp.SetAddress(const Address: string);
var
  n: Integer;
  s: string;
  p: Word;
begin
  n := Pos(':', Address);
  if n > 0 then begin
    s := Copy(Address, 1, n-1);
    p := Word(StrToInt(Copy(Address, n+1, Length(Address))));

    FillAddressInfo(FRootSock.FPeerAddress, FRootSock.FSocketNet, s, p);
  end else
    FillAddressInfo(FRootSock.FPeerAddress, FRootSock.FSocketNet, Address,
                                            FRootSock.PeerPort);
end;

function TLUdp.InitSocket(aSocket: TLSocket): TLSocket;
begin
  Result := FRootSock;
  if not Assigned(FRootSock) then begin
    aSocket.SocketType := SOCK_DGRAM;
    aSocket.Protocol := LPROTO_UDP;
    Result := inherited InitSocket(aSocket); // call last, to make sure sessions get their turn in overriding
  end;
end;

procedure TLUdp.ReceiveAction(aSocket: TLHandle);
begin
  with TLSocket(aSocket) do begin
    SetState(ssCanReceive);
    if Assigned(FSession) then
      FSession.ReceiveEvent(aSocket)
    else
      ReceiveEvent(aSocket);
  end;
end;

procedure TLUdp.ErrorAction(aSocket: TLHandle; const msg: string);
begin
  if Assigned(FSession) then
    FSession.ErrorEvent(aSocket, msg)
  else
    ErrorEvent(aSocket, msg);
end;

function TLUdp.IterNext: Boolean;
begin
  Result := False;
end;

procedure TLUdp.IterReset;
begin
end;

procedure TLUdp.CallAction;
begin
  if Assigned(FEventer) then
    FEventer.CallAction;
end;

function TLUdp.GetConnected: Boolean;
begin
  Result := False;
  if Assigned(FRootSock) then
  Result := FRootSock.ConnectionStatus = scConnected;
end;

function TLUdp.Get(out aData; const aSize: Integer; aSocket: TLSocket): Integer;
begin
  Result := 0;
  if Assigned(FRootSock) then
    Result := FRootSock.Get(aData, aSize);
end;

function TLUdp.GetMessage(out msg: string; aSocket: TLSocket): Integer;
begin
  Result := 0;
  if Assigned(FRootSock) then
    Result := FRootSock.GetMessage(msg);
end;

function TLUdp.SendMessage(const msg: string; aSocket: TLSocket = nil): Integer;
begin
  Result := 0;
  if Assigned(FRootSock) then
    Result := FRootSock.SendMessage(msg)
end;

function TLUdp.SendMessage(const msg: string; const Address: string): Integer;
begin
  Result := 0;
  if Assigned(FRootSock) then begin
    SetAddress(Address);
    Result := FRootSock.SendMessage(msg)
  end;
end;

function TLUdp.Send(const aData; const aSize: Integer; aSocket: TLSocket): Integer;
begin
  Result := 0;
  if Assigned(FRootSock) then
    Result := FRootSock.Send(aData, aSize)
end;

function TLUdp.Send(const aData; const aSize: Integer; const Address: string
  ): Integer;
begin
  Result := 0;
  if Assigned(FRootSock) then begin
    SetAddress(Address);
    Result := FRootSock.Send(aData, aSize);
  end;
end;

//******************************TLTcp**********************************

constructor TLTcp.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FSocketNet := LAF_INET; // default to IPv4
  FIterator  := nil;
  FCount     := 0;
  FRootSock  := nil;
end;

function TLTcp.Connect(const Address: string; const APort: Word): Boolean;
begin
  Result := inherited Connect(Address, aPort);
  
  if Assigned(FRootSock) then
    Disconnect(True);
    
  FRootSock := InitSocket(SocketClass.Create);
  Result := FRootSock.Connect(Address, aPort);
  
  if Result then begin
    Inc(FCount);
    FIterator := FRootSock;
    RegisterWithEventer;
  end else begin
    FreeAndNil(FRootSock); // one possible use, since we're not in eventer yet
    FIterator := nil;
  end;
end;

function TLTcp.Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
begin
  Result := false;
  
  if Assigned(FRootSock) then
    Disconnect(True);
  
  FRootSock := InitSocket(SocketClass.Create);
  FRootSock.SetReuseAddress(FReuseAddress);
  FRootSock.MsgBufferSize:= MsgBufferSize;
  if FRootSock.Listen(APort, AIntf) then begin
    FRootSock.SetState(ssServerSocket);
    FRootSock.FConnectionStatus := scConnected;
    FIterator := FRootSock;
    Inc(FCount);
    RegisterWithEventer;
    Result := true;
  end;
end;

function TLTcp.Bail(const msg: string; aSocket: TLSocket): Boolean;
begin
  Result  :=  False;

  if Assigned(FSession) then
    FSession.ErrorEvent(aSocket, msg)
  else
    ErrorEvent(aSocket, msg);

  if Assigned(aSocket) then
    aSocket.Disconnect(True)
  else
    Disconnect(True);
end;

procedure TLTcp.SocketDisconnect(aSocket: TLSocket);
begin
  if aSocket = FIterator then begin
    if Assigned(FIterator.NextSock) then
      FIterator := FIterator.NextSock
    else if Assigned(FIterator.PrevSock) then
      FIterator := FIterator.PrevSock
    else FIterator := nil; // NOT iterreset, not reorganized yet
    if Assigned(FIterator) and (ssServerSocket in FIterator.SocketState) then
      FIterator := nil;
  end;

  if aSocket = FRootSock then
    FRootSock := aSocket.NextSock;
  if Assigned(aSocket.PrevSock) then
    aSocket.PrevSock.NextSock := aSocket.NextSock;
  if Assigned(aSocket.NextSock) then
    aSocket.NextSock.PrevSock := aSocket.PrevSock;
    
  Dec(FCount);
end;

function TLTcp.InitSocket(aSocket: TLSocket): TLSocket;
begin
  aSocket.SocketType := SOCK_STREAM;
  aSocket.Protocol := LPROTO_TCP;
  aSocket.SocketNet := FSocketNet;
  aSocket.FOnFree := @SocketDisconnect;

  Result := inherited InitSocket(aSocket); // call last to make sure session can override options
end;

function TLTcp.IterNext: Boolean;
begin
  Result := False;
  if Assigned(FIterator.NextSock) then begin
    FIterator := FIterator.NextSock;
    Result := True;
  end else IterReset;
end;

procedure TLTcp.IterReset;
begin
  FIterator := FRootSock;
end;

procedure TLTcp.Disconnect(const Forced: Boolean = True);
begin
  if Assigned(FOnDisconnect) then
    FOnDisconnect(FRootSock);
  FreeSocks(Forced);
  FRootSock := nil;
  FCount := 0;
  FIterator := nil;
end;

procedure TLTcp.CallAction;
begin
  if Assigned(FEventer) then
    FEventer.CallAction;
end;

procedure TLTcp.ConnectAction(aSocket: TLHandle);
var
  a: TInetSockAddr;
  l: Longint;
begin
  with TLSocket(aSocket) do begin
    l := SizeOf(a);
    if Sockets.fpGetPeerName(FHandle, @a, @l) <> 0 then
      Self.Bail('Error on connect: connection refused', TLSocket(aSocket))
    else begin
      FConnectionStatus := scConnected;
      IgnoreWrite := True;
      if Assigned(FSession) then
        FSession.ConnectEvent(aSocket)
      else
        ConnectEvent(aSocket);
    end;
  end;
end;

procedure TLTcp.AcceptAction(aSocket: TLHandle);
var
  Tmp: TLSocket;
begin
  Tmp := InitSocket(SocketClass.Create);
  
  if Tmp.Accept(FRootSock.FHandle) then begin
    if Assigned(FRootSock.FNextSock) then begin
      Tmp.FNextSock := FRootSock.FNextSock;
      FRootSock.FNextSock.FPrevSock := Tmp;
    end;
    
    FRootSock.FNextSock := Tmp;
    Tmp.FPrevSock := FRootSock;
    
    if not Assigned(FIterator)      // if we don't have (bug?) an iterator yet
    or (ssServerSocket in FIterator.SocketState) then // or if it's the first socket accepted
      FIterator := Tmp;  // assign it as iterator (don't assign later acceptees)
      
    Inc(FCount);
    FEventer.AddHandle(Tmp);
    
    Tmp.FConnectionStatus := scConnected;
    Tmp.IgnoreWrite := True;

    if Assigned(FSession) then
      FSession.AcceptEvent(Tmp)
    else
      AcceptEvent(Tmp);
  end else
    Tmp.Free;
end;

procedure TLTcp.ReceiveAction(aSocket: TLHandle);
begin
  if (TLSocket(aSocket) = FRootSock) and (ssServerSocket in TLSocket(aSocket).SocketState) then
    AcceptAction(aSocket)
  else with TLSocket(aSocket) do begin
    if FConnectionStatus in [scConnected, scDisconnecting] then begin
      SetState(ssCanReceive);
      if Assigned(FSession) then
        FSession.ReceiveEvent(aSocket)
      else
        ReceiveEvent(aSocket);

      if not (FConnectionStatus = scConnected) then begin
        DisconnectEvent(aSocket);
        aSocket.Free;
      end;
    end;
  end;
end;

procedure TLTcp.SendAction(aSocket: TLHandle);
begin
  with TLSocket(aSocket) do begin
    if FConnectionStatus = scConnecting then
      ConnectAction(aSocket)
    else
      inherited;
  end;
end;

procedure TLTcp.ErrorAction(aSocket: TLHandle; const msg: string);
begin
  if TLSocket(aSocket).ConnectionStatus = scConnecting then begin
    Self.Bail('Error on connect: connection refused', TLSocket(aSocket));
    Exit;
  end;
  
  if Assigned(FSession) then
    FSession.ErrorEvent(aSocket, msg)
  else
    ErrorEvent(aSocket, msg);
end;

function TLTcp.GetConnected: Boolean;
var
  Tmp: TLSocket;
begin
  Result := False;
  Tmp := FRootSock;
  while Assigned(Tmp) do begin
    if Tmp.ConnectionStatus = scConnected then begin
      Result := True;
      Exit;
    end else Tmp := Tmp.NextSock;
  end;
end;

function TLTcp.GetConnecting: Boolean;
begin
  Result := False;
  if Assigned(FRootSock) then
    Result := FRootSock.ConnectionStatus = scConnecting;
end;

function TLTcp.GetCount: Integer;
begin
  Result := FCount;
end;

function TLTcp.GetValidSocket: TLSocket;
begin
  Result := nil;
  
  if Assigned(FIterator) and not (ssServerSocket in FIterator.SocketState) then
    Result := FIterator
  else if Assigned(FRootSock) and Assigned(FRootSock.FNextSock) then
    Result := FRootSock.FNextSock;
end;

procedure TLTcp.SetReuseAddress(const aValue: Boolean);
begin
  if not Assigned(FRootSock)
  or (FRootSock.FConnectionStatus = scNone) then
    FReuseAddress := aValue;
end;

procedure TLTcp.SetSocketNet(const aValue: Integer);
begin
  if GetConnected then
    raise Exception.Create('Cannot set socket network on a connected system');

  FSocketNet := aValue;
end;

function TLTcp.Get(out aData; const aSize: Integer; aSocket: TLSocket): Integer;
begin
  Result := 0;

  if not Assigned(aSocket) then
    aSocket := GetValidSocket;

  if Assigned(aSocket) then
    Result := aSocket.Get(aData, aSize)
  else
    Bail('No connected socket to get through', nil);
end;

function TLTcp.GetMessage(out msg: string; aSocket: TLSocket): Integer;
begin
  Result := 0;

  if not Assigned(aSocket) then
    aSocket := GetValidSocket;

  if Assigned(aSocket) then
    Result := aSocket.GetMessage(msg)
  else
    Bail('No connected socket to get through', nil);
end;

function TLTcp.Send(const aData; const aSize: Integer; aSocket: TLSocket): Integer;
begin
  Result := 0;

  if not Assigned(aSocket) then
    aSocket := GetValidSocket;

  if Assigned(aSocket) then
    Result := aSocket.Send(aData, aSize)
  else
    Bail('No connected socket to send through', nil);
end;

function TLTcp.SendMessage(const msg: string; aSocket: TLSocket): Integer;
begin
  Result := Send(PChar(msg)^, Length(msg), aSocket);
end;

//*******************************TLSession*********************************

procedure TLSession.RegisterWithComponent(aConnection: TLConnection);
begin
  if not Assigned(aConnection) then
    raise Exception.Create('Cannot register session with nil connection');
end;

procedure TLSession.InitHandle(aHandle: TLHandle);
begin
  TLSocket(aHandle).FSession := Self;
end;

procedure TLSession.ReceiveEvent(aHandle: TLHandle);
begin
  FActive := True;
  CallReceiveEvent(aHandle);
end;

procedure TLSession.SendEvent(aHandle: TLHandle);
begin
  FActive := True;
  CallSendEvent(aHandle);
end;

procedure TLSession.ErrorEvent(aHandle: TLHandle; const msg: string);
begin
  FActive := True;
  CallErrorEvent(aHandle, msg);
end;

procedure TLSession.ConnectEvent(aHandle: TLHandle);
begin
  FActive := True;
  CallConnectEvent(aHandle);
end;

procedure TLSession.AcceptEvent(aHandle: TLHandle);
begin
  FActive := True;
  CallAcceptEvent(aHandle);
end;

procedure TLSession.DisconnectEvent(aHandle: TLHandle);
begin
  FActive := True;
  CallDisconnectEvent(aHandle);
end;

procedure TLSession.CallReceiveEvent(aHandle: TLHandle); inline;
begin
  TLSocket(aHandle).FConnection.ReceiveEvent(TLSocket(aHandle));
end;

procedure TLSession.CallSendEvent(aHandle: TLHandle); inline;
begin
  TLSocket(aHandle).FConnection.CanSendEvent(TLSocket(aHandle));
end;

procedure TLSession.CallErrorEvent(aHandle: TLHandle; const msg: string);
  inline;
begin
  TLSocket(aHandle).FConnection.ErrorEvent(TLSocket(aHandle), msg);
end;

procedure TLSession.CallConnectEvent(aHandle: TLHandle); inline;
begin
  TLSocket(aHandle).FConnection.ConnectEvent(TLSocket(aHandle));
end;

procedure TLSession.CallAcceptEvent(aHandle: TLHandle); inline;
begin
  TLSocket(aHandle).FConnection.AcceptEvent(TLSocket(aHandle));
end;

procedure TLSession.CallDisconnectEvent(aHandle: TLHandle); inline;
begin
  TLSocket(aHandle).FConnection.DisconnectEvent(TLSocket(aHandle));
end;


end.