freepascal.compiler/packages/fcl-net/src/ssockets.pp

{
    This file is part of the Free Component Library (FCL)
    Copyright (c) 1999-2000 by the Free Pascal development team

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    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.

 **********************************************************************}
{$MODE objfpc}{$H+}
{$R-}

{$IFNDEF FPC_DOTTEDUNITS}
unit ssockets;
{$ENDIF FPC_DOTTEDUNITS}

interface

{$IFDEF FPC_DOTTEDUNITS}
uses
  System.SysUtils, System.Classes, System.CTypes, System.Net.Sockets;
{$ELSE FPC_DOTTEDUNITS}
uses
  SysUtils, Classes, ctypes, sockets;
{$ENDIF FPC_DOTTEDUNITS}

type

  TSocketErrorType = (
    seHostNotFound,
    seCreationFailed,
    seBindFailed,
    seListenFailed,
    seConnectFailed,
    seConnectTimeOut,
    seAcceptFailed,
    seAcceptWouldBlock,
    seIOTimeOut);

  TSocketOption = (soDebug,soReuseAddr,soKeepAlive,soDontRoute,soBroadcast,
                   soOOBinline);
  TSocketOptions = Set of TSocketOption;

  ESocketError = class(Exception)
    Code: TSocketErrorType;
    constructor Create(ACode: TSocketErrorType; const MsgArgs: array of const);overload;
  end;

  TAcceptErrorAction = (aeaRaise,aeaIgnore,aeaStop);
  TSocketStream = Class;
  TSocketServer = Class;
  TServerSocketStream = class;
  TInetSocket = Class;
{$IFDEF UNIX}
  TUnixSocket = class;
  TUnixSocketClass = Class of TUnixSocket;
{$ENDIF}
  TSocketStreamClass = Class of TSocketStream;
  TInetSocketClass = Class of TInetSocket;
  TServerSocketStreamClass = Class of TServerSocketStream;



  // Handles all OS calls

  { TSocketHandler }
  TSocketState = (sosCanread,sosCanWrite,sosException);
  TSocketStates = Set of TSocketState;

  TSocketHandler = Class(TObject)
  Private
    FSocket: TSocketStream;
  Protected
    FLastError : integer;
    Procedure SetSocket(const AStream: TSocketStream); virtual;
    Procedure CheckSocket;
  Public
    constructor Create; virtual;
    // Called after the connect call succeded. Returns True to continue, false to close connection.
    function Connect: boolean; virtual;
    // Called after the accept call succeded on the NEW client socket
    function Accept : Boolean; virtual;
    Function Close : Boolean; virtual;
    function Shutdown(BiDirectional : Boolean): boolean; virtual;
    function Select(aCheck : TSocketStates; TimeOut : Integer): TSocketStates; virtual;
    function CanRead(TimeOut : Integer): Boolean; virtual;
    function Recv(Const Buffer; Count: Integer): Integer; virtual;
    function Send(Const Buffer; Count: Integer): Integer; virtual;
    function BytesAvailable: Integer; virtual;
    // Call this to get extra error info.
    Function GetLastErrorDescription : String; virtual;
    Property Socket : TSocketStream Read FSocket;
    Property LastError : Integer Read FLastError;
  end;
  TSocketHandlerClass = Class of TSocketHandler;

  { TSocketStream }
  TSocketStreamArray = Array of TSocketStream;

  TSocketStream = class(THandleStream)
  Private
    FClosed: Boolean;
    FOnClose: TNotifyEvent;
    FPeerClosed: Boolean;
    FReadFlags: Integer;
    FSocketInitialized : Boolean;
    FSocketOptions : TSocketOptions;
    FWriteFlags: Integer;
    FHandler : TSocketHandler;
    FIOTimeout : Integer;
    FConnectTimeout : Integer;
    function GetLastError: Integer;
    Procedure GetSockOptions;
    procedure SetConnectTimeout(AValue: Integer);
    Procedure SetSocketOptions(Value : TSocketOptions);
    function GetLocalAddress: {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.TSockAddr;
    function GetRemoteAddress: {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.TSockAddr;
    procedure SetIOTimeout(AValue: Integer);
  Protected
    Procedure DoOnClose; virtual;
  Public
    Constructor Create (AHandle : Longint; AHandler : TSocketHandler = Nil);virtual;
    destructor Destroy; override;
    Class Function Select(Var aRead,aWrite,aExceptions : TSocketStreamArray; aTimeOut: Integer): Boolean; virtual;
    Procedure Close;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Select(aCheck : TSocketStates; TimeOut : Integer): TSocketStates;
    Function CanRead(TimeOut : Integer): Boolean; virtual;
    Function Read (Var Buffer; Count : Longint) : longint; Override;
    Function Write (Const Buffer; Count : Longint) :Longint; Override;
    Property SocketOptions : TSocketOptions Read FSocketOptions
                                            Write SetSocketOptions;
    property LocalAddress: {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}sockets.TSockAddr read GetLocalAddress;
    property RemoteAddress: {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}sockets.TSockAddr read GetRemoteAddress;
    Property LastError : Integer Read GetLastError;
    Property ReadFlags : Integer Read FReadFlags Write FReadFlags;
    Property WriteFlags : Integer Read FWriteFlags Write FWriteFlags;
    Property IOTimeout : Integer read FIOTimeout Write SetIOTimeout;
    Property ConnectTimeout : Integer read FConnectTimeout Write SetConnectTimeout;
    Property OnClose : TNotifyEvent Read FOnClose Write FOnClose;
    Property Handler : TSocketHandler Read FHandler;
    // We called close
    Property Closed : Boolean read FClosed;
    // Peer closed detected when reading.
    Property PeerClosed : Boolean Read FPeerClosed;
  end;

  TSocketClientEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
  TConnectEvent = TSocketClientEvent;
  TDisconnectEvent = TSocketClientEvent;
  TConnectionDroppedEvent = TSocketClientEvent;
  TConnectQuery = Procedure (Sender : TObject; ASocket : Longint; Var Allow : Boolean) of Object;
  TOnAcceptError = Procedure (Sender : TObject; ASocket : Longint; E : Exception; Var ErrorAction : TAcceptErrorAction) of Object;
  TGetClientSocketHandlerEvent = Procedure (Sender : TObject; Out AHandler : TSocketHandler) of object;
  TForeachHandler = Procedure (Sender : TObject; aClient : TSocketStream; var aContinue : Boolean) of object;

  { TSocketServer }

  TSocketServer = Class(TObject)
  Private
    FIdleTimeOut: Cardinal;
    FMaxSimultaneousConnections: longint;
    FOnAcceptError: TOnAcceptError;
    FOnConnectionDropped: TConnectionDroppedEvent;
    FOnCreateClientSocketHandler: TGetClientSocketHandlerEvent;
    FOnDisconnect: TDisconnectEvent;
    FOnIdle : TNotifyEvent;
    FNonBlocking : Boolean;
    FSocket : longint;
    FAccepting : Boolean;
    FMaxConnections : Longint;
    FQueueSize : Longint;
    FOnConnect : TConnectEvent;
    FOnConnectQuery : TConnectQuery;
    FHandler : TSocketHandler;
    FConnections : TThreadList;
    Procedure DoOnIdle;
    function GetConnectionCount: Integer;
    Function GetReuseAddress: Boolean;
    Function GetKeepAlive : Boolean;
    Function GetLinger : Integer;
    Procedure SetReuseAddress (AValue : Boolean);
    Procedure SetKeepAlive (AValue : Boolean);
    Procedure SetLinger(ALinger : Integer);
  Protected
    FSockType : Longint;
    FBound : Boolean;
    Procedure SocketClosed(aSocket: TSocketStream);
    Procedure DoConnectionDropped(aSocket : TSocketStream); virtual;
    Procedure DoDisconnect(aSocket : TSocketStream); virtual;
    Procedure DoConnect(ASocket : TSocketStream); Virtual;
    Function  DoConnectQuery(ASocket : longint): Boolean ;Virtual;
    Procedure Bind; Virtual; Abstract;
    Function  Accept: Longint;Virtual;Abstract;
    Function  SockToStream (ASocket : Longint) : TSocketStream;Virtual;Abstract;
    Procedure Close; Virtual;
    Procedure Abort;
    Procedure RemoveSelfFromConnections; virtual;

    Function RunIdleLoop : Boolean;
    function GetConnection: TSocketStream; virtual; abstract;
    Function HandleAcceptError(E : ESocketError) : TAcceptErrorAction;
    Function GetClientSocketHandler(aSocket : Longint) : TSocketHandler; virtual;
    Property Handler : TSocketHandler Read FHandler;
  Public
    Constructor Create(ASocket : Longint; AHandler : TSocketHandler);
    Destructor Destroy; Override;
    Procedure Listen;
    function  GetSockopt(ALevel,AOptName : cint; var optval; Var optlen : tsocklen): Boolean;
    function  SetSockopt(ALevel,AOptName : cint; var optval; optlen : tsocklen): Boolean;
    Procedure StartAccepting;
    Procedure StopAccepting(DoAbort : Boolean = False);
    Procedure SetNonBlocking;
    Procedure Foreach(aHandler : TForeachHandler);
    Property Bound : Boolean Read FBound;
    // Maximium number of connections in total. *Not* the simultaneous connection count. -1 keeps accepting.
    Property MaxConnections : longint Read FMaxConnections Write FMaxConnections;
    Property MaxSimultaneousConnections : longint Read FMaxSimultaneousConnections Write FMaxSimultaneousConnections;

    Property QueueSize : Longint Read FQueueSize Write FQueueSize default 5;
    Property OnConnect : TConnectEvent Read FOnConnect Write FOnConnect;
    Property OnDisconnect : TDisconnectEvent Read FOnDisconnect Write FOnDisconnect;
    Property OnConnectionDropped : TConnectionDroppedEvent Read FOnConnectionDropped Write FOnConnectionDropped;
    Property OnConnectQuery : TConnectQuery Read FOnConnectQuery Write FOnConnectQuery;
    Property OnAcceptError : TOnAcceptError Read FOnAcceptError Write FOnAcceptError;
    Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdle;
    Property NonBlocking : Boolean Read FNonBlocking;
    Property Socket : Longint Read FSocket;
    Property SockType : Longint Read FSockType;
    Property KeepAlive : Boolean Read GetKeepAlive Write SetKeepAlive;
    Property ReuseAddress : Boolean Read GetReuseAddress Write SetReuseAddress;
    // -1 means no linger. Any value >=0 sets linger on.
    Property Linger: Integer Read GetLinger Write Setlinger;
    // Accept Timeout in milliseconds.
    // If Different from 0, then there will be an idle loop before accepting new connections, Calling OnIdle if no new connection appeared in the specified timeout.
    Property AcceptIdleTimeOut : Cardinal Read FIdleTimeOut Write FIdleTimeout;
    Property OnCreateClientSocketHandler : TGetClientSocketHandlerEvent Read FOnCreateClientSocketHandler Write FOnCreateClientSocketHandler;
    Property ConnectionCount : Integer Read GetConnectionCount;
  end;

  { TInetServer }

  TInetServer = Class(TSocketServer)
  private
    FAddr : TINetSockAddr;
    FPort : Word;
    FHost: string;
  Protected
    Function GetConnection: TSocketStream; override;
    Function SockToStream (ASocket : Longint) : TSocketStream;Override;
    Function Accept : Longint;override;
    Property Addr : TINetSockAddr Read FAddr;
  Public
    DefaultServerSocketClass : TServerSocketStreamClass;
  Public
    Procedure Bind; Override;
    Constructor Create(APort: Word);
    Constructor Create(const aHost: string; const APort: Word; AHandler : TSocketHandler = Nil);
    Property Port : Word Read FPort;
    Property Host : string Read FHost;
  end;

{$ifdef Unix}

  { TUnixServer }

  TUnixServer = Class(TSocketServer)
  Private
    FUnixAddr : TUnixSockAddr;
    FFileName : String;
  Protected
    Procedure Bind; Override;
    Function Accept : Longint;override;
    function GetConnection: TSocketStream; override;
    Function SockToStream (ASocket : Longint) : TSocketStream;Override;
    Procedure Close; override;
  Public
    DefaultUnixSocketClass : TUnixSocketClass;
  Public
    Constructor Create(const AFileName : String; AHandler : TSocketHandler = Nil);
    Property FileName : String Read FFileName;
  end;
{$endif}

  { TInetSocket }
  TBlockingMode = (bmBlocking,bmNonBlocking);
  TBlockingModes = Set of TBlockingMode;
  TCheckTimeoutResult = (ctrTimeout,ctrError,ctrOK);

  {$if defined(unix) or defined(windows)}
  {$DEFINE HAVENONBLOCKING}
  {$endif}

  TNonBlockingSocketStream = class(TSocketStream)
  {$IFDEF HAVENONBLOCKING}
  function SetSocketBlockingMode(ASocket: cint; ABlockMode: TBlockingMode; AFDSPtr: Pointer): boolean; virtual;
  function CheckSocketConnectTimeout(ASocket: cint; AFDSPtr: Pointer; ATimeVPtr: Pointer): TCheckTimeoutResult; virtual;
  {$ENDIF}
  end;

  { TServerSocketStream }
  TServerSocketStream = class(TNonBlockingSocketStream)
  Protected
    FServer : TSocketServer;
  Protected
    Procedure DoOnClose; override;
    Property Server : TSocketServer Read FServer;
  Public
    Function CanRead(TimeOut : Integer): Boolean; override;
  end;

  TInetSocket = Class(TNonBlockingSocketStream)
  Private
    FHost : String;
    FPort : Word;
  Public
    Constructor Create(const AHost: String; APort: Word; AHandler : TSocketHandler = Nil); Overload;
    Constructor Create(const AHost: String; APort: Word; aConnectTimeout : Integer; AHandler : TSocketHandler = Nil); Overload;
    Procedure Connect; Virtual;
    Property Host : String Read FHost;
    Property Port : Word Read FPort;
  end;

{$ifdef Unix}

  TUnixSocket = Class(TNonBlockingSocketStream)
  Private
    FFileName : String;
  Protected
    Procedure DoConnect(ASocket : longint); Virtual;
  Public
    Constructor Create(ASocket : Longint); Overload;
    Constructor Create(const AFileName : String); Overload;
    Property FileName : String Read FFileName;
  end;
{$endif}

Implementation

{$IFDEF FPC_DOTTEDUNITS}
uses
// This must be here, to prevent it from overriding the sockets definitions... :/
{$ifdef unix}
  UnixApi.Base,UnixApi.Unix,
{$endif}
{$ifdef Windows}
  WinApi.Winsock2, WinApi.Windows,
{$endif}
  System.Net.Resolve;
{$ELSE FPC_DOTTEDUNITS}
uses
// This must be here, to prevent it from overriding the sockets definitions... :/
{$ifdef unix}
  BaseUnix,Unix,
{$endif}
{$ifdef windows}
  winsock2, windows,
{$endif}
  resolve;
{$ENDIF FPC_DOTTEDUNITS}

Const
  SocketBlockingMode = 0;
  SocketNonBlockingMode = 1;


{ ---------------------------------------------------------------------
  ESocketError
  ---------------------------------------------------------------------}

resourcestring
  strHostNotFound = 'Host name resolution for "%s" failed.';
  strSocketCreationFailed = 'Creation of socket failed: %s';
  strSocketBindFailed = 'Binding of socket failed: %s';
  strSocketListenFailed = 'Listening on port #%d failed, error: %d';
  strSocketConnectFailed = 'Connect to %s failed: %s';
  strSocketAcceptFailed = 'Could not accept a client connection on socket: %d, error %d';
  strSocketAcceptWouldBlock = 'Accept would block on socket: %d';
  strSocketIOTimeOut = 'Failed to set IO Timeout to %d';
  strErrNoStream = 'Socket stream not assigned';
  strSocketConnectTimeOut = 'Connection to %s timed out.';

{ TServerSocketStream }

function TServerSocketStream.CanRead(TimeOut : Integer): Boolean;
begin
  Result:=inherited CanRead(TimeOut);
  Result:=Result and Assigned(FServer); // main server is gone, cannot read from it
end;

procedure TServerSocketStream.DoOnClose;
begin
  if Assigned(FServer) then
    FServer.SocketClosed(Self);
  inherited DoOnClose;
end;

{ TSocketHandler }

Procedure TSocketHandler.SetSocket(const AStream: TSocketStream);
begin
  FSocket:=AStream;
end;

Procedure TSocketHandler.CheckSocket;
begin
  If not Assigned(FSocket) then
    Raise ESocketError.Create(StrErrNoStream);
end;

constructor TSocketHandler.Create;
begin
  FSocket:=Nil;
end;

function TSocketHandler.Connect: boolean;

begin
  // Only descendents can change this
  Result:=True;
end;

function TSocketHandler.Accept : Boolean;


begin
  // Only descendents can change this
  Result:=True;
end;

function TSocketHandler.Shutdown(BiDirectional: Boolean): boolean;
begin
  CheckSocket ;
  Result:=False;
end;

function TSocketHandler.Select(aCheck: TSocketStates; TimeOut: Integer): TSocketStates;
{$if defined(unix) or defined(windows)}
var
  FDSR,FDSW,FDSE : TFDSet;
  PFDSR,PFDSW,PFDSE : PFDSet;
  TimeV: TTimeVal;
  PTV : ^TTimeVal;
  res : Longint;

  Procedure DoSet(var FDS : TFDSet; var PFDS : PFDSet; aState : TSocketState);

  begin
    if not (aState in aCheck) then
      PFDS:=nil
    else
      begin
      FDS := Default(TFDSet);
      {$ifdef unix}
      fpFD_Zero(FDS);
      fpFD_Set(FSocket.Handle, FDS);
      {$endif}
      {$ifdef windows}
      FDS := Default(TFDSet);
      FD_Zero(FDS);
      FD_Set(FSocket.Handle, FDS);
      {$ENDIF}
      PFDS:=@FDS;
      end
  end;

  Procedure CheckSet(var FDS : TFDSet; aState : TSocketState);

  begin
    if aState in aCheck then
      begin
      {$ifdef unix}
      if fpFD_IsSet(FSocket.Handle, FDS)>0 then
        Include(Result,aState);
      {$endif}
      {$ifdef windows}
      if FD_IsSet(FSocket.Handle, FDS) then
        Include(Result,aState);
      {$endif}
      end;
  end;

{$endif}
begin
  Result:=[];
{$if defined(unix) or defined(windows)}
  Res:=-1;
  if Timeout<0 then
    PTV:=Nil
  else
    begin
    TimeV.tv_usec := (TimeOut mod 1000) * 1000;
    TimeV.tv_sec := TimeOut div 1000;
    PTV:=@TimeV;
    end;
  DoSet(FDSR,PFDSR,sosCanRead);
  DoSet(FDSW,PFDSW,sosCanWrite);
  DoSet(FDSE,PFDSE,sosException);
{$endif}
{$ifdef unix}
  Res:=fpSelect(Socket.Handle + 1, PFDSR, PFDSW, PFDSE, PTV);
{$endif}
{$ifdef windows}
  Res:={$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Winsock2.Select(Socket.Handle + 1, PFDSR, PFDSW, PFDSE, @TimeV);
{$endif}
{$if defined(unix) or defined(windows)}
  if Res>0 then
    begin
    CheckSet(FDSR,sosCanRead);
    CheckSet(FDSW,sosCanWrite);
    CheckSet(FDSE,sosException);
    end;
  if Res<0 then
    FLastError:=SocketError
  else
    FLastError:=0;
{$else}
  FLastError:=0;    
{$endif}
end;

function TSocketHandler.CanRead(TimeOut : Integer): Boolean;
begin
  Result:=Select([sosCanRead],Timeout)<>[];
end;

function TSocketHandler.Recv(Const Buffer; Count: Integer): Integer;

Var
  Flags : longint;
begin
  Flags:=Socket.FReadFlags;
{$ifdef unix}
  FLastError:=ESysEINTR;
  While (FlastError=ESysEINTR) do
{$endif}
    begin
    Result:=fprecv(Socket.Handle,@Buffer,count,flags);
    If (Result<0) then
      FLastError:=SocketError
    else
      FLastError:=0;
    end;
end;

function TSocketHandler.Send(Const Buffer; Count: Integer): Integer;

Var
  Flags : longint;

begin
  Flags:=FSocket.FWriteFlags;
{$ifdef unix}
  FLastError:=ESysEINTR;
  While (FlastError=ESysEINTR) do
{$endif}
    begin
    Result:=fpsend(Socket.Handle,@Buffer,count,flags);
    If Result<0 then
      FLastError:=SocketError
    else
      FlastError:=0;
    end;
end;

function TSocketHandler.BytesAvailable: Integer;
begin
  Result:=0;
  { we need ioctlsocket here }
end;

function TSocketHandler.GetLastErrorDescription: String;
begin
  Result:='';
end;


Function TSocketHandler.Close: Boolean;
begin
  Result:=True;
end;


constructor ESocketError.Create(ACode: TSocketErrorType; const MsgArgs: array of const);
var
  s: String;
begin
  Code := ACode;
  case ACode of
    seHostNotFound     : s := strHostNotFound;
    seCreationFailed   : s := strSocketCreationFailed;
    seBindFailed       : s := strSocketBindFailed;
    seListenFailed     : s := strSocketListenFailed;
    seConnectFailed    : s := strSocketConnectFailed;
    seAcceptFailed     : s := strSocketAcceptFailed;
    seAcceptWouldBLock : S := strSocketAcceptWouldBlock;
    seIOTimeout        : S := strSocketIOTimeOut;
    seConnectTimeOut   : s := strSocketConnectTimeout;
  end;
  s := Format(s, MsgArgs);
  inherited Create(s);
end;

{ ---------------------------------------------------------------------
    TSocketStream
  ---------------------------------------------------------------------}
constructor TSocketStream.Create(AHandle: Longint; AHandler: TSocketHandler);

begin
  Inherited Create(AHandle);
  FSocketInitialized := true;
  GetSockOptions;
  FHandler:=AHandler;
  If (FHandler=Nil) then
    FHandler:=TSocketHandler.Create;
  FHandler.SetSocket(Self);
end;

destructor TSocketStream.Destroy;
begin
  Close;
  inherited Destroy;
end;

class function TSocketStream.Select(var aRead, aWrite,
  aExceptions: TSocketStreamArray; aTimeOut: Integer): Boolean;

{$if defined(unix) or defined(windows)}
var
  FDR,FDW,FDE: TFDSet;
  TimeV: TTimeVal;
  MaxHandle : Longint;

  Procedure FillFD(var FD : TFDSet; anArray : TSocketStreamArray);

  Var
    S : TSocketStream;

  begin
    FD := Default(TFDSet);
    {$ifdef unix}
    fpFD_Zero(FD);
    For S in AnArray do
      begin
      fpFD_Set(S.Handle, FD);
      if S.Handle>MaxHandle then
        MaxHandle:=S.Handle;
      end;
    {$ENDIF}
    {$ifdef windows}
    FD_Zero(FD);
    For S in AnArray do
      begin
      FD_Set(S.Handle, FD);
      if S.Handle>MaxHandle then
        MaxHandle:=S.Handle;
      end;
    {$ENDIF}
  end;

  function FillArr(FD : TFDSet; Src : TSocketStreamArray) : TSocketStreamArray;

  Var
    S : TSocketStream;
    aLen : Integer;

  begin
    Result:=nil;
    SetLength(Result,Length(Src));
    aLen:=0;
    For S in Src do
      begin
{$IFDEF UNIX}
      if fpFD_IsSet(S.Handle, FD)>0 then
{$ENDIF}
{$IFDEF Windows}
      if FD_isSet(S.Handle, FD) then
{$ENDIF}
        begin
        Result[aLen]:=S;
        Inc(aLen);
        end;
      end;
    SetLength(Result,aLen);
  end;
  
{$ENDIF} // Unix or windows

begin
  Result:=False;
{$if defined(unix) or defined(windows)}
  MaxHandle:=0;
  TimeV.tv_usec := (aTimeOut mod 1000) * 1000;
  TimeV.tv_sec := aTimeOut div 1000;
  FillFD(FDR,aRead);
  FillFD(FDW,aWrite);
  FillFD(FDE,aExceptions);
  if MaxHandle=0 then
    exit;
{$ifdef unix}
  Result := fpSelect(MaxHandle+1, @FDR, @FDW, @FDE, @TimeV) > 0;
{$endif}
{$ifdef windows}
  Result := {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Winsock2.Select(MaxHandle+1, @FDR, @FDW, @FDE, @TimeV) > 0;
{$endif}
  aRead:=FillArr(FDR,aRead);
  aWrite:=FillArr(FDR,aRead);
  aExceptions:=FillArr(FDR,aRead);
{$ELSE}  // Unix or windows
  aRead:=[];
  aWrite:=[];
  aExceptions:=[];
{$ENDIF}  
end;

procedure TSocketStream.Close;
begin
  DoOnClose;
  if FSocketInitialized then
    FHandler.Close; // Ignore the result
  FSocketInitialized:=False;
  FreeAndNil(FHandler);
  CloseSocket(Handle);
  FClosed:=True;
end;

procedure TSocketStream.GetSockOptions;
{$ifdef windows}
var
  opt: DWord;
  olen: tsocklen;
{$endif windows}
{$ifdef unix}
var
  time: ttimeval;
  olen: tsocklen;
{$endif unix}
begin
  {$ifdef windows}
  olen:=4;
  if fpgetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @opt, @olen) = 0 then
    FIOTimeout:=opt;
  {$endif windows}
  {$ifdef unix}
  olen:=sizeof(time);
  if fpgetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @time, @olen) = 0 then
    FIOTimeout:=(time.tv_sec*1000)+(time.tv_usec div 1000);
  {$endif}
end;

procedure TSocketStream.SetConnectTimeout(AValue: Integer);
begin
  if FConnectTimeout = AValue then Exit;
  FConnectTimeout := AValue;
end;

function TSocketStream.GetLastError: Integer;
begin
  Result:=FHandler.LastError;
end;

procedure TSocketStream.SetSocketOptions(Value: TSocketOptions);

begin
  FSocketOptions:=Value;
end;

function TSocketStream.Seek(Offset: Longint; Origin: Word): Longint;

begin
  Result:=0;
end;

function TSocketStream.Select(aCheck: TSocketStates; TimeOut: Integer): TSocketStates;
begin
  Result:=FHandler.Select(aCheck,TimeOut);
end;

function TSocketStream.CanRead(TimeOut: Integer): Boolean;
begin
  Result:=FHandler.CanRead(TimeOut);
end;

function TSocketStream.Read(var Buffer; Count: Longint): longint;

begin
  Result:=FHandler.Recv(Buffer,Count);
  if (Result=0) then
    FPeerClosed:=True;
end;

function TSocketStream.Write(const Buffer; Count: Longint): Longint;

begin
  Result:=FHandler.Send(Buffer,Count);
end;

function TSocketStream.GetLocalAddress: {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}sockets.TSockAddr;
var
  len: LongInt;
begin
  len := SizeOf({$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}sockets.TSockAddr);
  if fpGetSockName(Handle, @Result, @len) <> 0 then
    FillChar(Result, SizeOf(Result), 0);
end;

function TSocketStream.GetRemoteAddress: {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}sockets.TSockAddr;
var
  len: LongInt;
begin
  len := SizeOf({$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}sockets.TSockAddr);
  if fpGetPeerName(Handle, @Result, @len) <> 0 then
    FillChar(Result, SizeOf(Result), 0);
end;

procedure TSocketStream.SetIOTimeout(AValue: Integer);

Var
  E : Boolean;
{$ifdef windows}
  opt: DWord;
{$endif windows}
{$ifdef unix}
  time: ttimeval;
{$endif unix}

begin
  E:=False;
  if FIOTimeout=AValue then Exit;
  FIOTimeout:=AValue;

  {$ifdef windows}
  opt := AValue;
  E:=fpsetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @opt, 4)<>0;
  if not E then
    E:=fpsetsockopt(Handle, SOL_SOCKET, SO_SNDTIMEO, @opt, 4)<>0;
  {$endif windows}
  {$ifdef unix}
  time.tv_sec:=avalue div 1000;
  time.tv_usec:=(avalue mod 1000) * 1000;
  E:=fpsetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @time, sizeof(time))<>0;
  if not E then
    E:=fpsetsockopt(Handle, SOL_SOCKET, SO_SNDTIMEO, @time, sizeof(time))<>0;
  {$endif}
  if E then
    Raise ESocketError.Create(seIOTimeout,[AValue]);
end;

procedure TSocketStream.DoOnClose;
begin
  If Assigned(FOnClose) then
    FOnClose(Self);
end;

{ ---------------------------------------------------------------------
    TSocketServer
  ---------------------------------------------------------------------}

constructor TSocketServer.Create(ASocket: Longint; AHandler: TSocketHandler);

begin
  FSocket:=ASocket;
  FQueueSize :=5;
  FMaxConnections:=-1;
  if (AHandler=Nil) then
    AHandler:=TSocketHandler.Create;
  FHandler:=AHandler;
  FConnections:=TThreadList.Create;
end;

destructor TSocketServer.Destroy;

begin
  RemoveSelfFromConnections;
  FreeAndNil(FConnections);
  Close;
  FreeAndNil(FHandler);
  Inherited;
end;

procedure TSocketServer.Close;

begin
  If FSocket<>-1 Then
    CloseSocket(FSocket);
  FSocket:=-1;
end;

procedure TSocketServer.Abort;
{$if defined(unix) or defined(mswindows) or defined(hasamiga)}
{$else}
var
  ASocket: longint;
{$endif}
begin
{$if defined(unix)}
  fpShutdown(FSocket,SHUT_RDWR);
{$elseif defined(mswindows) or defined(hasamiga)}
  CloseSocket(FSocket);
{$else}
  {$WARNING Method Abort is not tested on this platform!}
  ASocket:=FSocket;
  fpShutdown(ASocket,SHUT_RDWR);
  CloseSocket(ASocket);
{$endif}
end;

procedure TSocketServer.RemoveSelfFromConnections;

Var
  L : TList;
  P: Pointer;

begin
  L:=FConnections.LockList;
  try
    for P in L do
      TServerSocketStream(P).FServer:=Nil;
  finally
    FConnections.UnlockList;
  end;
end;

function TSocketServer.RunIdleLoop: Boolean;

// Run Accept idle loop. Return True if there is a new connection waiting
{$if defined(unix) or defined(windows)}
var
  FDS: TFDSet;
  TimeV: TTimeVal;
{$endif}
begin
  Repeat
    Result:=False;
{$if defined(unix) or defined(windows)}
    TimeV.tv_usec := (AcceptIdleTimeout mod 1000) * 1000;
    TimeV.tv_sec := AcceptIdleTimeout div 1000;
{$endif}
{$ifdef unix}
    FDS := Default(TFDSet);
    fpFD_Zero(FDS);
    fpFD_Set(FSocket, FDS);
    Result := fpSelect(FSocket + 1, @FDS, @FDS, @FDS, @TimeV) > 0;
{$else}
{$ifdef windows}
    FDS := Default(TFDSet);
    FD_Zero(FDS);
    FD_Set(FSocket, FDS);
    Result := {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Winsock2.Select(FSocket + 1, @FDS, @FDS, @FDS, @TimeV) > 0;
{$endif}
{$endif}
    If Result then
      break;
    DoOnIdle;
  Until (Not FAccepting);
end;

procedure TSocketServer.Listen;

begin
  If Not FBound then
    Bind;
  If  {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.FpListen(FSocket,FQueueSize)<>0 then
    Raise ESocketError.Create(seListenFailed,[FSocket,SocketError]);
end;

function TSocketServer.GetSockopt(ALevel, AOptName: cint; var optval;
  var optlen: tsocklen): Boolean;
begin
  Result:=fpGetSockOpt(FSocket,ALevel,AOptName,@optval,@optlen)<>-1;
end;

function TSocketServer.SetSockopt(ALevel, AOptName: cint; var optval;
  optlen: tsocklen): Boolean;
begin
  Result:=fpSetSockOpt(FSocket,ALevel,AOptName,@optval,optlen)<>-1;
end;

function TInetServer.GetConnection: TSocketStream;

var
  NewSocket : longint;

begin
  Result:=Nil;
  NewSocket:=Accept;
  if (NewSocket<0) then
    if not FAccepting then
      exit
    else
      Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]);
  If FAccepting and DoConnectQuery(NewSocket) Then
    Result:=SockToStream(NewSocket)
  else
    CloseSocket(NewSocket);
end;

function TSocketServer.HandleAcceptError(E: ESocketError): TAcceptErrorAction;
begin
  if FAccepting then
    Result:=aeaRaise
  else
    Result:=aeaStop;
  if Assigned(FOnAcceptError) then
    FOnAcceptError(Self,FSocket,E,Result);
end;

function TSocketServer.GetClientSocketHandler(aSocket : Longint): TSocketHandler;
begin
  If Assigned(FOnCreateClientSocketHandler) then
    FOnCreateClientSocketHandler(Self,Result)
  else
    if Assigned(FHandler) then
      Result:=TSocketHandlerClass(FHandler.ClassType).Create;
end;

procedure TSocketServer.StartAccepting;

Var
 NoConnections : Integer;
 Stream : TSocketStream;

begin
  FAccepting := True;
  NoConnections := 0;
  Listen;
  Repeat
    Repeat
      Stream:=Nil;
      Try
        If (AcceptIdleTimeOut=0) or RunIdleLoop then
          Stream:=GetConnection;
        if Assigned(Stream) then
          if (MaxSimultaneousConnections>0) and (ConnectionCount>=MaxSimultaneousConnections) then
            begin
            Stream.Close;
            DoConnectionDropped(Stream);
            FreeAndNil(Stream);
            end
          else
            begin
            if Stream is TServerSocketStream then
              begin
              FConnections.Add(Stream);
              TServerSocketStream(Stream).FServer:=Self;
              end;
            Inc(NoConnections);
            DoConnect(Stream);
            end;
      except
        On E : ESocketError do
          begin
          If E.Code=seAcceptWouldBlock then
            DoOnIdle
          else
            Case HandleAcceptError(E) of
              aeaIgnore : ;
              aeaStop : FAccepting:=False;
              aeaRaise : Raise;
            end;
          end;
       end;
    Until (Stream<>Nil) or (Not NonBlocking);
  Until Not (FAccepting) or ((FMaxConnections<>-1) and (NoConnections>=FMaxConnections));
end;

procedure TSocketServer.StopAccepting(DoAbort: Boolean = False);

begin
  FAccepting:=False;
  If DoAbort then
    Abort;
end;

procedure TSocketServer.DoOnIdle;

begin
  If Assigned(FOnIdle) then
    FOnIdle(Self);
end;

function TSocketServer.GetConnectionCount: Integer;

Var
  L : TList;

begin
  L:=FConnections.LockList;
  try
    Result:=L.Count;
  finally
    FConnections.UnlockList;
  end;
end;

function TSocketServer.GetReuseAddress: Boolean;
Var
  L : cint;
  ls : Tsocklen;
begin
  L:=0;
  ls:=0;
{$IFDEF UNIX}
  if not GetSockOpt(SOL_SOCKET, SO_REUSEADDR, L, LS) then
    Raise ESocketError.CreateFmt('Failed to get SO_REUSEADDR to %d: %d',[l,socketerror]);
  Result:=(L<>0);
{$ELSE}
  Result:=True;
{$ENDIF}

end;

function TSocketServer.GetKeepAlive: Boolean;
Var
  L : cint;
  ls : Tsocklen;
begin
  L:=0;
  ls:=0;
{$IFDEF UNIX}
  if Not GetSockOpt(SOL_SOCKET, SO_KEEPALIVE, L, LS) then
    Raise ESocketError.CreateFmt('Failed to get SO_KEEPALIVE: %d',[socketerror]);
  Result:=(L<>0);
{$ELSE}
  Result:=True;
{$ENDIF}
end;

function TSocketServer.GetLinger: Integer;
Var
  L : linger;
  ls : tsocklen;

begin
  L.l_onoff:=0;
  l.l_linger:=0;
  if Not GetSockOpt(SOL_SOCKET, SO_LINGER, l, ls) then
    Raise ESocketError.CreateFmt('Failed to set linger: %d',[socketerror]);
  if l.l_onoff=0 then
    Result:=-1
  else
    Result:=l.l_linger;
end;

procedure TSocketServer.DoConnect(ASocket: TSocketStream);

begin
  If Assigned(FOnConnect) Then
    FOnConnect(Self,ASocket);
end;

function TSocketServer.DoConnectQuery(ASocket: longint): Boolean;

begin
  Result:=True;
  If Assigned(FOnConnectQuery) then
    FOnConnectQuery(Self,ASocket,Result);
end;

procedure TSocketServer.SetNonBlocking;

begin
{$ifdef Unix}
  fpfcntl(FSocket,F_SETFL,O_NONBLOCK);
{$endif}
  FNonBlocking:=True;
end;

procedure TSocketServer.Foreach(aHandler: TForeachHandler);

Var
  L : TList;
  P : Pointer;
  aContinue : Boolean;

begin
  L:=FConnections.LockList;
  try
    aContinue:=True;
    For P in L do
      begin
      aHandler(Self,TSocketStream(P),aContinue);
      if not aContinue then
        break;
      end;
  finally
    FConnections.UnlockList;
  end;
end;

procedure TSocketServer.SetLinger(ALinger: Integer);
Var
  L : linger;
begin
  L.l_onoff:=Ord(ALinger>0);
  if ALinger<0 then
    l.l_linger:=ALinger
  else
    l.l_linger:=0;
  if Not SetSockOpt(SOL_SOCKET, SO_LINGER, l, SizeOf(L)) then
    Raise ESocketError.CreateFmt('Failed to set linger: %d',[socketerror]);
end;

procedure TSocketServer.SocketClosed(aSocket: TSocketStream);
begin
  FConnections.Remove(aSocket);
  DoDisConnect(aSocket);
end;

procedure TSocketServer.DoConnectionDropped(aSocket: TSocketStream);
begin
  If Assigned(FOnConnectionDropped) then
    FOnConnectionDropped(Self,aSocket);
end;

procedure TSocketServer.DoDisconnect(aSocket: TSocketStream);
begin
  If Assigned(FOnDisconnect) then
    FOnDisconnect(Self,aSocket);
end;

procedure TSocketServer.SetReuseAddress(AValue: Boolean);
Var
  L : cint;
begin
  L:=Ord(AValue);
{$IFDEF UNIX}
  if not SetSockOpt(SOL_SOCKET, SO_REUSEADDR , L, SizeOf(L)) then
    Raise ESocketError.CreateFmt('Failed to set SO_REUSEADDR to %d: %d',[l,socketerror]);
{$ENDIF}
end;

procedure TSocketServer.SetKeepAlive(AValue: Boolean);
Var
  L : cint;
begin
  L:=Ord(AValue);
{$IFDEF UNIX}
  if Not SetSockOpt(SOL_SOCKET, SO_KEEPALIVE, L, SizeOf(L)) then
    Raise ESocketError.CreateFmt('Failed to set SO_REUSEADDR to %d: %d',[l,socketerror]);
{$ENDIF}
end;

{ ---------------------------------------------------------------------
    TInetServer
  ---------------------------------------------------------------------}

constructor TInetServer.Create(APort: Word);

begin
  Create('0.0.0.0', aPort);
end;

constructor TInetServer.Create(const aHost: string; const APort: Word;
  AHandler: TSocketHandler);

Var S : longint;

begin
  FHost:=aHost;
  FPort:=APort;
  S:={$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.FpSocket(AF_INET,SOCK_STREAM,0);
  If S=-1 Then
    Raise ESocketError.Create(seCreationFailed,[Format('%d',[APort])]);
  Inherited Create(S,AHandler);
end;

procedure TInetServer.Bind;

begin
  Faddr.sin_family := AF_INET;
  Faddr.sin_port := ShortHostToNet(FPort);
  Faddr.sin_addr.s_addr := LongWord(StrToNetAddr(FHost));
  if {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.fpBind(FSocket, @FAddr, Sizeof(FAddr))<>0 then
    raise ESocketError.Create(seBindFailed, [IntToStr(FPort)]);
  FBound:=True;
end;

function TInetServer.SockToStream(ASocket: Longint): TSocketStream;
Var
  H : TSocketHandler;
  ok : Boolean;
  aClass : TServerSocketStreamClass;

  procedure ShutDownH;
  begin
    H.Shutdown(False);
    FreeAndNil(Result);
  end;

begin
  H:=GetClientSocketHandler(aSocket);
  aClass:=DefaultServerSocketClass;

  if aClass=Nil then
    aClass:=TServerSocketStream;
  Result:=aClass.Create(ASocket,H);

  ok:=false;
  try
    ok:=H.Accept;
  finally
    if not ok then
      ShutDownH;
  end;
end;

function TInetServer.Accept: Longint;

Var
  L : longint;
  R : integer;
begin
  L:=SizeOf(FAddr);
{$IFDEF UNIX}
  R:=ESysEINTR;
  While (R=ESysEINTR) do
{$ENDIF UNIX}
   begin
   Result:={$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.fpAccept(Socket,@Faddr,@L);
   R:=SocketError;
   end;
{$ifdef Unix}
  If (Result<0) then
    If R=ESysEWOULDBLOCK then
      Raise ESocketError.Create(seAcceptWouldBlock,[socket]);
{$endif}
  if (Result<0) or Not FAccepting then
    begin
    If (Result>=0) then
      CloseSocket(Result);
    // Do not raise an error if we've stopped accepting.
    if FAccepting then
      Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError])
    end;
end;

{ ---------------------------------------------------------------------
    TUnixServer
  ---------------------------------------------------------------------}
{$ifdef Unix}
Constructor TUnixServer.Create(const AFileName : String; AHandler : TSocketHandler = Nil);

Var S : Longint;

begin
  FFileName:=AFileName;
  S:={$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.fpSocket(AF_UNIX,SOCK_STREAM,0);
  If S=-1 then
    Raise ESocketError.Create(seCreationFailed,[AFileName])
  else
    Inherited Create(S,AHandler);
end;

Procedure TUnixServer.Close;
begin
  Inherited Close;
  DeleteFile(FFileName);
  FFileName:='';
end;

Procedure TUnixServer.Bind;

var
  AddrLen  : longint;
begin
  Str2UnixSockAddr(FFilename,FUnixAddr,AddrLen);
  If  {$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.FpBind(Socket,@FUnixAddr,AddrLen)<>0 then
    Raise ESocketError.Create(seBindFailed,[FFileName]);
  FBound:=True;
end;

Function TUnixServer.Accept : Longint;

Var L : longint;

begin
  L:=Length(FFileName);
  Result:={$IFDEF FPC_DOTTEDUNITS}System.Net.{$ENDIF}Sockets.fpAccept(Socket,@FUnixAddr,@L);
  If Result<0 then
    If SocketError=ESysEWOULDBLOCK then
      Raise ESocketError.Create(seAcceptWouldBlock,[socket])
    else
      Raise ESocketError.Create(seAcceptFailed,[socket,SocketError]);
end;

Function  TUnixServer.SockToStream (ASocket : Longint) : TSocketStream;

var
  aClass : TUnixSocketClass;

begin
  aClass:=DefaultUnixSocketClass;
  if aClass=Nil then
    aClass:=TUnixSocket;
  Result:=aClass.Create(ASocket);
  (Result as TUnixSocket).FFileName:=FFileName;
end;

Function TUnixServer.GetConnection : TSocketStream;

var
  NewSocket : longint;

begin
  Result:=Nil;
  NewSocket:=Accept;
  if (NewSocket<0) then
    Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]);
  If FAccepting and DoConnectQuery(NewSocket) Then
    Result:=SockToStream(NewSocket)
  else
    CloseSocket(NewSocket);
end;

{$endif}

{ ---------------------------------------------------------------------
    TInetSocket
  ---------------------------------------------------------------------}

Constructor TInetSocket.Create(const AHost: String; APort: Word;AHandler : TSocketHandler = Nil);
begin
  Create(AHost,aPort,0,AHandler);
end;

Constructor TInetSocket.Create(const AHost: String; APort: Word; aConnectTimeout : Integer; AHandler : TSocketHandler = Nil);
Var
  S : Longint;

begin
  FHost:=AHost;
  FPort:=APort;
  ConnectTimeout:=aConnectTimeout;
  S:=fpSocket(AF_INET,SOCK_STREAM,0);
  Inherited Create(S,AHandler);
  if (AHandler=Nil) then // Backwards compatible behaviour.
    Connect;
end;

{$IFDEF HAVENONBLOCKING}
function TNonBlockingSocketStream.SetSocketBlockingMode(ASocket: cint; ABlockMode: TBlockingMode; AFDSPtr: Pointer): Boolean;

Const
    BlockingModes : Array[TBlockingMode] of DWord =
                  (SocketBlockingMode, SocketNonBlockingMode);


var
  locFDS: PFDSet;
{$ifdef unix}
  flags: Integer;
{$endif}
begin
  locFDS := PFDSet(AFDSPtr);
  if (AblockMode = bmNonBlocking) then
    begin
{$ifdef unix}
    locFDS^ := Default(TFDSet);
    fpFD_Zero(locFDS^);
    fpFD_Set(ASocket, locFDS^);
{$else}
{$ifdef windows}
    locFDS^ := Default(TFDSet);
    FD_Zero(locFDS^);
    FD_Set(ASocket, locFDS^);
{$endif}
{$endif}
    end;
{$ifdef unix}
  flags := FpFcntl(ASocket, F_GetFl, 0);
  if (AblockMode = bmNonBlocking) then
    result := FpFcntl(ASocket, F_SetFl, flags or O_NONBLOCK) = 0
  else
    result := FpFcntl(ASocket, F_SetFl, flags and (not O_NONBLOCK)) = 0;
{$endif}
{$ifdef windows}
  result := ioctlsocket(ASocket,longint(FIONBIO),@ABlockMode) = 0;
{$endif}
end;

// Return true if a timeout happened. Will only be called in case of eWouldBlock.
function TNonBlockingSocketStream.CheckSocketConnectTimeout(ASocket: cint; AFDSPtr: Pointer; ATimeVPtr: Pointer): TCheckTimeoutResult;

var
  Err,ErrLen : Longint;
  Res : LongInt;
  locTimeVal: PTimeVal;
  locFDS: PFDSet;

begin
  locTimeVal := PTimeVal(ATimeVPtr);
  locFDS := PFDSet(AFDSPtr);
  locTimeVal^.tv_usec := (FConnectTimeout mod 1000) * 1000;
  locTimeVal^.tv_sec := FConnectTimeout div 1000;
  Res:=-1;
  {$ifdef unix}
    Res:=fpSelect(ASocket + 1, nil, locFDS, nil, locTimeVal); // 0 -> TimeOut
  {$ENDIF}
  {$ifdef windows}
    Res:={$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Winsock2.select(ASocket + 1, nil, locFDS, nil, locTimeVal); // 0 -> TimeOut
  {$ENDIF}
  if (Res=0) then
    Result:=ctrTimeout
  else if (Res<0) then
    Result:=ctrError
  else if (Res>0) then
    begin
    Result:=ctrError;
    ErrLen := SizeOf(Err);
    {$ifdef unix}
    if fpFD_ISSET(ASocket, locFDS^)=1 then
    {$ENDIF}
    {$ifdef windows}
    if FD_ISSET(ASocket, locFDS^) then
    {$ENDIF}
      begin
      fpGetSockOpt(ASocket, SOL_SOCKET, SO_ERROR, @Err, @ErrLen);
      if Err=0 then // 0 -> connected
        Result:=ctrOK
      end;
    end;
end;
{$ENDIF HAVENONBLOCKING}

procedure TInetSocket.Connect;

{$IFDEF HAVENONBLOCKING}
Const
 {$IFDEF UNIX}
    ErrWouldBlock = ESysEInprogress;
 {$ELSE}
    ErrWouldBlock = WSAEWOULDBLOCK;
 {$ENDIF}
{$ENDIF}

Var
  A : THostAddr;
  addr: TInetSockAddr;
  IsError : Boolean;
  TimeOutResult : TCheckTimeOutResult;
  Err: Integer;
  aErrMsg : String;
{$IFDEF HAVENONBLOCKING}
  FDS: TFDSet;
  TimeV: TTimeVal;
{$endif}
begin
  A := StrToHostAddr(FHost);
  if A.s_bytes[1] = 0 then
    With THostResolver.Create(Nil) do
      try
        If Not NameLookup(FHost) then
          raise ESocketError.Create(seHostNotFound, [FHost]);
        A:=HostAddress;
      finally
        free;
      end;
  addr.sin_family := AF_INET;
  addr.sin_port := ShortHostToNet(FPort);
  addr.sin_addr.s_addr := HostToNet(a.s_addr);
{$IFDEF HAVENONBLOCKING}
  if ConnectTimeOut>0 then
    SetSocketBlockingMode(Handle, bmNonBlocking, @FDS) ;
{$ENDIF}
  IsError:=True;
  TimeOutResult:=ctrError;
  {$ifdef unix}
  Err:=ESysEINTR;
  While IsError and ((Err=ESysEINTR) or (Err=ESysEAGAIN)) do
  {$endif}
    begin
    IsError:=fpConnect(Handle, @addr, sizeof(addr))<>0;
    if IsError then
      Err:=Socketerror;
    end;
{$IFDEF HAVENONBLOCKING}
  if (ConnectTimeOut>0) then
    begin
    if IsError and (Err=ErrWouldBlock) then
      begin
      TimeOutResult:=CheckSocketConnectTimeout(Handle, @FDS, @TimeV);
      IsError:=(TimeOutResult<>ctrOK);
      end;
    SetSocketBlockingMode(Handle, bmBlocking, @FDS);
    end;
{$ENDIF}
  If (Not IsError) and Assigned(Handler) then
    begin
    IsError:=Not FHandler.Connect;
    if IsError then
      CloseSocket(Handle);
    end;
  If IsError then
    if TimeoutResult=ctrTimeout then
      Raise ESocketError.Create(seConnectTimeOut, [Format('%s:%d',[FHost, FPort])])
    else
      begin
      if Assigned(FHandler) then
        aErrMsg:=FHandler.GetLastErrorDescription
      else
        aErrMsg:='Error connecting';
      Raise ESocketError.Create(seConnectFailed, [Format('%s:%d',[FHost, FPort]),aErrMsg]);
      end;
end;

{ ---------------------------------------------------------------------
    TUnixSocket
  ---------------------------------------------------------------------}
{$ifdef Unix}
Constructor TUnixSocket.Create(ASocket : Longint);

begin
  Inherited Create(ASocket);
end;

Constructor TUnixSocket.Create(const AFileName : String);

Var S : Longint;

begin
  FFileName:=AFileName;
  S:=FpSocket(AF_UNIX,SOCK_STREAM,0);
  DoConnect(S);
  Inherited Create(S);
end;

Procedure TUnixSocket.DoConnect(ASocket : longint);

Var
  UnixAddr : TUnixSockAddr;
  AddrLen  : longint;
begin
  Str2UnixSockAddr(FFilename,UnixAddr,AddrLen);
  If  FpConnect(ASocket,@UnixAddr,AddrLen)<>0 then
    Raise ESocketError.Create(seConnectFailed,[FFilename,'']);
end;
{$endif}
end.