dxsocket.pas

Well known and usefull component for delphi 7

                 {$ENDIF}Socket(sin_family,socket_type,protocol);
         If Result=Invalid_Socket then ErrorCode:=WSAGetLastError;
End;

Function SetErrorCode(ResultCode:Integer):Integer;
Begin
   If ResultCode=Socket_Error then Result:=WSAGetLastError
   Else Result:=0;
End;

Procedure SetNagle(Sock:TSocket;
                   TurnOn:Boolean;
                   Var ErrorCode:Integer);
Var
   TA:Array[0..3] of Char;

Begin
   If Not TurnOn then TA:='1111'
   Else TA:='0000';
   ErrorCode:=SetErrorCode(SetSockOpt(Sock,IPPROTO_TCP,TCP_NODELAY,@TA,SizeofInt));
End;

Procedure SetBlocking(Sock:TSocket;
                      UseBlocking:Boolean;
                      Var ErrorCode:Integer);
{$IFDEF LINUX}
Const
   FIONBIO=$5421;
{$ENDIF}

Var
{$IFDEF VER90}
   iBlocking:u_long;
{$ELSE}
   iBlocking:Integer;
{$ENDIF}

Begin
   If UseBlocking then iBlocking:=0
   Else iBlocking:=1;
// LINUX COULD BE DONE:
//         SetErrorCode(fcntl(Sock, F_SETFL, O_NONBLOCK));

   ErrorCode:=SetErrorCode(
   {$IFDEF VER90}
      Winsock.ioctlsocket(Sock,FIONBIO,iBlocking)
   {$ELSE}
      {$IFDEF LINUX}Libc.ioctl(Sock,FIONBIO,iBlocking)
      {$ELSE}Winsock.ioctlsocket(Sock,FIONBIO,iBlocking)
      {$ENDIF}
   {$ENDIF}
   );
End;

Procedure SetReceiveTimeout(Sock:TSocket;
                            TimeoutMS:Integer;
                            Var ErrorCode:Integer);
Begin
   ErrorCode:=SetErrorCode(setsockopt(Sock,SOL_SOCKET,SO_RCVTIMEO,@TimeoutMS,SizeOfInt));
End;

Procedure SetSendTimeout(Sock:TSocket;
                         TimeoutMS:Integer;
                         Var ErrorCode:Integer);
Begin
   ErrorCode:=SetErrorCode(setsockopt(Sock,SOL_SOCKET,SO_SNDTIMEO,@TimeoutMS,SizeofInt));
End;

Procedure ResetBufferAndTimeout(Sock:TSocket;
                                TimeoutMS:Integer;
                                WantedSize:Integer);
Begin
   setsockopt(Sock,SOL_SOCKET,SO_SNDTIMEO,@TimeoutMS,SizeofInt);
   setsockopt(Sock,SOL_SOCKET,SO_RCVTIMEO,@TimeoutMS,SizeOfInt);
   setsockopt(Sock,SOL_SOCKET,SO_RCVBUF,@WantedSize,SizeofInt);
   setsockopt(Sock,SOL_SOCKET,SO_SNDBUF,@WantedSize,SizeofInt);
End;

Function GetSockStatusBool(Sock:TSocket;
                           SO_Flag:Integer;
                           Var ErrorCode:Integer):Boolean;
Var
   Rslt:Boolean;

Begin
   ErrorCode:=SetErrorCode(GetSockOpt(Sock,SOL_SOCKET,SO_Flag,PChar(@Rslt),SizeofInt));
   If ErrorCode=0 then Result:=Rslt
   Else Result:=False;
End;

Function GetSockStatusInt(Sock:TSocket;
                          SO_Flag:Integer;
                          Var ErrorCode:Integer):Integer;
Var
   Rslt:Integer;

Begin
   ErrorCode:=SetErrorCode(GetSockOpt(Sock,SOL_SOCKET,SO_Flag,PChar(@Rslt),SizeofInt));
   If ErrorCode=0 then Result:=Rslt
   Else Result:=0;
End;

Procedure SetSockStatusBool(Sock:TSocket;
                           SO_Flag:Integer;
                           Setting:Boolean;
                           Var ErrorCode:Integer);
var
   intval:integer;

Begin
   if (Setting) then intval:=1
   else intval:=0;
   ErrorCode:=SetErrorCode(SetSockOpt(Sock,SOL_Socket,SO_Flag,@intval,SizeofInt));
End;

Procedure SetSockStatusInt(Sock:TSocket;
                          SO_Flag:Integer;
                          Setting:Integer;
                          Var ErrorCode:Integer);
Begin
   ErrorCode:=SetErrorCode(SetSockOpt(Sock,SOL_Socket,SO_Flag,@Setting,SizeofInt));
End;

Procedure SetReceiveBuffer(Sock:TSocket;
                           WantedSize:Integer;
                           Var ErrorCode:Integer);
Begin
   ErrorCode:=SetErrorCode(setsockopt(Sock,SOL_SOCKET,SO_RCVBUF,@WantedSize,SizeofInt));
End;

Procedure SetSendBuffer(Sock:TSocket;
                        WantedSize:Integer;
                        Var ErrorCode:Integer);
Begin
   ErrorCode:=SetErrorCode(setsockopt(Sock,SOL_SOCKET,SO_SNDBUF,@WantedSize,SizeofInt));
End;

Function GetReceiveBuffer(Sock:TSocket;
                          Var ErrorCode:Integer):Integer;
Begin
   Result:=GetSockStatusInt(Sock,SO_RCVBUF,ErrorCode);
End;

Function GetSendBuffer(Sock:TSocket;
                       Var ErrorCode:Integer):Integer;
Begin
   Result:=GetSockStatusInt(Sock,SO_SNDBUF,ErrorCode);
End;

Procedure KillSocket(Var Sock:TSocket);
Begin
   If Sock<>Invalid_Socket then Begin
      ShutDown(Sock,2);
try
{$IFDEF LINUX}
      Libc.__close(Sock);
{$ELSE}
      CloseSocket(Sock);
{$ENDIF}
finally
      Sock:=Invalid_Socket;
end;
   End;
End;

Procedure CloseConnection(Var Sock:TSocket;
                          Gracefully:Boolean);
Var
{$IFDEF VER100} // Delphi3 code
   Lin:TLinger;
{$ELSE}
   Lin:Linger;
{$ENDIF}

Begin
   If Sock=Invalid_Socket then Exit;
{$IFNDEF LINUX}
   Lin.l_linger:=0;
{$ELSE}
   Lin.l_linger:=Libc.TCP_LINGER2;
{$ENDIF}
   If Gracefully then Begin
      Lin.l_onoff:=1; // Not(0);
      {$IFDEF LINUX}Libc.
      {$ELSE}Winsock.
      {$ENDIF}setsockopt(Sock,SOL_SOCKET,SO_LINGER,@lin,Sizeof(Lin));
   End
   Else Begin
      Lin.l_onoff:=0;
      {$IFDEF LINUX}Libc.
      {$ELSE}Winsock.
      {$ENDIF}setsockopt(Sock,SOL_SOCKET,SO_LINGER,@lin,sizeof(lin)); {DONT 2.0.f}
   End;
   KillSocket(Sock);
End;

Function ClientConnectToServer(ServerIPAddress:String;
                               ServerPort:Integer;
                               UseUDP,UseNAGLE:Boolean;
                               ResultSockAddr:PSockAddr;
                               Var ErrorCode:Integer):TSocket;
{$IFDEF LINUX}
Const
   SOCK_dgram=2;
   SOCK_stream=1;
{$ENDIF}
Var
   Timeout:TTimeVal;

begin
   Result:=Invalid_Socket;
   If ServerIPAddress='' then Exit;
   ServerIPAddress:=FixDottedIp(ServerIPAddress);
{$IFNDEF LINUX}
// FASTEST:
   ResultSockAddr^.sa_data:=#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
{$ELSE}
   DXString.FillChar2(ResultSockAddr^.sa_data,Sizeof(ResultSockAddr^.sa_data),#0);
{$ENDIF}
   ResultSockAddr^.sin_family:=AF_INET;
   ResultSockAddr^.sin_port:=htons(ServerPort);
   If IsNumericString(ServerIPAddress) then Begin
      ResultSockAddr.sin_addr.S_addr:=Inet_Addr(Pchar(ServerIPAddress));
   End
   Else begin
      ServerIPAddress:=GetIPAddressByHost(ServerIPAddress,1);
      If ServerIPAddress='' then Begin
         ErrorCode:=WSAEFAULT; // invalid address
         Exit;
      End;
      ResultSockAddr.sin_addr.S_addr:=Inet_Addr(Pchar(ServerIPAddress));
   End;
   Case UseUDP of
      True:Begin
         Result:=CreateSocket(AF_INET,SOCK_DGRAM,IPPROTO_UDP,ErrorCode);
         Exit;
      End;
      Else Begin
         Result:=CreateSocket(AF_INET,SOCK_STREAM,IPPROTO_TCP,ErrorCode);
         If (Result<>Invalid_Socket) and (Not UseNAGLE) then
            SetNAGLE(Result,UseNAGLE,ErrorCode);
      End;
   End;
   If Result=Invalid_Socket then Exit;
   SetBlocking (Result,False,ErrorCode) ;
   If Connect(Result,ResultSockAddr^,ConstSizeofTSockAddrIn)=SOCKET_ERROR then begin
      ErrorCode:=WSAGetLastError;
      If (ErrorCode=WSAEWOULDBLOCK) or (ErrorCode=WSAEINPROGRESS) then Begin
         Timeout.tv_sec:=0;
         Timeout.tv_usec:=250000*16; // 4=1 second, 8=2 seconds, 16=4 seconds
         If BasicSelect(Result,False,Timeout)>0 then Begin
            ErrorCode:=0;
            Exit; // connected!
         End;
      End;
      KillSocket(Result);
   End;
end;

Function BindAndListen(BindToIPAddress:String;
                       BindToPort,WinsockQueue:Integer;
                       UseUDP,UseNAGLE,ConnectionLess:Boolean;
                       ResultSockAddr:PSockAddr;
                       Var ErrorCode:Integer):TSocket;
{$IFDEF LINUX}
Const
   SOCK_dgram=2;
   SOCK_stream=1;
{$ENDIF}

begin
// FASTEST:
   ResultSockAddr^.sa_family:=0;
{$IFNDEF LINUX}
   ResultSockAddr^.sa_data:=#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
{$ELSE}
   DXString.FillChar2(ResultSockAddr^.sa_data,Sizeof(ResultSockAddr^.sa_data),#0);
{$ENDIF}
// SPX: Result:=CreateSocket(AF_IPX,SOCK_STREAM,NSPROTO_SPX,ErrorCode);
// IPX: Result:=CreateSocket(AF_IPX,SOCK_DGRAM,NSPROTO_IPX,ErrorCode);
   Case UseUDP of
      True:Result:=CreateSocket(AF_INET,SOCK_DGRAM,IPPROTO_UDP,ErrorCode);
      Else Begin
         Result:=CreateSocket(AF_INET,SOCK_STREAM,IPPROTO_TCP,ErrorCode);
         If (Result<>Invalid_Socket) and (Not UseNAGLE) then SetNAGLE(Result,UseNAGLE,ErrorCode);
      End;
   End;
   If Result=Invalid_Socket then Exit;
   ResultSockAddr.sin_family:=AF_INET;
   ResultSockAddr.sin_port:=htons(BindToPORT);
   if (length(BindToIPAddress)<7) then ResultSockAddr.sin_addr.S_addr:=INADDR_ANY
   else ResultSockAddr.sin_addr.S_addr:=Inet_Addr(PChar(BindToIPAddress));
   If Bind(Result,ResultSockAddr^,ConstSizeofTSockAddrIn)=Socket_Error then Begin
      Result:=Invalid_Socket;
      ErrorCode:=WSAGetLastError;
      Exit;
   End;
// 7-27
   If Not ConnectionLess then
      If Listen(Result,WinsockQueue)=Socket_Error then Begin
         Result:=Invalid_Socket;
         ErrorCode:=WSAGetLastError;
      End;
End;

Function IsAcceptWaiting(ListenerSock:TSocket):Boolean;
Var
   TmpTimeout:TTimeVal; //2005-1-15
{$IFNDEF LINUX}
   SockList:TFDSet;
{$ENDIF}

Begin
   TmpTimeout:=GlobalTimeout;
   // 13-Jan-2005 override 100ms with
   TmpTimeout.tv_usec:=250000*4; // 4=1 second, 8=2 seconds, 16=4 seconds
{$IFDEF LINUX}
   Result:=BasicSelect(ListenerSock,True,TmpTimeout)>0;
{$ELSE}
   SockList.fd_count:=1;
   SockList.fd_array[0]:=ListenerSock;
   Result:=Select(0,@sockList,nil,nil,@TmpTimeout)>0;
{$ENDIF}
End;

Function AcceptNewConnect(ListenerSock:TSocket;
                          ResultAddr:PSockAddr;
                          ResultAddrlen:PInteger;
                          Var ErrorCode:Integer):TSocket;
Begin
   Result:={$IFDEF LINUX}Libc.
           {$ELSE}Winsock.
           {$ENDIF}Accept(ListenerSock,
{$IFDEF VER90}
      ResultAddr^,ResultAddrLen^);
{$ELSE}
{$IFDEF LINUX}
      ResultAddr,PSocketLength(ResultAddrLen));
{$ELSE}
      ResultAddr,ResultAddrLen);
{$ENDIF}
{$ENDIF}
   If Result=Invalid_Socket then ErrorCode:=WSAGetLastError
   Else If ResultAddrLen^=0 then ErrorCode:=WSAEFault
   Else ErrorCode:=0;
End;

Function BasicSend(Sock:TSocket;
                   Var Buf;
                   Len:Integer;
                   Flags:Integer;
                   Var ErrorCode:Integer):Integer;
Begin
   Result:=Send(Sock,Buf,Len,Flags {or MSG_DONTROUTE});
   ErrorCode:=SetErrorCode(Result);
End;

Function UDPSend(Sock:TSocket;
                 Var Buf;
                 Len:Integer;
                 Flags:Integer;
                 SendTo:TSockAddr;
                 SendToSize:Integer;
                 Var ErrorCode:Integer):Integer;
Begin
   Result:={$IFDEF LINUX}Libc.
           {$ELSE}Winsock.
           {$ENDIF}SendTo(Sock,Buf,Len,Flags,SendTo,SendToSize);
   ErrorCode:=SetErrorCode(Result);
End;

Function BasicRecv(Sock:TSocket;
                   Var Buf;
                   Len:Integer;