{==============================================================================|
| Project : Delphree - Synapse                        | xxx.xxx.xxx (modified) |
|==============================================================================|
| Content: Library base                                                        |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
| (the "License"); you may not use this file except in compliance with the     |
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|                                                                              |
| Software distributed under the License is distributed on an "AS IS" basis,   |
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
| the specific language governing rights and limitations under the License.    |
|==============================================================================|
| The Original Code is Synapse Delphi Library.                                 |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)1999,2000,2001.           |
| All Rights Reserved.                                                         |
|==============================================================================|
| Original Synapse is available from http://www.ararat.cz/synapse/             |
|                                                                              |
| This version is heavily modified by CyberAlien@users.sourceforge.net         |
|                                                                              |
| The latest version of modified blcksock.pas is included in SlavaNap project  |
| source code and available from http://www.slavanap.org                       |
|==============================================================================}

unit BlckSock;

interface

uses
  SynSock, SysUtils, Classes2,
{$IFDEF LINUX}
  libc, kernelioctl;
{$ELSE}
  WinSock, Windows;
{$ENDIF}

const
  cLocalhost = 'localhost';

type

  HSocket = TSocket;
  {TBlockSocket}
  TBlockSocket = class(TObject)
  protected
    FSocket: TSocket;
    FLocalSin: TSockAddrIn;
    FRemoteSin: TSockAddrIn;
    FLastError: Integer;
    FProtocol: Integer;
    // FBuffer: string;

    function GetSinIP(Sin: TSockAddrIn): string;
    function GetSinPort(Sin: TSockAddrIn): Integer;
    procedure SetSocket(Value: TSocket);
  public
    Tag: Integer;

    constructor Create;
    destructor Destroy; override;

    procedure CreateSocket; virtual;
    procedure CloseSocket;
    procedure Bind(IP, Port: string);
    procedure Connect(IP, Port: string);
    function SendBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
    procedure SendByte(Data: Byte); virtual;
    procedure SendString(Data: string); virtual;
    function RecvBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
    function RecvByte(TimeOut: Integer): Byte; virtual;
    // function RecvString(TimeOut: Integer): string; virtual;
    // function RecvPacket(TimeOut: Integer): string; virtual;
    // function RecvBufferEx(Buffer: Pointer; Length: Integer; TimeOut: Integer):
    //   Integer; virtual;
    function PeekBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
    function PeekByte(TimeOut: Integer): Byte; virtual;
    function WaitingData: Integer;
    procedure SetLinger(Enable: Boolean; Linger: Integer);
    procedure GetSins;
    function SockCheck(SockResult: Integer): Integer;
    function LocalName: string;
    procedure ResolveNameToIP(Name: string; IPlist: TMyStringList);
    function GetLocalSinIP: string;
    function GetRemoteSinIP: string;
    function GetLocalSinPort: Integer;
    function GetRemoteSinPort: Integer;
    function CanRead(TimeOut: Integer): Boolean;
    function CanWrite(TimeOut: Integer): Boolean;
    function SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
    function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer;

    function GetSizeRecvBuffer: Integer;
    procedure SetSizeRecvBuffer(Size: Integer);
    function GetSizeSendBuffer: Integer;
    procedure SetSizeSendBuffer(Size: Integer);
    function SetTimeout(Receive, Send: Integer): Boolean;
    // requires Winsock2 (Win98 has to be updated)
    procedure Block(DoBlock: Boolean);
    procedure ResetError;
    procedure KeepAlive(B: Boolean);

    property LocalSin: TSockAddrIn read FLocalSin;
    property RemoteSin: TSockAddrIn read FRemoteSin;
  published
    property Socket: TSocket read FSocket write SetSocket;
    property LastError: Integer read FLastError write FLastError;
    property Protocol: Integer read FProtocol;
    property SizeRecvBuffer: Integer read GetSizeRecvBuffer write
      SetSizeRecvBuffer;
    property SizeSendBuffer: Integer read GetSizeSendBuffer write
      SetSizeSendBuffer;
  end;

  {TUDPBlockSocket}
  TUDPBlockSocket = class(TBlockSocket)
  public
    procedure CreateSocket; override;
    function EnableBroadcast(Value: Boolean): Boolean;
  end;

  {TTCPBlockSocket}
  TTCPBlockSocket = class(TBlockSocket)
  public
    constructor Create;
    destructor Destroy; override;
    procedure CreateSocket; override;
    procedure Listen;
    function Accept: TSocket;
  end;

function GetErrorDesc(ErrorCode: Integer): string;
procedure ResolveNameToIP(Name: string; IPlist: TMyStringList);
procedure SetSin(var Sin: TSockAddrIn; IP, Port: string; Protocol: Integer);
function TCPSocket_Connect(Socket: HSocket; IP, Port: string; var Last_Error:
  Integer): Integer;
procedure TCPSocket_Block(Socket: HSocket; DoBlock: Boolean);
function TCPSocket_GetSocketError(Socket: HSocket): Integer;
function TCPSocket_SendString(Socket: HSocket; Data: string; var Last_Error:
  Integer): Integer;
function TCPSocket_SendBuffer(Socket: HSocket; Buffer: Pointer; Length: Integer;
  var Last_Error: Integer): Integer;
function TCPSocket_RecvBuffer(Socket: HSocket; Buffer: Pointer; Length: Integer;
  var Last_Error: Integer): Integer;
function TCPSocket_CanRead(Socket: HSocket; TimeOut: Integer; var Last_Error:
  Integer): Boolean;
function TCPSocket_CanWrite(Socket: HSocket; TimeOut: Integer; var Last_Error:
  Integer): Boolean;
procedure TCPSocket_SetLinger(Socket: HSocket; Enable: Boolean; Linger:
  Integer);
procedure TCPSocket_Bind(Socket: HSocket; IP, Port: string);
procedure TCPSocket_SetSizeRecvBuffer(Socket: HSocket; Size: Integer);
procedure TCPSocket_SetSizeSendBuffer(Socket: HSocket; Size: Integer);
procedure TCPSocket_KeepAlive(Socket: HSocket; B: Boolean);
function TCPSocket_GetRemoteSin(Socket: HSocket): TSockAddrIn;
function TCPSocket_GetLocalSin(Socket: HSocket): TSockAddrIn;
function TCPSocket_SockCheck(SockResult: Integer): Integer;

var
  FWsaData: TWSADATA;
  Sockets_Count: Integer;
  // for debug:
  Count_BlockSock,
    Count_BlockSock_Max: Integer;

implementation

{TBlockSocket.Create}

constructor TBlockSocket.Create;
begin
  inherited Create;
  // SetLength(FBuffer, 0);
  Tag := 0;
  FSocket := INVALID_SOCKET;
  FProtocol := IPPROTO_IP;
  Inc(Count_BlockSock);
  if Count_BlockSock > Count_BlockSock_Max then
    Count_BlockSock_Max := Count_BlockSock;
end;

{TBlockSocket.Destroy}

destructor TBlockSocket.Destroy;
begin
  CloseSocket;
  Dec(Count_BlockSock);
  inherited Destroy;
end;

{TBlockSocket.SetSin}

procedure SetSin(var Sin: TSockAddrIn; IP, Port: string; Protocol: Integer);
var
  ProtoEnt: PProtoEnt;
  ServEnt: PServEnt;
  HostEnt: PHostEnt;
begin
  FillChar(Sin, SizeOf(Sin), 0);
  Sin.sin_family := AF_INET;
  ProtoEnt := SynSock.getprotobynumber(Protocol);
  ServEnt := nil;
  if ProtoEnt <> nil then
    ServEnt := SynSock.getservbyname(PChar(Port), ProtoEnt^.p_name);
  if ServEnt = nil then
    Sin.sin_port := SynSock.htons(StrToIntDef(Port, 0))
  else
    Sin.sin_port := ServEnt^.s_port;
  if IP = '255.255.255.255' then
    Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
  else
  begin
    Sin.sin_addr.s_addr := SynSock.inet_addr(PChar(IP));
    if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
    begin
      HostEnt := SynSock.gethostbyname(PChar(IP));
      if HostEnt <> nil then
        Sin.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
    end;
  end;
end;

{TBlockSocket.GetSinIP}

function TBlockSocket.GetSinIP(Sin: TSockAddrIn): string;
var
  P: PChar;
begin
  P := SynSock.inet_ntoa(Sin.sin_addr);
  if P = nil then
    Result := ''
  else
    Result := P;
end;

{TBlockSocket.GetSinPort}

function TBlockSocket.GetSinPort(Sin: TSockAddrIn): Integer;
begin
  Result := SynSock.ntohs(Sin.sin_port);
end;

procedure TBlockSocket.SetSocket(Value: TSocket);
begin
  if FSocket = INVALID_SOCKET then
  begin
    FSocket := Value;
    if Value <> INVALID_SOCKET then
      Inc(Sockets_Count);
  end
  else
  begin
    FSocket := Value;
    if Value = INVALID_SOCKET then
      Dec(Sockets_Count);
  end;
end;

{TBlockSocket.CreateSocket}

procedure TBlockSocket.CreateSocket;
begin
  if FSocket = INVALID_SOCKET then
    FLastError := SynSock.WSAGetLastError
  else
    FLastError := 0;
end;

{TBlockSocket.CloseSocket}

procedure TBlockSocket.CloseSocket;
begin
  if FSocket <> INVALID_SOCKET then
  begin
    SynSock.Shutdown(FSocket, SD_BOTH);
    SynSock.CloseSocket(FSocket);
    Dec(Sockets_Count);
  end;
  FSocket := INVALID_SOCKET;
end;

{TBlockSocket.Bind}

procedure TBlockSocket.Bind(IP, Port: string);
var
  Sin: TSockAddrIn;
  Len: Integer;
begin
  SetSin(Sin, IP, Port, FProtocol);
  SockCheck(SynSock.bind(FSocket, Sin, SizeOf(Sin)));
  Len := SizeOf(FLocalSin);
  SynSock.GetSockName(FSocket, FLocalSin, Len);
end;

{TBlockSocket.Connect}

procedure TBlockSocket.Connect(IP, Port: string);
var
  Sin: TSockAddrIn;
begin
  SetSin(Sin, IP, Port, FProtocol);
  SockCheck(SynSock.connect(FSocket, Sin, SizeOf(Sin)));
  GetSins;
end;

{TBlockSocket.GetSins}

procedure TBlockSocket.GetSins;
var
  Len: Integer;
begin
  Len := SizeOf(FLocalSin);
  SynSock.GetSockName(FSocket, FLocalSin, Len);
  Len := SizeOf(FRemoteSin);
  SynSock.GetPeerName(FSocket, FremoteSin, Len);
end;

{TBlockSocket.SendBuffer}

function TBlockSocket.SendBuffer(Buffer: Pointer; Length: Integer): Integer;
begin
  Result := SynSock.Send(FSocket, Buffer^, Length, 0);
  SockCheck(Result);
end;

{TBlockSocket.SendByte}

procedure TBlockSocket.SendByte(Data: Byte);
begin
  SockCheck(SynSock.Send(FSocket, Data, 1, 0));
end;

{TBlockSocket.SendString}

procedure TBlockSocket.SendString(Data: string);
begin
  SendBuffer(PChar(Data), Length(Data));
end;

{TBlockSocket.RecvBuffer}

function TBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer;
begin
  Result := SynSock.Recv(FSocket, Buffer^, Length, 0);
  if Result = 0 then
    FLastError := WSAENOTCONN
  else
    SockCheck(Result);
end;

{TBlockSocket.RecvByte}

function TBlockSocket.RecvByte(TimeOut: Integer): Byte;
var
  Y: Integer;
  Data: Byte;
begin
  Data := 0;
  Result := 0;
  if CanRead(TimeOut) then
  begin
    Y := SynSock.recv(FSocket, Data, 1, 0);
    if Y = 0 then
      FLastError := WSAENOTCONN
    else
      SockCheck(Y);
    Result := Data;
  end
  else
    FLastError := WSAETIMEDOUT;
end;

{function TBlockSocket.RecvString(TimeOut: Integer): string;
const
  MaxBuf = 1024;
var
  X: Integer;
  S: string;
  C: Char;
  R: Integer;
begin
  S := '';
  FLastError := 0;
  C := #0;
  repeat
    if FBuffer = '' then
    begin
      X := WaitingData;
      if X = 0 then
        X := 1;
      if X > MaxBuf then
        X := MaxBuf;
      if X = 1 then
      begin
        C := Char(RecvByte(TimeOut));
        if FLastError <> 0 then
          Break;
        FBuffer := C;
      end
      else
      begin
        SetLength(FBuffer, X);
        R := SynSock.Recv(FSocket, Pointer(FBuffer)^, X, 0);
        SockCheck(R);
        if R = 0 then
          FLastError := WSAECONNRESET;
        if FLastError <> 0 then
          Break;
        if R < X then
          SetLength(FBuffer, R);
      end;
    end;
    X := Pos(#10, FBuffer);
    if X < 1 then
      X := Length(FBuffer);
    S := S + Copy(FBuffer, 1, X - 1);
    C := FBuffer[X];
    Delete(FBuffer, 1, X);
    S := S + C;
  until C = #10;

  if FLastError = 0 then
  begin
    }
    //{$IFDEF LINUX}
    // S := AdjustLineBreaks(S, tlbsCRLF);
    //{$ELSE}
    // S := AdjustLineBreaks(S);
    //{$ENDIF}
    {X := Pos(#13 + #10, S);
    if X > 0 then
      S := Copy(S, 1, X - 1);
    Result := S;
  end
  else
    Result := '';
end;}

{function TBlockSocket.RecvPacket(TimeOut: Integer): string;
var
  X: Integer;
  S: string;
begin
  Result := '';
  FLastError := 0;
  X := -1;
  if FBuffer <> '' then
  begin
    Result := FBuffer;
    FBuffer := '';
  end
  else if CanRead(TimeOut) then
  begin
    X := WaitingData;
    if X > 0 then
    begin
      SetLength(S, X);
      X := RecvBuffer(Pointer(S), X);
      Result := Copy(S, 1, X);
    end;
  end
  else
    FLastError := WSAETIMEDOUT;
  if X = 0 then
    FLastError := WSAECONNRESET;
end;
}

{function TBlockSocket.RecvBufferEx(Buffer: Pointer; Length: Integer;
  TimeOut: Integer): Integer;
var
  S, SS, ST: string;
  X, L, LSS: Integer;
  FB, FS: Integer;
  Max: Integer;
begin
  FLastError := 0;
  X := System.Length(FBuffer);
  if Length <= X then
  begin
    FB := Length;
    FS := 0;
  end
  else
  begin
    FB := X;
    FS := Length - X;
  end;
  SS := '';
  if FB > 0 then
  begin
    S := Copy(FBuffer, 1, FB);
    Delete(FBuffer, 1, FB);
  end;
  if FS > 0 then
  begin
    Max := GetSizeRecvBuffer;
    SS := '';
    while System.Length(SS) < FS do
    begin
      if CanRead(TimeOut) then
      begin
        L := WaitingData;
        if L > Max then
          L := Max;
        if (System.Length(SS) + L) > FS then
          L := FS - System.Length(SS);
        SetLength(ST, L);
        X := SynSock.Recv(FSocket, Pointer(ST)^, L, 0);
        if X = 0 then
          FLastError := WSAECONNRESET
        else
          SockCheck(X);
        if FLastError <> 0 then
          Break;
        LSS := System.Length(SS);
        SetLength(SS, LSS + X);
        Move(Pointer(ST)^, Pointer(@SS[LSS + 1])^, X);
        // It is 3x faster then SS := SS + Copy(ST, 1, X);
        Sleep(0);
      end
      else
        FLastError := WSAETIMEDOUT;
      if FLastError <> 0 then
        Break;
    end;
    FS := System.Length(SS);
  end;
  Result := FB + FS;
  S := S + SS;
  Move(Pointer(S)^, Buffer^, Result);
end;
}

{TBlockSocket.PeekBuffer}

function TBlockSocket.PeekBuffer(Buffer: Pointer; Length: Integer): Integer;
begin
  Result := SynSock.recv(FSocket, Buffer^, Length, MSG_PEEK);
  SockCheck(Result);
end;

{TBlockSocket.PeekByte}

function TBlockSocket.PeekByte(TimeOut: Integer): Byte;
var
  Y: Integer;
  Data: Byte;
begin
  Data := 0;
  Result := 0;
  if CanRead(TimeOut) then
  begin
    Y := SynSock.recv(FSocket, Data, 1, MSG_PEEK);
    if Y = 0 then
      FLastError := WSAENOTCONN;
    SockCheck(Y);
    Result := Data;
  end
  else
    FLastError := WSAETIMEDOUT;
end;

{TBlockSocket.SockCheck}

function TBlockSocket.SockCheck(SockResult: Integer): Integer;
begin
  if SockResult = SOCKET_ERROR then
    Result := SynSock.WSAGetLastError
  else
    Result := 0;
  FLastError := Result;
end;

{TBlockSocket.WaitingData}

function TBlockSocket.WaitingData: Integer;
var
  X: Integer;
begin
  SynSock.ioctlsocket(FSocket, FIONREAD, u_long(X));
  Result := X;
end;

{TBlockSocket.SetLinger}

procedure TBlockSocket.SetLinger(Enable: Boolean; Linger: Integer);
var
  Li: TLinger;
begin
  Li.l_onoff := Ord(Enable);
  Li.l_linger := Linger div 1000;
  SockCheck(SynSock.SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, @Li,
    SizeOf(Li)));
end;

{TBlockSocket.LocalName}

function TBlockSocket.LocalName: string;
var
  Buf: array[0..255] of Char;
  PBuf: PChar;
  RemoteHost: PHostEnt;
begin
  PBuf := Buf;
  Result := '';
  SynSock.gethostname(PBuf, 255);
  if PBuf <> '' then
  begin
    //try get Fully Qualified Domain Name
    RemoteHost := SynSock.GetHostByName(PBuf);
    if RemoteHost <> nil then
      Result := PChar(RemoteHost^.h_name);
  end;
  if Result = '' then
    Result := '127.0.0.1';
end;

{TBlockSocket.ResolveNameToIP}

procedure TBlockSocket.ResolveNameToIP(Name: string; IPlist: TMyStringList);
type
  TaPInAddr = array[0..250] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  RemoteHost: PHostEnt;
  IP: u_long;
  PAdrPtr: PaPInAddr;
  I: Integer;
  S: string;
  InAddr: TInAddr;
begin
  IPList.Clear;
  IP := SynSock.inet_addr(PChar(Name));
  if IP = u_long(INADDR_NONE) then
  begin
    RemoteHost := SynSock.gethostbyname(PChar(Name));
    if RemoteHost <> nil then
    begin
      PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
      I := 0;
      while PAdrPtr^[I] <> nil do
      begin
        InAddr := PAdrPtr^[I]^;
        with InAddr.S_un_b do
          S := IntToStr(Ord(s_b1)) + '.' + IntToStr(Ord(s_b2)) + '.'
            + IntToStr(Ord(s_b3)) + '.' + IntToStr(Ord(s_b4));
        IPList.Add(S);
        Inc(I);
      end;
    end;
  end
  else
    IPList.Add(Name);
end;

{TBlockSocket.GetLocalSinIP}

function TBlockSocket.GetLocalSinIP: string;
begin
  Result := GetSinIP(FLocalSin);
end;

{TBlockSocket.GetRemoteSinIP}

function TBlockSocket.GetRemoteSinIP: string;
begin
  Result := GetSinIP(FRemoteSin);
end;

{TBlockSocket.GetLocalSinPort}

function TBlockSocket.GetLocalSinPort: Integer;
begin
  Result := GetSinPort(FLocalSin);
end;

{TBlockSocket.GetRemoteSinPort}

function TBlockSocket.GetRemoteSinPort: Integer;
begin
  Result := GetSinPort(FRemoteSin);
end;

{TBlockSocket.CanRead}

function TBlockSocket.CanRead(TimeOut: Integer): Boolean;
var
  FDSet: TFDSet;
  TimeVal: PTimeVal;
  TimeV: tTimeval;
  X: Integer;
begin
  TimeV.tv_usec := (TimeOut mod 1000) * 1000;
  TimeV.tv_sec := TimeOut div 1000;
  TimeVal := @TimeV;
  if TimeOut = -1 then
    TimeVal := nil;
  FD_Zero(FDSet);
  FD_Set(FSocket, FDSet);
  X := SynSock.Select(FSocket + 1, @FDSet, nil, nil, TimeVal);
  SockCheck(X);
  if FLastError <> 0 then
    X := 0;
  Result := X > 0;
end;

{TBlockSocket.CanWrite}

function TBlockSocket.CanWrite(TimeOut: Integer): Boolean;
var
  FDSet: TFDSet;
  TimeVal: PTimeVal;
  TimeV: tTimeval;
  X: Integer;
begin
  TimeV.tv_usec := (TimeOut mod 1000) * 1000;
  TimeV.tv_sec := TimeOut div 1000;
  TimeVal := @TimeV;
  if TimeOut = -1 then
    TimeVal := nil;
  FD_Zero(FDSet);
  FD_Set(FSocket, FDSet);
  X := SynSock.Select(FSocket + 1, nil, @FDSet, nil, TimeVal);
  SockCheck(X);
  if FLastError <> 0 then
    X := 0;
  Result := X > 0;
end;

{TBlockSocket.SendBufferTo}

function TBlockSocket.SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
var
  Len: Integer;
begin
  Len := SizeOf(FRemoteSin);
  Result := SynSock.sendto(FSocket, Buffer^, Length, 0, FRemoteSin, Len);
  SockCheck(Result);
end;

{TBlockSocket.RecvBufferFrom}

function TBlockSocket.RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer;
var
  Len: Integer;
begin
  Len := SizeOf(FRemoteSin);
  Result := SynSock.recvfrom(FSocket, Buffer^, Length, 0, FRemoteSin, Len);
  SockCheck(Result);
end;

{TBlockSocket.GetSizeRecvBuffer}

function TBlockSocket.GetSizeRecvBuffer: Integer;
var
  L: Integer;
begin
  L := SizeOf(Result);
  SockCheck(SynSock.getSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Result, L));
  if Flasterror <> 0 then
    Result := 1024;
end;

{TBlockSocket.SetSizeRecvBuffer}

procedure TBlockSocket.SetSizeRecvBuffer(Size: Integer);
begin
  SockCheck(SynSock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Size,
    SizeOf(Size)));
end;

{TBlockSocket.GetSizeSendBuffer}

function TBlockSocket.GetSizeSendBuffer: Integer;
var
  L: Integer;
begin
  L := SizeOf(Result);
  SockCheck(SynSock.getSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Result, L));
  if Flasterror <> 0 then
    Result := 1024;
end;

{TBlockSocket.SetSizeSendBuffer}

procedure TBlockSocket.SetSizeSendBuffer(Size: Integer);
begin
  SockCheck(SynSock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Size,
    SizeOf(Size)));
end;

function TBlockSocket.SetTimeout(Receive, Send: Integer): Boolean;
begin
  // all timeouts are in milliseconds
  Result := SynSock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVTIMEO, @Receive,
    SizeOf(Receive)) <> SOCKET_ERROR;
  Result := Result and (SynSock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDTIMEO,
    @Send, SizeOf(Send)) <> SOCKET_ERROR);
end;

procedure TBlockSocket.Block(DoBlock: Boolean);
var
  X: Integer;
begin
  // set socket to blocking/non-blocking mode
  // if you use non - blocking mode
  //   you'll have to manage all WSAEWOULDBLOCK errors yourself
  X := Ord(not DoBlock);
  SynSock.ioctlsocket(FSocket, FIONBIO, u_long(X));
end;

procedure TBlockSocket.ResetError;
begin
  // resets error flag
//  synsock.WSASetLastError(0);
  FLastError := 0;
end;

procedure TBlockSocket.KeepAlive(B: Boolean);
var
  X: Integer;
begin
  X := Ord(B);
  SynSock.setsockopt(FSocket, SOL_SOCKET, SO_KEEPALIVE, @X, SizeOf(X));
end;

{======================================================================}

{TUDPBlockSocket.CreateSocket}

procedure TUDPBlockSocket.CreateSocket;
begin
  FSocket := SynSock.Socket(PF_INET, Integer(SOCK_DGRAM), IPPROTO_UDP);
  FProtocol := IPPROTO_UDP;
  inherited CreateSocket;
end;

{TUDPBlockSocket.EnableBroadcast}

function TUDPBlockSocket.EnableBroadcast(Value: Boolean): Boolean;
var
  Opt: Integer;
  Res: Integer;
begin
  Opt := Ord(Value);
  Res := SynSock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @Opt,
    SizeOf(Opt));
  SockCheck(Res);
  Result := Res = 0;
end;

{======================================================================}

{TTCPBlockSocket.Create}

constructor TTCPBlockSocket.Create;
begin
  inherited Create;
end;

{TTCPBlockSocket.Destroy}

destructor TTCPBlockSocket.Destroy;
begin
  CloseSocket;
  inherited Destroy;
end;

{TTCPBlockSocket.CreateSocket}

procedure TTCPBlockSocket.CreateSocket;
begin
  FSocket := SynSock.Socket(PF_INET, Integer(SOCK_STREAM), IPPROTO_TCP);
  Inc(Sockets_Count);
  FProtocol := IPPROTO_TCP;
  inherited CreateSocket;
end;

{TTCPBlockSocket.Listen}

procedure TTCPBlockSocket.Listen;
begin
  SockCheck(SynSock.listen(FSocket, SOMAXCONN));
  GetSins;
end;

{TTCPBlockSocket.Accept}

function TTCPBlockSocket.Accept: TSocket;
var
  Len: Integer;
begin
  Len := SizeOf(FRemoteSin);
  Result := SynSock.accept(FSocket, @FRemoteSin, @Len);
  SockCheck(Result);
end;

{======================================================================}

{GetErrorDesc}

function GetErrorDesc(ErrorCode: Integer): string;
begin
  case ErrorCode of
    0: Result := 'OK';
    WSAEINTR: {10004} Result := 'Interrupted system call';
    WSAEBADF: {10009} Result := 'Bad file number';
    WSAEACCES: {10013} Result := 'Permission denied';
    WSAEFAULT: {10014} Result := 'Bad address';
    WSAEINVAL: {10022} Result := 'Invalid argument';
    WSAEMFILE: {10024} Result := 'Too many open files';
    WSAEWOULDBLOCK: {10035} Result := 'Operation would block';
    WSAEINPROGRESS: {10036} Result := 'Operation now in progress';
    WSAEALREADY: {10037} Result := 'Operation already in progress';
    WSAENOTSOCK: {10038} Result := 'Socket operation on nonsocket';
    WSAEDESTADDRREQ: {10039} Result := 'Destination address required';
    WSAEMSGSIZE: {10040} Result := 'Message too long';
    WSAEPROTOTYPE: {10041} Result := 'Protocol wrong type for socket';
    WSAENOPROTOOPT: {10042} Result := 'Protocol not available';
    WSAEPROTONOSUPPORT: {10043} Result := 'Protocol not supported';
    WSAESOCKTNOSUPPORT: {10044} Result := 'Socket not supported';
    WSAEOPNOTSUPP: {10045} Result := 'Operation not supported on socket';
    WSAEPFNOSUPPORT: {10046} Result := 'Protocol family not supported';
    WSAEAFNOSUPPORT: {10047} Result := 'Address family not supported';
    WSAEADDRINUSE: {10048} Result := 'Address already in use';
    WSAEADDRNOTAVAIL: {10049} Result := 'Can''t assign requested address';
    WSAENETDOWN: {10050} Result := 'Network is down';
    WSAENETUNREACH: {10051} Result := 'Network is unreachable';
    WSAENETRESET: {10052} Result := 'Network dropped connection on reset';
    WSAECONNABORTED: {10053} Result := 'Software caused connection abort';
    WSAECONNRESET: {10054} Result := 'Connection reset by peer';
    WSAENOBUFS: {10055} Result := 'No buffer space available';
    WSAEISCONN: {10056} Result := 'Socket is already connected';
    WSAENOTCONN: {10057} Result := 'Socket is not connected';
    WSAESHUTDOWN: {10058} Result := 'Can''t send after socket shutdown';
    WSAETOOMANYREFS: {10059} Result := 'Too many references:can''t splice';
    WSAETIMEDOUT: {10060} Result := 'Connection timed out';
    WSAECONNREFUSED: {10061} Result := 'Connection refused';
    WSAELOOP: {10062} Result := 'Too many levels of symbolic links';
    WSAENAMETOOLONG: {10063} Result := 'File name is too long';
    WSAEHOSTDOWN: {10064} Result := 'Host is down';
    WSAEHOSTUNREACH: {10065} Result := 'No route to host';
    WSAENOTEMPTY: {10066} Result := 'Directory is not empty';
    WSAEPROCLIM: {10067} Result := 'Too many processes';
    WSAEUSERS: {10068} Result := 'Too many users';
    WSAEDQUOT: {10069} Result := 'Disk quota exceeded';
    WSAESTALE: {10070} Result := 'Stale NFS file handle';
    WSAEREMOTE: {10071} Result := 'Too many levels of remote in path';
    WSASYSNOTREADY: {10091} Result := 'Network subsystem is unusable';
    WSAVERNOTSUPPORTED: {10092} Result :=
      'Winsock DLL cannot support this application';
    WSANOTINITIALISED: {10093} Result := 'Winsock not initialized';
    WSAEDISCON: {10101} Result := 'WSAEDISCON-10101';
    WSAHOST_NOT_FOUND: {11001} Result := 'Host not found';
    WSATRY_AGAIN: {11002} Result := 'Non authoritative - host not found';
    WSANO_RECOVERY: {11003} Result := 'Non recoverable error';
    WSANO_DATA: {11004} Result := 'Valid name, no data record of requested type'
  else
    Result := 'Not a Winsock error (' + IntToStr(ErrorCode) + ')';
  end;
end;

procedure ResolveNameToIP(Name: string; IPlist: TMyStringList);
type
  TaPInAddr = array[0..250] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  RemoteHost: PHostEnt;
  IP: u_long;
  PAdrPtr: PaPInAddr;
  I: Integer;
  S: string;
  InAddr: TInAddr;
begin
  IPList.Clear;
  IP := SynSock.inet_addr(PChar(Name));
  if IP = u_long(INADDR_NONE) then
  begin
    RemoteHost := SynSock.gethostbyname(PChar(Name));
    if RemoteHost <> nil then
    begin
      PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
      I := 0;
      while PAdrPtr^[I] <> nil do
      begin
        InAddr := PAdrPtr^[I]^;
        with InAddr.S_un_b do
          S := IntToStr(Ord(s_b1)) + '.' + IntToStr(Ord(s_b2)) + '.'
            + IntToStr(Ord(s_b3)) + '.' + IntToStr(Ord(s_b4));
        IPList.Add(S);
        Inc(I);
      end;
    end;
  end
  else
    IPList.Add(Name);
end;

function TCPSocket_Connect(Socket: HSocket; IP, Port: string; var Last_Error:
  Integer): Integer;
var
  Sin: TSockAddrIn;
begin
  SetSin(Sin, IP, Port, IPPROTO_TCP);
  Result := SynSock.connect(Socket, Sin, SizeOf(Sin));
  Last_Error := TCPSocket_SockCheck(Result);
end;

procedure TCPSocket_Block(Socket: HSocket; DoBlock: Boolean);
var
  X: Integer;
begin
  // set socket to blocking/non-blocking mode
  // if you use non - blocking mode
  //   you'll have to manage all WSAEWOULDBLOCK errors yourself
  X := Ord(not DoBlock);
  SynSock.ioctlsocket(Socket, FIONBIO, u_long(X));
end;

function TCPSocket_GetSocketError(Socket: HSocket): Integer;
var
  L: Integer;
begin
  L := SizeOf(Result);
  SynSock.getSockOpt(Socket, SOL_SOCKET, SO_ERROR, @Result, L);
end;

function TCPSocket_SendString(Socket: HSocket; Data: string; var Last_Error:
  Integer): Integer;
begin
  Result := TCPSocket_SendBuffer(Socket, PChar(Data), Length(Data), Last_Error);
end;

function TCPSocket_SendBuffer(Socket: HSocket; Buffer: Pointer; Length: Integer;
  var Last_Error: Integer): Integer;
begin
  Result := SynSock.Send(Socket, Buffer^, Length, 0);
  Last_Error := TCPSocket_SockCheck(Result);
end;

function TCPSocket_RecvBuffer(Socket: HSocket; Buffer: Pointer; Length: Integer;
  var Last_Error: Integer): Integer;
begin
  Result := SynSock.Recv(Socket, Buffer^, Length, 0);
  if Result < 0 then
    Last_Error := SynSock.WSAGetLastError
  else if Result = 0 then
    Last_Error := WSAENOTCONN
  else
    Last_Error := 0;
end;

function TCPSocket_CanRead(Socket: HSocket; TimeOut: Integer; var Last_Error:
  Integer): Boolean;
var
  FDSet: TFDSet;
  TimeVal: PTimeVal;
  TimeV: tTimeval;
  X: Integer;
begin
  TimeV.tv_usec := (TimeOut mod 1000) * 1000;
  TimeV.tv_sec := TimeOut div 1000;
  TimeVal := @TimeV;
  if TimeOut = -1 then
    TimeVal := nil;
  FD_Zero(FDSet);
  FD_Set(Socket, FDSet);
  X := SynSock.Select(Socket + 1, @FDSet, nil, nil, TimeVal);
  Last_Error := TCPSocket_SockCheck(X);
  if Last_Error <> 0 then
    Result := False
  else
    Result := X > 0;
end;

function TCPSocket_CanWrite(Socket: HSocket; TimeOut: Integer; var Last_Error:
  Integer): Boolean;
var
  FDSet: TFDSet;
  TimeVal: PTimeVal;
  TimeV: tTimeval;
  X: Integer;
begin
  TimeV.tv_usec := (TimeOut mod 1000) * 1000;
  TimeV.tv_sec := TimeOut div 1000;
  TimeVal := @TimeV;
  if TimeOut = -1 then
    TimeVal := nil;
  FD_Zero(FDSet);
  FD_Set(Socket, FDSet);
  X := SynSock.Select(Socket + 1, nil, @FDSet, nil, TimeVal);
  Last_Error := TCPSocket_SockCheck(X);
  if Last_Error <> 0 then
    X := 0;
  Result := X > 0;
end;

procedure TCPSocket_SetLinger(Socket: HSocket; Enable: Boolean; Linger:
  Integer);
var
  Li: TLinger;
begin
  Li.l_onoff := Ord(Enable);
  Li.l_linger := Linger div 1000;
  SynSock.SetSockOpt(Socket, SOL_SOCKET, SO_LINGER, @Li, SizeOf(Li));
end;

procedure TCPSocket_Bind(Socket: HSocket; IP, Port: string);
var
  Sin: TSockAddrIn;
begin
  SetSin(Sin, IP, Port, IPPROTO_TCP);
  SynSock.bind(Socket, Sin, SizeOf(Sin));
end;

procedure TCPSocket_SetSizeRecvBuffer(Socket: HSocket; Size: Integer);
begin
  SynSock.SetSockOpt(Socket, SOL_SOCKET, SO_RCVBUF, @Size, SizeOf(Size));
end;

procedure TCPSocket_SetSizeSendBuffer(Socket: HSocket; Size: Integer);
begin
  SynSock.SetSockOpt(Socket, SOL_SOCKET, SO_SNDBUF, @Size, SizeOf(Size));
end;

procedure TCPSocket_KeepAlive(Socket: HSocket; B: Boolean);
var
  X: Integer;
begin
  X := Ord(B);
  SynSock.setsockopt(Socket, SOL_SOCKET, SO_KEEPALIVE, @X, SizeOf(X));
end;

function TCPSocket_GetRemoteSin(Socket: HSocket): TSockAddrIn;
var
  Len: Integer;
begin
  Len := SizeOf(Result);
  SynSock.GetPeerName(Socket, Result, Len);
end;

function TCPSocket_GetLocalSin(Socket: HSocket): TSockAddrIn;
var
  Len: Integer;
begin
  Len := SizeOf(Result);
  SynSock.GetSockName(Socket, Result, Len);
end;

function TCPSocket_SockCheck(SockResult: Integer): Integer;
begin
  if SockResult = SOCKET_ERROR then
    Result := SynSock.WSAGetLastError
  else
    Result := 0;
end;

initialization
  begin
    Sockets_Count := 0;
    Count_BlockSock := 0;
    Count_BlockSock_Max := 0;
    if not InitSocketInterface('') then
      Exit;
    SynSock.WSAStartup($101, FWsaData);
    Exit;
    asm
    db 'Synapse TCP/IP library by Lukas Gebauer',0
    end;
  end;

finalization
  begin
    SynSock.WSACleanup;
    DestroySocketInterface;
  end;

end.
