dxsocket.pas

Well known and usefull component for delphi 7

{$I DXSock.def}
unit DXSocket;

///////////////////////////////////////////////////////////////////////////////
//         Unit: DXSocket
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2004
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (3rd Generation Code)
// ========================================================================
//  Description: Low-Level Socket Wrapper, producing a common framework.
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

interface

{$IFDEF LINUX}
uses
   Classes,
   Libc;
{$ELSE}
uses
   Classes,
   Windows,
   Winsock;
{$ENDIF}

{$WARNINGS OFF}
{$IFDEF LINUX}
Const
   INVALID_SOCKET=Libc.INVALID_SOCKET;
   SO_KeepAlive=Libc.SO_KEEPALIVE;
   WSAEINTR=Libc.EINTR;
   WSAEBADF=Libc.EBADF;
   WSAEACCES=Libc.EACCES;
   WSAEFAULT=Libc.EFAULT;
   WSAEINVAL=Libc.EINVAL;
   WSAEMFILE=Libc.EMFILE;
   WSAEWOULDBLOCK=Libc.EWOULDBLOCK;
   WSAEINPROGRESS=Libc.EINPROGRESS;
   WSAEALREADY=Libc.EALREADY;
   WSAENOTSOCK=Libc.ENOTSOCK;
   WSAEDESTADDRREQ=Libc.EDESTADDRREQ;
   WSAEMSGSIZE=Libc.EMSGSIZE;
   WSAEPROTOTYPE=Libc.EPROTOTYPE;
   WSAENOPROTOOPT=Libc.ENOPROTOOPT;
   WSAEPROTONOSUPPORT=Libc.EPROTONOSUPPORT;
   WSAESOCKTNOSUPPORT=Libc.ESOCKTNOSUPPORT;
   WSAEOPNOTSUPP=Libc.EOPNOTSUPP;
   WSAEPFNOSUPPORT=Libc.EPFNOSUPPORT;
   WSAEAFNOSUPPORT=Libc.EAFNOSUPPORT;
   WSAEADDRINUSE=Libc.EADDRINUSE;
   WSAEADDRNOTAVAIL=Libc.EADDRNOTAVAIL;
   WSAENETDOWN=Libc.ENETDOWN;
   WSAENETUNREACH=Libc.ENETUNREACH;
   WSAENETRESET=Libc.ENETRESET;
   WSAECONNABORTED=Libc.ECONNABORTED;
   WSAECONNRESET=Libc.ECONNRESET;
   WSAENOBUFS=Libc.ENOBUFS;
   WSAEISCONN=Libc.EISCONN;
   WSAENOTCONN=Libc.ENOTCONN;
   WSAESHUTDOWN=Libc.ESHUTDOWN;
   WSAETOOMANYREFS=Libc.ETOOMANYREFS;
   WSAETIMEDOUT=Libc.ETIMEDOUT;
   WSAECONNREFUSED=Libc.ECONNREFUSED;
   WSAELOOP=Libc.ELOOP;
   WSAENAMETOOLONG=Libc.ENAMETOOLONG;
   WSAEHOSTDOWN=Libc.EHOSTDOWN;
   WSAEHOSTUNREACH=Libc.EHOSTUNREACH;
   WSAENOTEMPTY=Libc.ENOTEMPTY;
   WSAEPROCLIM=1000; // not applicable
   WSAEUSERS=Libc.EUSERS;
   WSAEDQUOT=Libc.EDQUOT;
   WSAESTALE=Libc.ESTALE;
   WSAEREMOTE=Libc.EREMOTE;
   WSASYSNOTREADY=1001; // not applicable
   WSAVERNOTSUPPORTED=1002; // not applicable
   WSANOTINITIALISED=1003; // not applicable
   WSAHOST_NOT_FOUND=Libc.HOST_NOT_FOUND;
   WSATRY_AGAIN=Libc.TRY_AGAIN;
   WSANO_RECOVERY=Libc.NO_RECOVERY;
   WSANO_DATA=Libc.ENODATA;
   WSAUNKNOWN=Libc.UNKNOWN_REQUEST;
   Socket_Error=Libc.SOCKET_ERROR;
{$ELSE}
Const
   INVALID_SOCKET=Winsock.INVALID_SOCKET;
   SO_KeepAlive=Winsock.SO_KEEPALIVE;
   WSAENOBUFS=Winsock.WSAENOBUFS;
   WSAETIMEDOUT=Winsock.WSAETIMEDOUT;
   WSAECONNABORTED=Winsock.WSAECONNABORTED;
   Socket_Error=Winsock.SOCKET_ERROR;
   WSAEWOULDBLOCK=Winsock.WSAEWOULDBLOCK;
   WSAECONNRESET=Winsock.WSAECONNRESET;
   WSAENOTSOCK=Winsock.WSAENOTSOCK;
Type
   PInteger=Windows.PInteger;
{$ENDIF}

{$IFDEF VER100}
type
  in_addr = TInAddr;
{$ENDIF}

Type
{$IFDEF LINUX}
   TSockAddrIn=Libc.TSockAddrin;
   TTimeVal=Libc.TTimeVal;
   TFDSet=Libc.TFDSet;
{$ELSE}
   TSockAddrIn=Winsock.TSockAddrIn;
   TTimeVal=Winsock.TTimeVal;
   TFDSet=Winsock.TFDSet;
{$ENDIF}
{$IFDEF USE_TPERSISTENT}
   TDXNewConnect=class(TPersistent)
   private
      fPort:Integer;
      fUseNAGLE:Boolean;
      fUseUDP:Boolean;
      fUseBlocking:Boolean;
      fipAddress:String;
   public
      constructor Create;
      destructor Destroy; override;
   published
      property Port:Integer read fPort write fPort;
      property UseNAGLE:Boolean read fUseNAGLE write fUseNAGLE;
      property UseUDP:Boolean read fUseUDP write fUseUDP;
      property UseBLOCKING:Boolean read fUseBlocking write fUseBlocking;
      property ipADDRESS:String read fipAddress write fipAddress;
   End;
{$ELSE}
   PNewConnect=^TNewConnect;
   TNewConnect=Record
      Port:Integer;
      UseNAGLE:Boolean;
      UseUDP:Boolean;
      UseBlocking:Boolean;
      ipAddress:String;
   End;
{$ENDIF}

   PNewListen=^TNewListen;
   TNewListen=Record
      Port:Integer;
      WinsockQueue:Integer;
      UseNAGLE:Boolean;
      UseUDP:Boolean;
      UseBlocking:Boolean;
      ConnectionLess:Boolean;
   End;

   PWinsockInfo=^TWinsockInfo; // 2.3 changed array from 0.. to 1..
   TWinsockInfo=Record
     Major_Version:Byte;                 {current version}
     Minor_Version:Byte;                 {current version}
     Highest_Major_Version:Byte;         {available on disk}
     Highest_Minor_Version:Byte;         {available on disk}
     Description:array[1..256] of Char;  // C++ Char Description[256];
     SystemStatus:array[1..128] of Char; // C++ Char Description[128];
     MaxSockets:Word;                    // C++ Unsigned short MaxSockets;
     MaxUDPDatagramSize:Word;            // C++ Unsigned short MaxUDPDatagramSize;
     VendorInfo:PChar;                   // C++ Char FAR * VendorInfo;
   End;

Const
   ConstSizeofTSockAddrIn=16;

Function CreateSocket(sin_family,socket_type,protocol:integer;
                      Var ErrorCode:Integer):TSocket;
Function ClientConnectToServer(ServerIPAddress:String;
                               ServerPort:Integer;
                               UseUDP,UseNAGLE:Boolean;
                               ResultSockAddr:PSockAddr;
                               Var ErrorCode:Integer):TSocket;
Function BindAndListen(BindToIPAddress:String;
                       BindToPort,WinsockQueue:Integer;
                       UseUDP,UseNAGLE,ConnectionLess:Boolean;
                       ResultSockAddr:PSockAddr;
                       Var ErrorCode:Integer):TSocket;
Function IsAcceptWaiting(ListenerSock:TSocket):Boolean;
Function AcceptNewConnect(ListenerSock:TSocket;
                          ResultAddr:PSockAddr;
                          ResultAddrlen:PInteger;
                          Var ErrorCode:Integer):TSocket;
Procedure CloseConnection(Var Sock:TSocket;
                          Gracefully:Boolean);
Function BasicSend(Sock:TSocket;
                   Var Buf;
                   Len:Integer;
                   Flags:Integer;
                   Var ErrorCode:Integer):Integer;
Function BasicRecv(Sock:TSocket;
                   Var Buf;
                   Len:Integer;
                   Flags:Integer;
                   Var ErrorCode:Integer):Integer;
Function UDPSend(Sock:TSocket;
                 Var Buf;
                 Len:Integer;
                 Flags:Integer;
                 SendTo:TSockAddr;
                 SendToSize:Integer;
                 Var ErrorCode:Integer):Integer;
Function UDPRecv(Sock:TSocket;
                 Var Buf;
                 Len:Integer;
                 Flags:Integer;
                 Var RcvFrom:TSockAddr;
                 Var RcvFromSize:Integer;
                 Var ErrorCode:Integer):Integer;
Function BasicPeek(Sock:TSocket;
                   Var Buf;
                   Len:Integer):Integer;
Function BasicSelect(Sock:TSocket;
                     CheckRead:Boolean;
                     Timeout:TTimeVal):Integer;
Procedure SetNagle(Sock:TSocket;
                   TurnOn:Boolean;
                   Var ErrorCode:Integer);
Procedure SetBlocking(Sock:TSocket;
                      UseBlocking:Boolean;
                      Var ErrorCode:Integer);
Procedure SetReceiveTimeout(Sock:TSocket;
                            TimeoutMS:Integer;
                            Var ErrorCode:Integer);
Procedure SetSendTimeout(Sock:TSocket;
                         TimeoutMS:Integer;
                         Var ErrorCode:Integer);
Procedure SetReceiveBuffer(Sock:TSocket;
                           WantedSize:Integer;
                           Var ErrorCode:Integer);
Procedure SetSendBuffer(Sock:TSocket;
                        WantedSize:Integer;
                        Var ErrorCode:Integer);
Procedure ResetBufferAndTimeout(Sock:TSocket;
                                TimeoutMS:Integer;
                                WantedSize:Integer);
Function GetReceiveBuffer(Sock:TSocket;
                          Var ErrorCode:Integer):Integer;
Function GetSendBuffer(Sock:TSocket;
                       Var ErrorCode:Integer):Integer;
Function GetSockStatusBool(Sock:TSocket;
                           SO_Flag:Integer;
                           Var ErrorCode:Integer):Boolean;
Function GetSockStatusInt(Sock:TSocket;
                          SO_Flag:Integer;
                          Var ErrorCode:Integer):Integer;
Procedure SetSockStatusBool(Sock:TSocket;
                           SO_Flag:Integer;
                           Setting:Boolean;
                           Var ErrorCode:Integer);
Procedure SetSockStatusInt(Sock:TSocket;
                          SO_Flag:Integer;
                          Setting:Integer;
                          Var ErrorCode:Integer);
Function CountWaiting(Sock:TSocket;
                      Var ErrorCode:Integer):Integer;
Function GetAddressCountByIP(IPAddress:String):Integer;
Function GetAddressCountByHost(Host:String):Integer;
Function GetIPAddressByHost(Host:String;Which:Integer):String;
Function GetHostByIPAddress(IPAddress:String):String;
Function GetLocalHostName:String;
function GetLocalPort(Sock:TSocket):Integer;
function GetLocalIPAddr(Sock:TSocket):string;
function GetLastError:Integer;
Function GetErrorDesc(ErrorCode:Integer):String;
function ByteSwap4(lng:Cardinal):Cardinal;
function ByteSwap2(shrt:smallint):smallint;
Function IPIntToIPStr(IPAddr:Integer):String;
Function IPStrToIPInt(IPAddr:String):Integer;
Function SocketLayerLoaded:Boolean;
Procedure GetSocketVersion(WinsockInfo:PWinsockInfo);
Function ntohs(netshort:Word):Word;
Function inet_ntoa(inaddr:in_addr):PChar;
Function htonl(Hostlong:Integer):Integer;
Function ntohl(Netlong:Integer):Integer;
//Function SetErrorCode(ResultCode:Integer):Integer;

Var
   GlobalTimeout:TTimeVal; //6-9

implementation

Uses
   DXString,
   SysUtils;

Var
{$IFNDEF LINUX}
   DLLData:TWSAData;
{$ENDIF}
   StartupResult:Integer;

Var
{$IFDEF LINUX}
   SizeOfInt:Cardinal=4; // optimize compiling
{$ELSE}
   SizeOfInt:Integer=4; // optimize compiling
{$ENDIF}

{$IFDEF ENGLISH1}
{$I Resource_English.inc}
{$ENDIF}
{$IFDEF FRENCH1}
{$I Resource_French.inc}
{$ENDIF}
{$IFDEF GERMAN1}
{$I Resource_German.inc}
{$ENDIF}
{$IFDEF ITALIAN1}
{$I Resource_Italian.inc}
{$ENDIF}
{$IFDEF LOWMEM1}
{$I Resource_LowMem.inc}
{$ENDIF}
{$IFDEF PORTUGUESE1}
{$I Resource_Portuguese.inc}
{$ENDIF}
{$IFDEF RUSSIAN1}
{$I Resource_Russian.inc}
{$ENDIF}
{$IFDEF SPANISH1}
{$I Resource_Spanish.inc}
{$ENDIF}
{$IFDEF TURKISH1}
{$I Resource_Turkish.inc}
{$ENDIF}

constructor TDXNewConnect.Create;
begin
   inherited Create;
   fPort:=0;
   fUseNAGLE:=True;
   fUseUDP:=False;
   fUseBlocking:=True;
   fipAddress:='127.0.0.1';
end;

destructor TDXNewConnect.Destroy;
begin
   inherited Destroy;
end;

{$IFDEF LINUX}
Function WSAGetLastError:Integer;
Begin
   Result:=System.GetLastError
End;
{$ENDIF}

Function CreateSocket(sin_family,socket_type,protocol:integer;
                      Var ErrorCode:Integer):TSocket;
Begin
   ErrorCode:=0;
         Result:={$IFDEF LINUX}Libc.
                 {$ELSE}Winsock.