{==============================================================================|
| 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.
