dxsocket.pas

Well known and usefull component for delphi 7

                   Flags:Integer;
                   Var ErrorCode:Integer):Integer;
Begin
      Result:=Recv(Sock,Buf,Len,Flags);
      ErrorCode:=SetErrorCode(Result);
End;

Function UDPRecv(Sock:TSocket;
                 Var Buf;
                 Len:Integer;
                 Flags:Integer;
                 Var RcvFrom:TSockAddr;
                 Var RcvFromSize:Integer;
                 Var ErrorCode:Integer):Integer;
Begin
      Result:={$IFDEF LINUX}Libc.recvfrom(Sock,Buf,Len,Flags,@RcvFrom,@RcvFromSize);
              {$ELSE}Winsock.recvfrom(Sock,Buf,Len,Flags,RcvFrom,RcvFromSize);
              {$ENDIF}
      ErrorCode:=SetErrorCode(Result);
End;

Function BasicPeek(Sock:TSocket;
                   Var Buf;
                   Len:Integer):Integer;
Begin
      Result:=Recv(Sock, Buf, Len, MSG_PEEK);
End;

Function BasicSelect(Sock:TSocket;
                     CheckRead:Boolean;
                     Timeout:TTimeVal):Integer;
var
  SockList: TFDSet;

Begin
{$IFDEF LINUX}
   Libc.FD_ZERO(SockList);
   Libc.FD_SET(Sock,SockList);
//   SockList.fds_bits[0]:=Sock;
   If CheckRead then
      Result:=Select(Sock+1,@SockList,nil,nil,@Timeout)
   Else
      Result:=Select(Sock+1,nil,@SockList,nil,@Timeout);
   If Result>0 then Begin
      If Libc.FD_ISSET(Sock,SockList) then Result:=1
      Else Result:=0;
   End;
{$ELSE}
   SockList.fd_count:=1;
   SockList.fd_array[0]:=Sock;
   If CheckRead then
     Result:=Select(0,@sockList,nil,nil,@Timeout)
   Else
     Result:=Select(0,nil,@sockList,nil,@Timeout)
{$ENDIF}
End;

Function CountWaiting(Sock:TSocket;Var ErrorCode:Integer):Integer;
{$IFDEF LINUX}
Const
   FIONREAD=$541B; // Solaris & BSD FIONREAD=$400667f
{$ENDIF}
var
   numWaiting:longint;

begin
   Result:=0;
// in linux IOCtl is normally used to "set" not "get" values.
// but the following is a great HACK to make it work like Winsock!
   ErrorCode:=SetErrorCode({$IFDEF LINUX}Libc.IOCtl(Sock,FIONREAD,@numWaiting));
                           {$ELSE}Winsock.IOCtlSocket(Sock,FIONREAD,numWaiting));
                           {$ENDIF}
   If ErrorCode=0 then Result:=numWaiting;
end;

Function GetAddressCountByIP(IPAddress:String):Integer;
Var
   HostEnt:PHostEnt;
   InAddr:u_long;

Begin
   IPAddress:=FixDottedIp(IPAddress);
   InAddr:=inet_addr(PChar(IPAddress));
   HostEnt:=gethostbyaddr(@InAddr,Length(IPAddress),AF_INET);
   If Assigned(HostEnt) then Result:=HostEnt^.h_length div 4
   Else Result:=0;
End;

Function GetAddressCountByHost(Host:String):Integer;
Var
   HostEnt:PHostEnt;

Begin
   HostEnt:=gethostbyname(PChar(Host));
   If Assigned(HostEnt) then Result:=HostEnt^.h_length div 4
   Else Result:=0;
End;

Function GetIPAddressByHost(Host:String;Which:Integer):String;
Var
   HostEnt:PHostEnt;
   iAddr:Integer;

Begin
   HostEnt:=gethostbyname(PChar(Host));
   If Assigned(HostEnt) then Begin
      If Which<=(HostEnt^.h_length div 4) then Begin
         FastMove(PByteArray(HostEnt^.h_addr_list^)[(Which-1)*4],iAddr,4);
         Result:=inet_ntoa(in_Addr(iAddr));
      End
      Else Result:='';
   End
   Else Result:='';
End;

Function GetHostByIPAddress(IPAddress:String):String;
Var
   HostEnt:PHostEnt;
   InAddr:u_long;

Begin
   IPAddress:=FixDottedIp(IPAddress);
   InAddr:=inet_addr(PChar(IPAddress));
   HostEnt:=gethostbyaddr(@InAddr,Length(IPAddress),AF_INET);
   If Assigned(HostEnt) then Result:=StrPas(HostEnt^.h_name)
   Else Result:='';
End;

Function GetLocalHostName:String;
Begin
   Result:=GetHostByIPAddress(
      GetIPAddressByHost('localhost',1));
   If Result='' then Result:='Localhost';
End;

function GetLocalPort(Sock:TSocket):Integer;
var
  addr: TSockAddrIn;
{$IFDEF LINUX}
  addrlen: cardinal;
{$ELSE}
  addrlen: integer;
{$ENDIF}

begin
  addrlen:=ConstSizeofTSockAddrIn;
  if getsockname(Sock,addr,addrlen)=0 then Result:=ntohs(addr.sin_port)
  else Result := 0;
end;

function GetLocalIPAddr(Sock:TSocket):string;
var
  addr: TSockAddrIn;
{$IFDEF LINUX}
  addrlen: cardinal;
{$ELSE}
  addrlen: integer;
{$ENDIF}

begin
  addrlen:=ConstSizeofTSockAddrIn;
// FASTEST:
  Addr.sa_family:=0;
{$IFNDEF LINUX}
  Addr.sa_data:=#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
{$ELSE}
   DXString.FillChar2(Addr.sa_data,Sizeof(Addr.sa_data),#0);
{$ENDIF}
  getsockname(Sock,addr,addrlen);
  Result:=inet_ntoa(addr.sin_addr);
end;

Procedure GetRemoteSockAddr(Sock:TSocket;
                            ResultAddr:PSockAddr;
                            ResultAddrlen:PInteger;
                            Var ErrorCode:Integer);
{$IFDEF LINUX}
Var
   TmpAddrLen:Cardinal;
{$ENDIF}

Begin
{$IFDEF LINUX}
   ErrorCode:=SetErrorCode(getpeername(Sock,ResultAddr^,TmpAddrlen));
   ResultAddrLen^:=TmpAddrLen;
{$ELSE}
   ErrorCode:=SetErrorCode(getpeername(Sock,ResultAddr^,ResultAddrlen^));
{$ENDIF}
End;

function GetLastError:Integer;
Begin
   Result:=WSAGetLastError;
End;

Function GetErrorDesc(errorCode:Integer):String;
begin
// If you compile and get "Undeclared Identified -
// Edit DXSock.DEF - and select a language!
   case errorCode of
      WSAEINTR:Result:=_WSAEINTR;
      WSAEBADF:Result:=_WSAEBADF;
      WSAEACCES:Result:=_WSAEACCES;
      WSAEFAULT:Result:=_WSAEFAULT;
      WSAEINVAL:Result:=_WSAEINVAL;
      WSAEMFILE:Result:=_WSAEMFILE;
      WSAEWOULDBLOCK:Result:=_WSAEWOULDBLOCK;
      WSAEINPROGRESS:Result:=_WSAEINPROGRESS;
      WSAEALREADY:Result:=_WSAEALREADY;
      WSAENOTSOCK:Result:=_WSAENOTSOCK;
      WSAEDESTADDRREQ:Result:=_WSAEDESTADDRREQ;
      WSAEMSGSIZE:Result:=_WSAEMSGSIZE;
      WSAEPROTOTYPE:Result:=_WSAEPROTOTYPE;
      WSAENOPROTOOPT:Result:=_WSAENOPROTOOPT;
      WSAEPROTONOSUPPORT:Result:=_WSAEPROTONOSUPPORT;
      WSAESOCKTNOSUPPORT:Result:=_WSAESOCKTNOSUPPORT;
      WSAEOPNOTSUPP:Result:=_WSAEOPNOTSUPP;
      WSAEPFNOSUPPORT:Result:=_WSAEPFNOSUPPORT;
      WSAEAFNOSUPPORT:Result:=_WSAEAFNOSUPPORT;
      WSAEADDRINUSE:Result:=_WSAEADDRINUSE;
      WSAEADDRNOTAVAIL:Result:=_WSAEADDRNOTAVAIL;
      WSAENETDOWN:Result:=_WSAENETDOWN;
      WSAENETUNREACH:Result:=_WSAENETUNREACH;
      WSAENETRESET:Result:=_WSAENETRESET;
      WSAECONNABORTED:Result:=_WSAECONNABORTED;
      WSAECONNRESET:Result:=_WSAECONNRESET;
      WSAENOBUFS:Result:=_WSAENOBUFS;
      WSAEISCONN:Result:=_WSAEISCONN;
      WSAENOTCONN:Result:=_WSAENOTCONN;
      WSAESHUTDOWN:Result:=_WSAESHUTDOWN;
      WSAETOOMANYREFS:Result:=_WSAETOOMANYREFS;
      WSAETIMEDOUT:Result:=_WSAETIMEDOUT;
      WSAECONNREFUSED:Result:=_WSAECONNREFUSED;
      WSAELOOP:Result:=_WSAELOOP;
      WSAENAMETOOLONG:Result:=_WSAENAMETOOLONG;
      WSAEHOSTDOWN:Result:=_WSAEHOSTDOWN;
      WSAEHOSTUNREACH:Result:=_WSAEHOSTUNREACH;
      WSAENOTEMPTY:Result:=_WSAENOTEMPTY;
      WSAEPROCLIM:Result:=_WSAEPROCLIM;
      WSAEUSERS:Result:=_WSAEUSERS;
      WSAEDQUOT:Result:=_WSAEDQUOT;
      WSAESTALE:Result:=_WSAESTALE;
      WSAEREMOTE:Result:=_WSAEREMOTE;
      WSASYSNOTREADY:Result:=_WSASYSNOTREADY;
      WSAVERNOTSUPPORTED:Result:=_WSAVERNOTSUPPORTED;
      WSANOTINITIALISED:Result:=_WSANOTINITIALISED;
      WSAHOST_NOT_FOUND:Result:=_WSAHOST_NOT_FOUND;
      WSATRY_AGAIN:Result:=_WSATRY_AGAIN;
      WSANO_RECOVERY:Result:=_WSANO_RECOVERY;
      WSANO_DATA:Result:=_WSANO_DATA;
      Else Result:=_WSAUNKNOWN+' ('+IntToCommaStr(ErrorCode)+')';
   end;
end;

function ByteSwap4(lng:Cardinal):Cardinal;
begin
   result:=ntohl(lng);
end;

function ByteSwap2(shrt:smallint):smallint;
begin
   result:=ntohs(shrt);
end;

Function IPIntToIPStr(IPAddr:Integer):String;
Var
   Ws:String;

Begin
   Setlength(Ws,4);
   FastMove(IPAddr,Ws[1],4);
   Result:=IntegerToString(Ord(Ws[1]))+'.'+
      IntegerToString(Ord(Ws[2]))+'.'+
      IntegerToString(Ord(Ws[3]))+'.'+
      IntegerToString(Ord(Ws[4]));
End;

Function IPStrToIPInt(IPAddr:String):Integer;
Var
   Ws:String;

Begin
   Setlength(Ws,4);
   Ws[1]:=Char(StrToInt(FetchByChar(IPAddr,'.',False)));
   Ws[2]:=Char(StrToInt(FetchByChar(IPAddr,'.',False)));
   Ws[3]:=Char(StrToInt(FetchByChar(IPAddr,'.',False)));
   Ws[4]:=Char(StrToInt(FetchByChar(IPAddr,'.',False)));
   FastMove(Ws[1],Result,4);
End;

Function SocketLayerLoaded:Boolean;
Begin
   Result:=(StartupResult=999);
End;

Procedure GetSocketVersion(WinsockInfo:PWinsockInfo);
Begin
{$IFDEF LINUX}
   With WinsockInfo^ do Begin
      Major_Version:=2;
      Minor_Version:=0;
      Highest_Major_Version:=2;
      Highest_Minor_Version:=0;
      FastMove('Linux Socket Layer 2.0',Description,256);
      FastMove('Ready',SystemStatus,128);
      MaxSockets:=65000;
      MaxUDPDatagramSize:=1500;
      VendorInfo:='Brain Patchwork DX, LLC.';
   End;
{$ELSE}
   With WinsockInfo^ do Begin
      Major_Version:=BYTE(DllData.wVersion);
      Minor_Version:=HIBYTEOfWORD(DllData.wVersion);
      Highest_Major_Version:=BYTE(DllData.wHighVersion);
      Highest_Minor_Version:=HIBYTEOfWORD(DllData.wHighVersion);
      FastMove(DllData.szDescription,Description,256);
      FastMove(DllData.szSystemStatus,SystemStatus,128);
      MaxSockets:=DllData.iMaxSockets;
      MaxUDPDatagramSize:=DllData.iMaxUdpDg;
      VendorInfo:=DllData.lpVendorInfo;
   End;
{$ENDIF}
End;

Function ntohs(netshort:Word):Word;
Begin
   Result:={$IFDEF LINUX}Libc.
           {$ELSE}Winsock.
           {$ENDIF}ntohs(Netshort);
End;

Function inet_ntoa(inaddr:in_addr):PChar;
Begin
   Result:={$IFDEF LINUX}Libc.
           {$ELSE}Winsock.
           {$ENDIF}inet_ntoa(inaddr);
End;

Function htonl(Hostlong:Integer):Integer;
Begin
   Result:={$IFDEF LINUX}Libc.
           {$ELSE}Winsock.
           {$ENDIF}htonl(Hostlong);
End;

Function ntohl(Netlong:Integer):Integer;
Begin
   Result:={$IFDEF LINUX}Libc.
           {$ELSE}Winsock.
           {$ENDIF}ntohl(netlong)
End;

initialization
{$IFDEF LINUX}
   StartupResult:=0;
{$ELSE}
   StartupResult:=WSAStartup(MAKEBytesToWORD(2,2),DLLData);
{$ENDIF}
   if StartupResult=0 then Begin
      StartupResult:=999;
      GlobalTimeout.tv_Sec:=0;
      GlobalTimeout.tv_uSec:=100; //2500;
   End
   else StartupResult:=123;

finalization
{$IFNDEF LINUX}
   If StartupResult=999 then WSACleanup;
{$ENDIF}

End.