Archivado/Componentes.Terceros.RemObjects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
e4d0fcb01d
Componentes.Terceros.RemObj.../official/5.0.35.741/RemObjects SDK for Delphi/Source/RODX/uRODXSocket.pas
david e4d0fcb01d Importación inicial 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
2009-02-27 15:16:56 +00:00

1154 lines
35 KiB
ObjectPascal
Raw Blame History

{$I uRODXSock.def}
unit uRODXSocket;
///////////////////////////////////////////////////////////////////////////////
// Unit: DXSocket
// Author: G.E. Ozz Nixon Jr. (onixon@dxsock.com)
// ========================================================================
// Source Owner: DX, Inc. 1995-2002
// 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 MSWINDOWS}
uses
Windows,
Winsock;
{$ENDIF}
{$IFNDEF MSWINDOWS}
uses
baseunix, sockets;
Const
TCP_NODELAY = 1;
INVALID_SOCKET = -1;
SO_KeepAlive=sockets.SO_KEEPALIVE;
WSAEINTR=ESysEINTR;
WSAEBADF=ESysEBADF;
WSAEACCES=ESysEACCES;
WSAEFAULT=ESysEFAULT;
WSAEINVAL=ESysEINVAL;
WSAEMFILE=ESysEMFILE;
WSAEWOULDBLOCK=ESysEWOULDBLOCK;
WSAEINPROGRESS=ESysEINPROGRESS;
WSAEALREADY=ESysEALREADY;
WSAENOTSOCK=ESysENOTSOCK;
WSAEDESTADDRREQ=ESysEDESTADDRREQ;
WSAEMSGSIZE=ESysEMSGSIZE;
WSAEPROTOTYPE=ESysEPROTOTYPE;
WSAENOPROTOOPT=ESysENOPROTOOPT;
WSAEPROTONOSUPPORT=ESysEPROTONOSUPPORT;
WSAESOCKTNOSUPPORT=ESysESOCKTNOSUPPORT;
WSAEOPNOTSUPP=ESysEOPNOTSUPP;
WSAEPFNOSUPPORT=ESysEPFNOSUPPORT;
WSAEAFNOSUPPORT=ESysEAFNOSUPPORT;
WSAEADDRINUSE=ESysEADDRINUSE;
WSAEADDRNOTAVAIL=ESysEADDRNOTAVAIL;
WSAENETDOWN=ESysENETDOWN;
WSAENETUNREACH=ESysENETUNREACH;
WSAENETRESET=ESysENETRESET;
WSAECONNABORTED=ESysECONNABORTED;
WSAECONNRESET=ESysECONNRESET;
WSAENOBUFS=ESysENOBUFS;
WSAEISCONN=ESysEISCONN;
WSAENOTCONN=ESysENOTCONN;
WSAESHUTDOWN=ESysESHUTDOWN;
WSAETOOMANYREFS=ESysETOOMANYREFS;
WSAETIMEDOUT=ESysETIMEDOUT;
WSAECONNREFUSED=ESysECONNREFUSED;
WSAELOOP=ESysELOOP;
WSAENAMETOOLONG=ESysENAMETOOLONG;
WSAEHOSTDOWN=ESysEHOSTDOWN;
WSAEHOSTUNREACH=ESysEHOSTUNREACH;
WSAENOTEMPTY=ESysENOTEMPTY;
WSAEPROCLIM=1000; // not applicable
WSAEUSERS=ESysEUSERS;
WSAEDQUOT=ESysEDQUOT;
WSAESTALE=ESysESTALE;
WSAEREMOTE=ESysEREMOTE;
WSASYSNOTREADY=1001; // not applicable
WSAVERNOTSUPPORTED=1002; // not applicable
WSANOTINITIALISED=1003; // not applicable
WSAHOST_NOT_FOUND=1;
WSATRY_AGAIN=2;
WSANO_RECOVERY=3;
WSANO_DATA=4;
WSAUNKNOWN=5;
Socket_Error=-1;
{$DEFINE USE_LIBC_functions}
{$IFDEF USE_LIBC_functions}
const clib = 'c';
type
Phostent = ^hostent;
hostent = record
h_name: PChar;
h_aliases: PPChar;
h_addrtype: Integer;
h_length: socklen_t;
case Byte of
0: (h_addr_list: PPChar);
1: (h_addr: PPChar);
end;
__socklen_t = dword;
function gethostbyaddr(__addr:pointer; __len:__socklen_t; __type:longint):Phostent;cdecl;external clib name 'gethostbyaddr';
function gethostbyname(__name:Pchar):Phostent;cdecl;external clib name 'gethostbyname';
{$ENDIF}
{$ENDIF}
{$IFDEF MSWINDOWS}
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;
// 7-27:
WSAEWOULDBLOCK=Winsock.WSAEWOULDBLOCK;
{$ENDIF}
{$IFDEF VER100}
type
in_addr = TInAddr;
{$ENDIF}
Type
{$IFNDEF MSWINDOWS}
TSockAddrIn = sockaddr;
TTimeVal = timeval;
// TFDSet=Libc.TFDSet;
{$ENDIF}
{$IFDEF MSWINDOWS}
TSockAddrIn=Winsock.TSockAddrIn;
TTimeVal=Winsock.TTimeVal;
TFDSet=Winsock.TFDSet;
{$ENDIF}
PNewConnect=^TNewConnect;
TNewConnect=Record
Port:Integer;
UseNAGLE:Boolean;
UseUDP:Boolean;
UseBlocking:Boolean;
ipAddress:AnsiString;
End;
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 AnsiChar; // C++ Char Description[256];
SystemStatus:array[1..128] of AnsiChar; // C++ Char Description[128];
MaxSockets:Word; // C++ Unsigned short MaxSockets;
MaxUDPDatagramSize:Word; // C++ Unsigned short MaxUDPDatagramSize;
VendorInfo:PAnsiChar; // C++ Char FAR * VendorInfo;
End;
Const
ConstSizeofTSockAddrIn=16;
Function CreateSocket(sin_family,socket_type,protocol:integer;
Var ErrorCode:Integer):TSocket;
Function ClientConnectToServer(ServerIPAddress:AnsiString;
ServerPort:Integer;
UseUDP,UseNAGLE:Boolean;
ResultSockAddr:PSockAddr;
Var ErrorCode:Integer):TSocket;
Function BindAndListen(BindToIPAddress:AnsiString;
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);
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:AnsiString):Integer;
Function GetAddressCountByHost(Host:AnsiString):Integer;
Function GetIPAddressByHost(Host:AnsiString;Which:Integer):AnsiString;
Function GetHostByIPAddress(IPAddress:AnsiString):AnsiString;
Function GetLocalHostName:AnsiString;
function GetLocalPort(Sock:TSocket):Integer;
function GetLocalIPAddr(Sock:TSocket):AnsiString;
function GetLastError:Integer;
Function GetErrorDesc(ErrorCode:Integer):AnsiString;
function ByteSwap4(long:Cardinal):Cardinal;
function ByteSwap2(short:smallint):smallint;
Function IPIntToIPStr(IPAddr:Integer):AnsiString;
Function IPStrToIPInt(IPAddr:AnsiString):Integer;
Function SocketLayerLoaded:Boolean;
Procedure GetSocketVersion(WinsockInfo:PWinsockInfo);
Function ntohs(netshort:Word):Word;
Function inet_ntoa(inaddr:in_addr):PAnsiChar;
Function htonl(Hostlong:Integer):Integer;
Function ntohl(Netlong:Integer):Integer;
Function SetErrorCode(ResultCode:Integer):Integer;
implementation
Uses
uRODXString,
SysUtils;
Var
{$IFDEF MSWINDOWS}
DLLData:TWSAData;
{$ENDIF}
StartupResult:Integer;
GlobalTimeout:TTimeVal; //6-9
Var
{$IFNDEF MSWINDOWS}
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}
{$IFNDEF MSWINDOWS}
Function WSAGetLastError:Integer;
Begin
Result:=fpGetErrno;
End;
{$ENDIF}
Function CreateSocket(sin_family,socket_type,protocol:integer;
Var ErrorCode:Integer):TSocket;
Begin
ErrorCode:=0;
// 7-27 Case StartupResult of
// 7-27 999:Begin
Result:={$IFNDEF MSWINDOWS}socket(sin_family,socket_type,protocol){$ENDIF}
{$IFDEF MSWINDOWS}Winsock.Socket(sin_family,socket_type,protocol){$ENDIF}
;
If Result=Invalid_Socket then ErrorCode:=WSAGetLastError;
// 7-27 End
// 7-27 Else Begin
// 7-27 Result:=Invalid_Socket;
// 7-27 ErrorCode:=WSANotInitialised;
// 7-27 End;
// 7-27 End;
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 AnsiChar;
Begin
If Not TurnOn then TA:='1111'
Else TA:='0000';
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpSetSockOpt(Sock,IPPROTO_TCP,TCP_NODELAY,@TA,SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}SetSockOpt(Sock,IPPROTO_TCP,TCP_NODELAY,@TA,SizeofInt){$ENDIF}
);
End;
Procedure SetBlocking(Sock:TSocket;
UseBlocking:Boolean;
Var ErrorCode:Integer);
{$IFNDEF MSWINDOWS}
Const
FIONBIO=$5421;
{$ENDIF}
Var
{$IFDEF VER90}
iBlocking:u_long;
{$ELSE}
iBlocking:Integer;
{$ENDIF}
Begin
If UseBlocking then iBlocking:=0
Else iBlocking:=1;
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpioctl(Sock,FIONBIO,@iBlocking){$ENDIF}
{$IFDEF MSWINDOWS}Winsock.ioctlsocket(Sock,FIONBIO,iBlocking){$ENDIF}
);
End;
Procedure SetReceiveTimeout(Sock:TSocket;
TimeoutMS:Integer;
Var ErrorCode:Integer);
Begin
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpsetsockopt(Sock,SOL_SOCKET,SO_RCVTIMEO,@TimeoutMS,SizeOfInt){$ENDIF}
{$IFDEF MSWINDOWS}setsockopt(Sock,SOL_SOCKET,SO_RCVTIMEO,@TimeoutMS,SizeOfInt){$ENDIF}
);
End;
Procedure SetSendTimeout(Sock:TSocket;
TimeoutMS:Integer;
Var ErrorCode:Integer);
Begin
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpsetsockopt(Sock,SOL_SOCKET,SO_SNDTIMEO,@TimeoutMS,SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}setsockopt(Sock,SOL_SOCKET,SO_SNDTIMEO,@TimeoutMS,SizeofInt){$ENDIF}
);
End;
Procedure SetReceiveBuffer(Sock:TSocket;
WantedSize:Integer;
Var ErrorCode:Integer);
Begin
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpsetsockopt(Sock,SOL_SOCKET,SO_RCVBUF,@WantedSize,SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}setsockopt(Sock,SOL_SOCKET,SO_RCVBUF,@WantedSize,SizeofInt){$ENDIF}
);
End;
Function GetSockStatusBool(Sock:TSocket;
SO_Flag:Integer;
Var ErrorCode:Integer):Boolean;
Var
Rslt:Boolean;
Begin
// 7-27
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpGetSockOpt(Sock,SOL_SOCKET,SO_Flag,@Rslt,@SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}GetSockOpt(Sock,SOL_SOCKET,SO_Flag,PAnsiChar(@Rslt),SizeofInt){$ENDIF}
);
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
// 7-27
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpGetSockOpt(Sock,SOL_SOCKET,SO_Flag,@Rslt,@SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}GetSockOpt(Sock,SOL_SOCKET,SO_Flag,PAnsiChar(@Rslt),SizeofInt){$ENDIF}
);
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(
{$IFNDEF MSWINDOWS}fpSetSockOpt(Sock,SOL_Socket,SO_Flag,@intval,SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}SetSockOpt(Sock,SOL_Socket,SO_Flag,@intval,SizeofInt){$ENDIF}
);
End;
Procedure SetSockStatusInt(Sock:TSocket;
SO_Flag:Integer;
Setting:Integer;
Var ErrorCode:Integer);
Begin
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpSetSockOpt(Sock,SOL_Socket,SO_Flag,@Setting,SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}SetSockOpt(Sock,SOL_Socket,SO_Flag,@Setting,SizeofInt){$ENDIF}
);
End;
Procedure SetSendBuffer(Sock:TSocket;
WantedSize:Integer;
Var ErrorCode:Integer);
Begin
ErrorCode:=SetErrorCode(
{$IFNDEF MSWINDOWS}fpsetsockopt(Sock,SOL_SOCKET,SO_SNDBUF,@WantedSize,SizeofInt){$ENDIF}
{$IFDEF MSWINDOWS}setsockopt(Sock,SOL_SOCKET,SO_SNDBUF,@WantedSize,SizeofInt){$ENDIF}
);
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);
{$IFNDEF MSWINDOWS}closeSocket(Sock);{$ENDIF}
{$IFDEF MSWINDOWS}CloseSocket(Sock);{$ENDIF}
Sock:=Invalid_Socket;
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;
Lin.l_linger:=0;
If Gracefully then Begin
Lin.l_onoff:=1; // Not(0);
{$IFNDEF MSWINDOWS}fpsetsockopt(Sock,SOL_SOCKET,SO_LINGER,@lin,Sizeof(Lin));{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.setsockopt(Sock,SOL_SOCKET,SO_LINGER,@lin,Sizeof(Lin));{$ENDIF}
End
Else Begin
Lin.l_onoff:=0;
{$IFNDEF MSWINDOWS}fpsetsockopt(Sock,SOL_SOCKET,SO_LINGER,@lin,sizeof(lin));{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.setsockopt(Sock,SOL_SOCKET,SO_LINGER,@lin,sizeof(lin));{$ENDIF}
End;
// DoSleepEx(0);
KillSocket(Sock);
End;
{$IFDEF MSWINDOWS}
function CheckForSocketError(ResultCode:Integer):Boolean;
begin
Result := ResultCode = SOCKET_ERROR;
end;
{$ENDIF}
{$IFNDEF MSWINDOWS}
function CheckForSocketError(ResultCode: Boolean):Boolean;
begin
Result := ResultCode = False;
end;
{$ENDIF}
Function ClientConnectToServer(ServerIPAddress:AnsiString;
ServerPort:Integer;
UseUDP,UseNAGLE:Boolean;
ResultSockAddr:PSockAddr;
Var ErrorCode:Integer):TSocket;
{$IFNDEF MSWINDOWS}
Const
SOCK_dgram=2;
SOCK_stream=1;
{$ENDIF}
begin
Result:=Invalid_Socket;
If ServerIPAddress='' then Exit;
ServerIPAddress:=FixDottedIp(ServerIPAddress);
FillChar(ResultSockAddr^,Sizeof(ResultSockAddr^),#0);
ResultSockAddr.sin_family:=AF_INET;
ResultSockAddr.sin_port:=htons(ServerPort);
{$IFNDEF MSWINDOWS}
ResultSockAddr.sin_addr.S_addr:= StrToNetAddr(ServerIPAddress).s_addr;
{$ENDIF}
{$IFDEF MSWINDOWS}
ResultSockAddr.sin_addr.S_addr:=Inet_Addr(PAnsichar(ServerIPAddress));
{$ENDIF}
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;
SetSendTimeout(Result,5000,ErrorCode);
If CheckForSocketError(Connect(Result,ResultSockAddr^,ConstSizeofTSockAddrIn)) then begin
ErrorCode:=WSAGetLastError;
KillSocket(Result);
End;
end;
Function BindAndListen(BindToIPAddress:AnsiString;
BindToPort,WinsockQueue:Integer;
UseUDP,UseNAGLE,ConnectionLess:Boolean;
ResultSockAddr:PSockAddr;
Var ErrorCode:Integer):TSocket;
{$IFNDEF MSWINDOWS}
Const
SOCK_dgram=2;
SOCK_stream=1;
{$ENDIF}
begin
FillChar(ResultSockAddr^,Sizeof(ResultSockAddr^),#0); // DO ! USE ZEROMEMORY
// 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);
// 7-27
if (length(BindToIPAddress)<7) then
ResultSockAddr.sin_addr.S_addr:=INADDR_ANY
else
{$IFNDEF MSWINDOWS}
ResultSockAddr.sin_addr.S_addr:=StrToNetAddr(BindToIPAddress).s_addr;
{$ENDIF}
{$IFDEF MSWINDOWS}
ResultSockAddr.sin_addr.S_addr:=Inet_Addr(PAnsiChar(BindToIPAddress));
{$ENDIF}
If CheckForSocketError(Bind(Result,ResultSockAddr^,ConstSizeofTSockAddrIn)) then Begin
Result:=Invalid_Socket;
ErrorCode:=WSAGetLastError;
Exit;
End;
// 7-27
If Not ConnectionLess then
If CheckForSocketError(Listen(Result,WinsockQueue)) then Begin
Result:=Invalid_Socket;
ErrorCode:=WSAGetLastError;
End;
End;
Function IsAcceptWaiting(ListenerSock:TSocket):Boolean;
{$IFDEF MSWINDOWS}
Var
SockList:TFDSet;
{$ENDIF}
Begin
{$IFNDEF MSWINDOWS}
Result:=BasicSelect(ListenerSock,True,GlobalTimeout)>0;
{$ELSE}
SockList.fd_count:=1;
SockList.fd_array[0]:=ListenerSock;
Result:=Select(0,@sockList,nil,nil,@GlobalTimeout)>0;
{$ENDIF}
End;
Function AcceptNewConnect(ListenerSock:TSocket;
ResultAddr:PSockAddr;
ResultAddrlen:PInteger;
Var ErrorCode:Integer):TSocket;
Begin
Result:={$IFNDEF MSWINDOWS}Accept(ListenerSock,ResultAddr^,ResultAddrLen^);{$ENDIF}
{$IFDEF MSWINDOWS}
{$IFDEF VER90}
Winsock.Accept(ListenerSock,ResultAddr^,ResultAddrLen^);
{$ELSE}
Winsock.Accept(ListenerSock,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:=Socket_Error;
// ErrorCode:=WSAEINTR;
// While (Result<0) and ((ErrorCode=WSAEINTR) or (ErrorCode=WSAETIMEDOUT)) do Begin
Result:=Send(Sock,Buf,Len,Flags);
ErrorCode:=SetErrorCode(Result);
// End;
End;
Function UDPSend(Sock:TSocket;
Var Buf;
Len:Integer;
Flags:Integer;
SendTo:TSockAddr;
SendToSize:Integer;
Var ErrorCode:Integer):Integer;
Begin
Result:={$IFNDEF MSWINDOWS}fpSendTo(Sock,@Buf,Len,Flags,@SendTo,SendToSize);{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.SendTo(Sock,Buf,Len,Flags,SendTo,SendToSize);{$ENDIF}
ErrorCode:=SetErrorCode(Result);
End;
Function BasicRecv(Sock:TSocket;
Var Buf;
Len:Integer;
Flags:Integer;
Var ErrorCode:Integer):Integer;
Begin
// 7-27 If Sock<>Invalid_Socket then Begin
Result:=Recv(Sock,Buf,Len,Flags);
ErrorCode:=SetErrorCode(Result);
// 7-27 End
// 7-27 Else Result:=0;
End;
Function UDPRecv(Sock:TSocket;
Var Buf;
Len:Integer;
Flags:Integer;
Var RcvFrom:TSockAddr;
Var RcvFromSize:Integer;
Var ErrorCode:Integer):Integer;
Begin
// 7-27 If Sock<>Invalid_Socket then Begin
Result:={$IFNDEF MSWINDOWS}recvfrom(Sock,Buf,Len,Flags,RcvFrom,RcvFromSize);{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.recvfrom(Sock,Buf,Len,Flags,RcvFrom,RcvFromSize);{$ENDIF}
ErrorCode:=SetErrorCode(Result);
// 7-27 End
// 7-27 Else Result:=0;
End;
Function BasicPeek(Sock:TSocket;
Var Buf;
Len:Integer):Integer;
Begin
// 7-27 If Sock<>Invalid_Socket then Begin
Result:=Recv(Sock, Buf, Len, MSG_PEEK);
// 7-27 End
// 7-27 Else Result:=Socket_Error;
End;
Function BasicSelect(Sock:TSocket;
CheckRead:Boolean;
Timeout:TTimeVal):Integer;
var
SockList: TFDSet;
Begin
{$IFNDEF MSWINDOWS}
fpFD_ZERO(SockList);
SockList[0]:=Sock;
If CheckRead then
Result:=fpSelect(1,@SockList,nil,nil,@Timeout)
Else
Result:=fpSelect(1,nil,@SockList,nil,@Timeout);
{$ENDIF}
{$IFDEF MSWINDOWS}
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;
{$IFNDEF MSWINDOWS}
Const
FIONREAD=$541B;
{$ENDIF}
var
numWaiting:longint;
begin
Result:=0;
// in linux IOCtl is used to "set" not "get" values.
ErrorCode:=SetErrorCode({$IFNDEF MSWINDOWS}fpIOCtl(Sock,FIONREAD,@numWaiting));{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.IOCtlSocket(Sock,FIONREAD,numWaiting));{$ENDIF}
If ErrorCode=0 then Result:=numWaiting;
end;
Function GetAddressCountByIP(IPAddress:AnsiString):Integer;
Var
HostEnt:PHostEnt;
{$IFDEF MSWINDOWS}
InAddr: integer;
{$ENDIF}
{$IFNDEF MSWINDOWS}
InAddr:cuint32;
{$ENDIF}
Begin
IPAddress:=FixDottedIp(IPAddress);
{$IFDEF MSWINDOWS}
InAddr:=inet_addr(PAnsiChar(IPAddress));
{$ENDIF}
{$IFNDEF MSWINDOWS}
InAddr:=StrToNetAddr(IPAddress).s_addr;
{$ENDIF}
{$WARNINGS OFF}
HostEnt:=gethostbyaddr(@InAddr,Length(IPAddress),AF_INET);
If Assigned(HostEnt) then Result:=HostEnt.h_length div 4
Else Result:=0;
{$WARNINGS ON}
End;
Function GetAddressCountByHost(Host:AnsiString):Integer;
Var
HostEnt:PHostEnt;
Begin
// 7-27 if Host='' then Begin
// 7-27 Result:=0;
// 7-27 Exit;
// 7-27 End;
HostEnt:=gethostbyname(PAnsiChar(Host));
// 7-27
If Assigned(HostEnt) then Result:=GetAddressCountByIP(HostEnt.h_addr^)
Else Result:=0;
End;
Function GetIPAddressByHost(Host:AnsiString;Which:Integer):AnsiString;
Var
HostEnt:PHostEnt;
iAddr:Integer;
Begin
// 7-27 if (Host='') or (Which<1) then Begin
// 7-27 Result:='';
// 7-27 Exit;
// 7-27 End;
HostEnt:=gethostbyname(PAnsiChar(Host));
If Assigned(HostEnt) then Begin
If Which<=(HostEnt.h_length div 4) then Begin
Move(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:AnsiString):AnsiString;
Var
HostEnt:PHostEnt;
{$IFDEF MSWINDOWS}
InAddr: integer;
{$ENDIF}
{$IFNDEF MSWINDOWS}
InAddr:cuint32;
{$ENDIF}
Begin
IPAddress:=FixDottedIp(IPAddress);
{$IFDEF MSWINDOWS}
InAddr:=inet_addr(PAnsiChar(IPAddress));
{$ENDIF}
{$IFNDEF MSWINDOWS}
InAddr:=StrToNetAddr(IPAddress).s_addr;
{$ENDIF}
{$WARNINGS OFF}
HostEnt:=gethostbyaddr(@InAddr,Length(IPAddress),AF_INET);
If Assigned(HostEnt) then Result:=StrPas(HostEnt.h_name)
Else Result:='';
{$WARNINGS ON}
End;
Function GetLocalHostName:AnsiString;
Begin
Result:=GetHostByIPAddress(
GetIPAddressByHost('localhost',1));
If Result='' then Result:='Localhost';
End;
function GetLocalPort(Sock:TSocket):Integer;
var
addr: TSockAddrIn;
{$IFNDEF MSWINDOWS}
addrlen: cardinal;
{$ENDIF}
{$IFDEF MSWINDOWS}
addrlen: integer;
{$ENDIF}
begin
addrlen:=ConstSizeofTSockAddrIn;
{$IFDEF MSWINDOWS}
if getsockname(Sock,addr,addrlen)=0 then
{$ENDIF}
{$IFNDEF MSWINDOWS}
if fpgetsockname(Sock,@addr,@addrlen)=0 then
{$ENDIF}
Result:=ntohs(addr.sin_port)
else Result := 0;
end;
function GetLocalIPAddr(Sock:TSocket):AnsiString;
var
addr: TSockAddrIn;
{$IFNDEF MSWINDOWS}
addrlen: cardinal;
{$ENDIF}
{$IFDEF MSWINDOWS}
addrlen: integer;
{$ENDIF}
begin
addrlen:=ConstSizeofTSockAddrIn;
FillChar(Addr,Sizeof(TSockAddrIn),#0);
{$IFNDEF MSWINDOWS}
fpgetsockname(Sock,@addr,@addrlen);
{$ENDIF}
{$IFDEF MSWINDOWS}
getsockname(Sock,addr,addrlen);
{$ENDIF}
Result:=inet_ntoa(addr.sin_addr);
end;
Procedure GetRemoteSockAddr(Sock:TSocket;
ResultAddr:PSockAddr;
ResultAddrlen:PInteger;
Var ErrorCode:Integer);
{$IFNDEF MSWINDOWS}
Var
TmpAddrLen:LongInt;
{$ENDIF}
Begin
{$IFNDEF MSWINDOWS}
ErrorCode:=SetErrorCode(getpeername(Sock,ResultAddr^,TmpAddrlen));
ResultAddrLen^:=TmpAddrLen;
{$ENDIF}
{$IFDEF MSWINDOWS}
ErrorCode:=SetErrorCode(getpeername(Sock,ResultAddr^,ResultAddrlen^));
{$ENDIF}
End;
function GetLastError:Integer;
Begin
Result:=WSAGetLastError;
End;
Function GetErrorDesc(errorCode:Integer):AnsiString;
var
r: string;
begin
// If you compile and get "Undeclared Identified -
// Edit DXSock.DEF - and select a language!
case errorCode of
WSAEINTR:R:=_WSAEINTR;
WSAEBADF:R:=_WSAEBADF;
WSAEACCES:R:=_WSAEACCES;
WSAEFAULT:R:=_WSAEFAULT;
WSAEINVAL:R:=_WSAEINVAL;
WSAEMFILE:R:=_WSAEMFILE;
WSAEWOULDBLOCK:R:=_WSAEWOULDBLOCK;
WSAEINPROGRESS:R:=_WSAEINPROGRESS;
WSAEALREADY:R:=_WSAEALREADY;
WSAENOTSOCK:R:=_WSAENOTSOCK;
WSAEDESTADDRREQ:R:=_WSAEDESTADDRREQ;
WSAEMSGSIZE:R:=_WSAEMSGSIZE;
WSAEPROTOTYPE:R:=_WSAEPROTOTYPE;
WSAENOPROTOOPT:R:=_WSAENOPROTOOPT;
WSAEPROTONOSUPPORT:R:=_WSAEPROTONOSUPPORT;
WSAESOCKTNOSUPPORT:R:=_WSAESOCKTNOSUPPORT;
WSAEOPNOTSUPP:R:=_WSAEOPNOTSUPP;
WSAEPFNOSUPPORT:R:=_WSAEPFNOSUPPORT;
WSAEAFNOSUPPORT:R:=_WSAEAFNOSUPPORT;
WSAEADDRINUSE:R:=_WSAEADDRINUSE;
WSAEADDRNOTAVAIL:R:=_WSAEADDRNOTAVAIL;
WSAENETDOWN:R:=_WSAENETDOWN;
WSAENETUNREACH:R:=_WSAENETUNREACH;
WSAENETRESET:R:=_WSAENETRESET;
WSAECONNABORTED:R:=_WSAECONNABORTED;
WSAECONNRESET:R:=_WSAECONNRESET;
WSAENOBUFS:R:=_WSAENOBUFS;
WSAEISCONN:R:=_WSAEISCONN;
WSAENOTCONN:R:=_WSAENOTCONN;
WSAESHUTDOWN:R:=_WSAESHUTDOWN;
WSAETOOMANYREFS:R:=_WSAETOOMANYREFS;
WSAETIMEDOUT:R:=_WSAETIMEDOUT;
WSAECONNREFUSED:R:=_WSAECONNREFUSED;
WSAELOOP:R:=_WSAELOOP;
WSAENAMETOOLONG:R:=_WSAENAMETOOLONG;
WSAEHOSTDOWN:R:=_WSAEHOSTDOWN;
WSAEHOSTUNREACH:R:=_WSAEHOSTUNREACH;
WSAENOTEMPTY:R:=_WSAENOTEMPTY;
WSAEPROCLIM:R:=_WSAEPROCLIM;
WSAEUSERS:R:=_WSAEUSERS;
WSAEDQUOT:R:=_WSAEDQUOT;
WSAESTALE:R:=_WSAESTALE;
WSAEREMOTE:R:=_WSAEREMOTE;
WSASYSNOTREADY:R:=_WSASYSNOTREADY;
WSAVERNOTSUPPORTED:R:=_WSAVERNOTSUPPORTED;
WSANOTINITIALISED:R:=_WSANOTINITIALISED;
WSAHOST_NOT_FOUND:R:=_WSAHOST_NOT_FOUND;
WSATRY_AGAIN:R:=_WSATRY_AGAIN;
WSANO_RECOVERY:R:=_WSANO_RECOVERY;
{$IFDEF MSWINDOWS}
WSANO_DATA:R:=_WSANO_DATA;
{$ENDIF}
Else R:=_WSAUNKNOWN+' ('+IntToCommaStr(ErrorCode)+')';
end;
// message in the native Ansi so
Result := {$IFDEF UNICODE}WideStringToAnsiString{$ENDIF}(R);
end;
function ByteSwap4(long:Cardinal):Cardinal;
begin
result:=ntohl(long);
end;
function ByteSwap2(short:smallint):smallint;
begin
result:=ntohs(short);
end;
Function IPIntToIPStr(IPAddr:Integer):AnsiString;
Var
Ws:AnsiString;
Begin
Setlength(Ws,4);
Move(IPAddr,Ws[1],4);
Result:=
Ansi_IntToStr(Ord(Ws[1]))+'.'+
Ansi_IntToStr(Ord(Ws[2]))+'.'+
Ansi_IntToStr(Ord(Ws[3]))+'.'+
Ansi_IntToStr(Ord(Ws[4]));
End;
Function IPStrToIPInt(IPAddr:AnsiString):Integer;
function _getChar(AValue: Ansistring): AnsiChar;
begin
Result :=AnsiChar(Ansi_StrToInt(AValue));
end;
Var
Ws:AnsiString;
Begin
Setlength(Ws,4);
Ws[1]:=_getChar(FetchByChar(IPAddr,'.',False));
Ws[2]:=_getChar(FetchByChar(IPAddr,'.',False));
Ws[3]:=_getChar(FetchByChar(IPAddr,'.',False));
Ws[4]:=_getChar(FetchByChar(IPAddr,'.',False));
Move(Ws[1],Result,4);
End;
Function SocketLayerLoaded:Boolean;
Begin
Result:=(StartupResult=999);
End;
Procedure GetSocketVersion(WinsockInfo:PWinsockInfo);
Begin
{$IFNDEF MSWINDOWS}
With WinsockInfo^ do Begin
Major_Version:=2;
Minor_Version:=0;
Highest_Major_Version:=2;
Highest_Minor_Version:=0;
Move('Linux Socket Layer 2.0',Description,256);
Move('Ready',SystemStatus,128);
MaxSockets:=65000;
MaxUDPDatagramSize:=1500;
VendorInfo:='Brain Patchwork DX, LLC.';
End;
{$ENDIF}
{$IFDEF MSWINDOWS}
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);
Move(DllData.szDescription,Description,256);
Move(DllData.szSystemStatus,SystemStatus,128);
MaxSockets:=DllData.iMaxSockets;
MaxUDPDatagramSize:=DllData.iMaxUdpDg;
VendorInfo:=DllData.lpVendorInfo;
End;
{$ENDIF}
End;
Function ntohs(netshort:Word):Word;
Begin
Result:={$IFNDEF MSWINDOWS}sockets.ntohs(Netshort);{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.ntohs(Netshort);{$ENDIF}
End;
Function inet_ntoa(inaddr:in_addr):PAnsiChar;
Begin
Result:={$IFNDEF MSWINDOWS}PAnsiChar(NetAddrToStr(inaddr));{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.inet_ntoa(inaddr);{$ENDIF}
End;
Function htonl(Hostlong:Integer):Integer;
Begin
Result:={$IFNDEF MSWINDOWS}sockets.htonl(Hostlong);{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.htonl(Hostlong);{$ENDIF}
End;
Function ntohl(Netlong:Integer):Integer;
Begin
Result:={$IFNDEF MSWINDOWS}sockets.ntohl(netlong);{$ENDIF}
{$IFDEF MSWINDOWS}Winsock.ntohl(netlong);{$ENDIF}
End;
initialization
{$IFNDEF MSWINDOWS}
StartupResult:=0;
{$ELSE}
StartupResult:=WSAStartup(MAKEBytesToWORD(2,2),DLLData);
{$ENDIF}
if StartupResult=0 then Begin
StartupResult:=999;
// 6-9: added to load 1 time.
GlobalTimeout.tv_Sec:=0;
GlobalTimeout.tv_uSec:=2500;
End
else StartupResult:=123;
finalization
{$IFDEF MSWINDOWS}
If StartupResult=999 then WSACleanup;
{$ENDIF}
End.
Reference in New Issue View Git Blame Copy Permalink