synapse/synsock.pas
geby 155969aef8 Release 24
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@51 7c85be65-684b-0410-a082-b2ed4fbef004
2008-04-24 07:07:45 +00:00

621 lines
21 KiB
ObjectPascal

{==============================================================================|
| Project : Delphree - Synapse | 002.001.000 |
|==============================================================================|
| Content: Socket Independent Platform Layer |
|==============================================================================|
| 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)2001. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{ Comment next line if you need dynamic loading of winsock under Windows
or any another DLL stack by CreateAlternate constructor of TBlockSocket Class.
if next line stay uncommented, is used static mapping. This is fater method.
Under Linx is always used static maping to Libc. }
{$DEFINE STATICWINSOCK}
unit synsock;
interface
uses
{$IFDEF LINUX}
Libc, KernelIoctl;
{$ELSE}
Windows, WinSock;
{$ENDIF}
{$IFDEF LINUX}
const
WSAEINTR = EINTR;
WSAEBADF = EBADF;
WSAEACCES = EACCES;
WSAEFAULT = EFAULT;
WSAEINVAL = EINVAL;
WSAEMFILE = EMFILE;
WSAEWOULDBLOCK = EWOULDBLOCK;
WSAEINPROGRESS = EINPROGRESS;
WSAEALREADY = EALREADY;
WSAENOTSOCK = ENOTSOCK;
WSAEDESTADDRREQ = EDESTADDRREQ;
WSAEMSGSIZE = EMSGSIZE;
WSAEPROTOTYPE = EPROTOTYPE;
WSAENOPROTOOPT = ENOPROTOOPT;
WSAEPROTONOSUPPORT = EPROTONOSUPPORT;
WSAESOCKTNOSUPPORT = ESOCKTNOSUPPORT;
WSAEOPNOTSUPP = EOPNOTSUPP;
WSAEPFNOSUPPORT = EPFNOSUPPORT;
WSAEAFNOSUPPORT = EAFNOSUPPORT;
WSAEADDRINUSE = EADDRINUSE;
WSAEADDRNOTAVAIL = EADDRNOTAVAIL;
WSAENETDOWN = ENETDOWN;
WSAENETUNREACH = ENETUNREACH;
WSAENETRESET = ENETRESET;
WSAECONNABORTED = ECONNABORTED;
WSAECONNRESET = ECONNRESET;
WSAENOBUFS = ENOBUFS;
WSAEISCONN = EISCONN;
WSAENOTCONN = ENOTCONN;
WSAESHUTDOWN = ESHUTDOWN;
WSAETOOMANYREFS = ETOOMANYREFS;
WSAETIMEDOUT = ETIMEDOUT;
WSAECONNREFUSED = ECONNREFUSED;
WSAELOOP = ELOOP;
WSAENAMETOOLONG = ENAMETOOLONG;
WSAEHOSTDOWN = EHOSTDOWN;
WSAEHOSTUNREACH = EHOSTUNREACH;
WSAENOTEMPTY = ENOTEMPTY;
WSAEPROCLIM = -1;
WSAEUSERS = EUSERS;
WSAEDQUOT = EDQUOT;
WSAESTALE = ESTALE;
WSAEREMOTE = EREMOTE;
WSASYSNOTREADY = -2;
WSAVERNOTSUPPORTED = -3;
WSANOTINITIALISED = -4;
WSAEDISCON = -5;
WSAHOST_NOT_FOUND = HOST_NOT_FOUND;
WSATRY_AGAIN = TRY_AGAIN;
WSANO_RECOVERY = NO_RECOVERY;
// WSANO_DATA = NO_DATA;
WSANO_DATA = -6;
{$ELSE}
const
DLLStackName = 'wsock32.dll';
var
LibHandle: THandle = 0;
{$ENDIF}
{$IFDEF LINUX}
const
WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;
type
PWSAData = ^TWSAData;
TWSAData = packed record
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
DWORD = Integer;
TLinger = Linger;
{$ENDIF}
type
TWSAStartup = function(wVersionRequired: Word;
var WSData: TWSAData): Integer; stdcall;
TWSACleanup = function: Integer; stdcall;
TWSAGetLastError = function: Integer; stdcall;
TGetServByName = function(name, proto: PChar): PServEnt; stdcall;
TGetServByPort = function(port: Integer; proto: PChar): PServEnt; stdcall;
TGetProtoByName = function(name: PChar): PProtoEnt; stdcall;
TGetProtoByNumber = function(proto: Integer): PProtoEnt; stdcall;
TGetHostByName = function(name: PChar): PHostEnt; stdcall;
TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt; stdcall;
TGetHostName = function(name: PChar; len: Integer): Integer; stdcall;
TShutdown = function(s: TSocket; how: Integer): Integer; stdcall;
TSetSockOpt = function(s: TSocket; level, optname: Integer;
optval: PChar; optlen: Integer): Integer; stdcall;
TGetSockOpt = function(s: TSocket; level, optname: Integer;
optval: PChar; var optlen: Integer): Integer; stdcall;
TSendTo = function(s: TSocket; var Buf;
len, flags: Integer; var addrto: TSockAddr;
tolen: Integer): Integer; stdcall;
TSend = function(s: TSocket; var Buf;
len, flags: Integer): Integer; stdcall;
TRecv = function(s: TSocket;
var Buf; len, flags: Integer): Integer; stdcall;
TRecvFrom = function(s: TSocket;
var Buf; len, flags: Integer; var from: TSockAddr;
var fromlen: Integer): Integer; stdcall;
Tntohs = function(netshort: u_short): u_short; stdcall;
Tntohl = function(netlong: u_long): u_long; stdcall;
TListen = function(s: TSocket; backlog: Integer): Integer; stdcall;
TIoctlSocket = function(s: TSocket; cmd: DWORD;
var arg: u_long): Integer; stdcall;
TInet_ntoa = function(inaddr: TInAddr): PChar; stdcall;
TInet_addr = function(cp: PChar): u_long; stdcall;
Thtons = function(hostshort: u_short): u_short; stdcall;
Thtonl = function(hostlong: u_long): u_long; stdcall;
TGetSockName = function(s: TSocket; var name: TSockAddr;
var namelen: Integer): Integer; stdcall;
TGetPeerName = function(s: TSocket; var name: TSockAddr;
var namelen: Integer): Integer; stdcall;
TConnect = function(s: TSocket; var name: TSockAddr;
namelen: Integer): Integer; stdcall;
TCloseSocket = function(s: TSocket): Integer; stdcall;
TBind = function(s: TSocket; var addr: TSockAddr;
namelen: Integer): Integer; stdcall;
TAccept = function(s: TSocket; addr: PSockAddr;
addrlen: PInteger): TSocket; stdcall;
TSocketProc = function(af, Struc, Protocol: Integer): TSocket; stdcall;
TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
timeout: PTimeVal): Longint; stdcall;
var
WSAStartup: TWSAStartup = nil;
WSACleanup: TWSACleanup = nil;
WSAGetLastError: TWSAGetLastError = nil;
GetServByName: TGetServByName = nil;
GetServByPort: TGetServByPort = nil;
GetProtoByName: TGetProtoByName = nil;
GetProtoByNumber: TGetProtoByNumber = nil;
GetHostByName: TGetHostByName = nil;
GetHostByAddr: TGetHostByAddr = nil;
GetHostName: TGetHostName = nil;
Shutdown: TShutdown = nil;
SetSockOpt: TSetSockOpt = nil;
GetSockOpt: TGetSockOpt = nil;
SendTo: TSendTo = nil;
Send: TSend = nil;
Recv: TRecv = nil;
RecvFrom: TRecvFrom = nil;
ntohs: Tntohs = nil;
ntohl: Tntohl = nil;
Listen: TListen = nil;
IoctlSocket: TIoctlSocket = nil;
Inet_ntoa: TInet_ntoa = nil;
Inet_addr: TInet_addr = nil;
htons: Thtons = nil;
htonl: Thtonl = nil;
GetSockName: TGetSockName = nil;
GetPeerName: TGetPeerName = nil;
Connect: TConnect = nil;
CloseSocket: TCloseSocket = nil;
Bind: TBind = nil;
Accept: TAccept = nil;
Socket: TSocketProc = nil;
Select: TSelect = nil;
function InitSocketInterface(stack: string): Boolean;
function DestroySocketInterface: Boolean;
{$IFDEF LINUX}
function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; stdcall;
function LSWSACleanup: Integer; stdcall;
function LSWSAGetLastError: Integer; stdcall;
function LSGetServByName(name, proto: PChar): PServEnt; stdcall;
function LSGetServByPort(port: Integer; proto: PChar): PServEnt; stdcall;
function LSGetProtoByName(name: PChar): PProtoEnt; stdcall;
function LSGetProtoByNumber(proto: Integer): PProtoEnt; stdcall;
function LSGetHostByName(name: PChar): PHostEnt; stdcall;
function LSGetHostByAddr(addr: Pointer; len, Struc: Integer): PHostEnt; stdcall;
function LSGetHostName(name: PChar; len: Integer): Integer; stdcall;
function LSShutdown(s: TSocket; how: Integer): Integer; stdcall;
function LSSetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
optlen: Integer): Integer; stdcall;
function LSGetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
var optlen: Integer): Integer; stdcall;
function LSSendTo(s: TSocket; var Buf; len, flags: Integer;
var addrto: TSockAddr; tolen: Integer): Integer; stdcall;
function LSSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function LSRecv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function LSRecvFrom(s: TSocket; var Buf; len, flags: Integer;
var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
function LSntohs(netshort: u_short): u_short; stdcall;
function LSntohl(netlong: u_long): u_long; stdcall;
function LSListen(s: TSocket; backlog: Integer): Integer; stdcall;
function LSIoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer; stdcall;
function LSInet_ntoa(inaddr: TInAddr): PChar; stdcall;
function LSInet_addr(cp: PChar): u_long; stdcall;
function LShtons(hostshort: u_short): u_short; stdcall;
function LShtonl(hostlong: u_long): u_long; stdcall;
function LSGetSockName(s: TSocket; var name: TSockAddr;
var namelen: Integer): Integer; stdcall;
function LSGetPeerName(s: TSocket; var name: TSockAddr;
var namelen: Integer): Integer; stdcall;
function LSConnect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
function LSCloseSocket(s: TSocket): Integer; stdcall;
function LSBind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
function LSAccept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
function LSSocketProc(af, Struc, Protocol: Integer): TSocket; stdcall;
function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
timeout: PTimeVal): Longint; stdcall;
{$ENDIF}
implementation
{$IFNDEF LINUX}
{$IFNDEF STATICWINSOCK}
uses syncobjs;
var
SynSockCS: TCriticalSection;
SynSockCount: Integer = 0;
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX}
function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
begin
with WSData do
begin
wVersion := wVersionRequired;
wHighVersion := $101;
szDescription := 'Synapse Platform Independent Socket Layer';
szSystemStatus := 'On Linux';
iMaxSockets := 32768;
iMaxUdpDg := 8192;
end;
Result := 0;
end;
function LSWSACleanup: Integer;
begin
Result := 0;
end;
function LSWSAGetLastError: Integer;
begin
Result := System.GetLastError;
end;
function LSGetServByName(name, proto: PChar): PServEnt;
begin
Result := libc.GetServByName(name, proto);
end;
function LSGetServByPort(port: Integer; proto: PChar): PServEnt;
begin
Result := libc.GetServByPort(port, proto);
end;
function LSGetProtoByName(name: PChar): PProtoEnt;
begin
Result := libc.GetProtoByName(Name);
end;
function LSGetProtoByNumber(proto: Integer): PProtoEnt;
begin
Result := libc.GetProtoByNumber(proto);
end;
function LSGetHostByName(name: PChar): PHostEnt;
begin
Result := libc.GetHostByName(Name);
end;
function LSGetHostByAddr(addr: Pointer; len, Struc: Integer): PHostEnt;
begin
Result := libc.GetHostByAddr(Addr, len, struc);
end;
function LSGetHostName(name: PChar; len: Integer): Integer;
begin
Result := libc.GetHostName(Name, Len);
end;
function LSShutdown(s: TSocket; how: Integer): Integer;
begin
Result := libc.Shutdown(S, How);
end;
function LSSetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
optlen: Integer): Integer;
begin
Result := libc.SetSockOpt(S, Level, OptName, OptVal, OptLen);
end;
function LSGetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
var optlen: Integer): Integer;
begin
Result := libc.getsockopt(s, level, optname, optval, cardinal(optlen));
end;
function LSSendTo(s: TSocket; var Buf; len, flags: Integer;
var addrto: TSockAddr; tolen: Integer): Integer;
begin
Result := libc.SendTo(S, Buf, Len, Flags, Addrto, Tolen);
end;
function LSSend(s: TSocket; var Buf; len, flags: Integer): Integer;
begin
Result := libc.Send(S, Buf, Len, Flags);
end;
function LSRecv(s: TSocket; var Buf; len, flags: Integer): Integer;
begin
Result := libc.Recv(S, Buf, Len, Flags);
end;
function LSRecvFrom(s: TSocket; var Buf; len, flags: Integer;
var from: TSockAddr; var fromlen: Integer): Integer;
begin
Result := libc.RecvFrom(S, Buf, Len, Flags, @from, @fromlen);
end;
function LSntohs(netshort: u_short): u_short;
begin
Result := libc.NToHS(netshort);
end;
function LSntohl(netlong: u_long): u_long;
begin
Result := libc.NToHL(netlong);
end;
function LSListen(s: TSocket; backlog: Integer): Integer;
begin
Result := libc.Listen(S, Backlog);
end;
function LSIoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
begin
Result := libc.ioctl(s, cmd, @arg);
end;
function LSInet_ntoa(inaddr: TInAddr): PChar;
begin
Result := libc.inet_ntoa(inaddr);
end;
function LSInet_addr(cp: PChar): u_long;
begin
Result := libc.inet_addr(cp);
end;
function LShtons(hostshort: u_short): u_short;
begin
Result := libc.HToNs(HostShort);
end;
function LShtonl(hostlong: u_long): u_long;
begin
Result := libc.HToNL(HostLong);
end;
function LSGetSockName(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
begin
Result := libc.GetSockName(S, Name, cardinal(namelen));
end;
function LSGetPeerName(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
begin
Result := libc.GetPeerName(S, Name, cardinal(namelen));
end;
function LSConnect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer;
begin
Result := libc.Connect(S, name, namelen);
end;
function LSCloseSocket(s: TSocket): Integer;
begin
Result := libc.__close(s);
end;
function LSBind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer;
begin
Result := libc.Bind(S, addr, namelen);
end;
function LSAccept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket;
begin
Result := libc.Accept(S, addr, psocketlength(addrlen));
end;
function LSSocketProc(af, Struc, Protocol: Integer): TSocket;
begin
Result := libc.Socket(Af, Struc, Protocol);
end;
function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
timeout: PTimeVal): Longint;
begin
Result := libc.Select(nfds, readfds, writefds, exceptfds, timeout);
end;
{$ENDIF}
function InitSocketInterface(stack: string): Boolean;
begin
{$IFDEF LINUX}
Accept := LSAccept;
Bind := LSBind;
CloseSocket := LSCloseSocket;
Connect := LSConnect;
GetPeerName := LSGetPeerName;
GetSockName := LSGetSockName;
GetSockOpt := LSGetSockOpt;
Htonl := LShtonl;
Htons := LShtons;
Inet_Addr := LSinet_addr;
Inet_Ntoa := LSinet_ntoa;
IoctlSocket := LSioctlsocket;
Listen := LSlisten;
Ntohl := LSntohl;
Ntohs := LSntohs;
Recv := LSrecv;
RecvFrom := LSrecvfrom;
Select := LSselect;
Send := LSsend;
SendTo := LSsendto;
SetSockOpt := LSsetsockopt;
ShutDown := LSshutdown;
Socket := LSsocketProc;
GetHostByAddr := LSGetHostByAddr;
GetHostByName := LSGetHostByName;
GetProtoByName := LSGetProtoByName;
GetProtoByNumber := LSGetProtoByNumber;
GetServByName := LSGetServByName;
GetServByPort := LSGetServByPort;
GetHostName := LSGetHostName;
WSAGetLastError := LSWSAGetLastError;
WSAStartup := LSWSAStartup;
WSACleanup := LSWSACleanup;
Result := True;
{$ELSE}
{$IFDEF STATICWINSOCK}
Accept := Winsock.Accept;
Bind := Winsock.Bind;
CloseSocket := Winsock.CloseSocket;
Connect := Winsock.Connect;
GetPeerName := Winsock.GetPeerName;
GetSockName := Winsock.GetSockName;
GetSockOpt := Winsock.GetSockOpt;
Htonl := Winsock.htonl;
Htons := Winsock.htons;
Inet_Addr := Winsock.inet_addr;
Inet_Ntoa := Winsock.inet_ntoa;
IoctlSocket := Winsock.ioctlsocket;
Listen := Winsock.listen;
Ntohl := Winsock.ntohl;
Ntohs := Winsock.ntohs;
Recv := Winsock.recv;
RecvFrom := Winsock.recvfrom;
Select := Winsock.select;
Send := Winsock.send;
SendTo := Winsock.sendto;
SetSockOpt := Winsock.setsockopt;
ShutDown := Winsock.shutdown;
Socket := Winsock.socket;
GetHostByAddr := Winsock.GetHostByAddr;
GetHostByName := Winsock.GetHostByName;
GetProtoByName := Winsock.GetProtoByName;
GetProtoByNumber := Winsock.GetProtoByNumber;
GetServByName := Winsock.GetServByName;
GetServByPort := Winsock.GetServByPort;
GetHostName := Winsock.GetHostName;
WSAGetLastError := Winsock.WSAGetLastError;
WSAStartup := Winsock.WSAStartup;
WSACleanup := Winsock.WSACleanup;
Result := True;
{$ELSE}
Result := False;
if stack = '' then
stack := DLLStackName;
SynSockCS.Enter;
try
if SynSockCount = 0 then
begin
LibHandle := Windows.LoadLibrary(PChar(Stack));
if LibHandle <> 0 then
begin
Accept := Windows.GetProcAddress(LibHandle, PChar('accept'));
Bind := Windows.GetProcAddress(LibHandle, PChar('bind'));
CloseSocket := Windows.GetProcAddress(LibHandle, PChar('closesocket'));
Connect := Windows.GetProcAddress(LibHandle, PChar('connect'));
GetPeerName := Windows.GetProcAddress(LibHandle, PChar('getpeername'));
GetSockName := Windows.GetProcAddress(LibHandle, PChar('getsockname'));
GetSockOpt := Windows.GetProcAddress(LibHandle, PChar('getsockopt'));
Htonl := Windows.GetProcAddress(LibHandle, PChar('htonl'));
Htons := Windows.GetProcAddress(LibHandle, PChar('htons'));
Inet_Addr := Windows.GetProcAddress(LibHandle, PChar('inet_addr'));
Inet_Ntoa := Windows.GetProcAddress(LibHandle, PChar('inet_ntoa'));
IoctlSocket := Windows.GetProcAddress(LibHandle, PChar('ioctlsocket'));
Listen := Windows.GetProcAddress(LibHandle, PChar('listen'));
Ntohl := Windows.GetProcAddress(LibHandle, PChar('ntohl'));
Ntohs := Windows.GetProcAddress(LibHandle, PChar('ntohs'));
Recv := Windows.GetProcAddress(LibHandle, PChar('recv'));
RecvFrom := Windows.GetProcAddress(LibHandle, PChar('recvfrom'));
Select := Windows.GetProcAddress(LibHandle, PChar('select'));
Send := Windows.GetProcAddress(LibHandle, PChar('send'));
SendTo := Windows.GetProcAddress(LibHandle, PChar('sendto'));
SetSockOpt := Windows.GetProcAddress(LibHandle, PChar('setsockopt'));
ShutDown := Windows.GetProcAddress(LibHandle, PChar('shutdown'));
Socket := Windows.GetProcAddress(LibHandle, PChar('socket'));
GetHostByAddr := Windows.GetProcAddress(LibHandle, PChar('gethostbyaddr'));
GetHostByName := Windows.GetProcAddress(LibHandle, PChar('gethostbyname'));
GetProtoByName := Windows.GetProcAddress(LibHandle, PChar('getprotobyname'));
GetProtoByNumber := Windows.GetProcAddress(LibHandle, PChar('getprotobynumber'));
GetServByName := Windows.GetProcAddress(LibHandle, PChar('getservbyname'));
GetServByPort := Windows.GetProcAddress(LibHandle, PChar('getservbyport'));
GetHostName := Windows.GetProcAddress(LibHandle, PChar('gethostname'));
WSAGetLastError := Windows.GetProcAddress(LibHandle, PChar('WSAGetLastError'));
WSAStartup := Windows.GetProcAddress(LibHandle, PChar('WSAStartup'));
WSACleanup := Windows.GetProcAddress(LibHandle, PChar('WSACleanup'));
Result := True;
end;
end
else Result := True;
if Result then
Inc(SynSockCount);
finally
SynSockCS.Leave;
end;
{$ENDIF}
{$ENDIF}
end;
function DestroySocketInterface: Boolean;
begin
{$IFDEF LINUX}
{$ELSE}
{$IFNDEF STATICWINSOCK}
SynSockCS.Enter;
try
Dec(SynSockCount);
if SynSockCount < 0 then
SynSockCount := 0;
if SynSockCount = 0 then
if LibHandle <> 0 then
begin
Windows.FreeLibrary(libHandle);
LibHandle := 0;
end;
finally
SynSockCS.Leave;
end;
{$ENDIF}
{$ENDIF}
Result := True;
end;
{$IFNDEF LINUX}
{$IFNDEF STATICWINSOCK}
initialization
begin
SynSockCS:= TCriticalSection.Create;
end;
finalization
begin
SynSockCS.Free;
end;
{$ENDIF}
{$ENDIF}
end.