ssdotnet.pas

Synapse The synchronyous socket library. File content: 1.) About Synapse 2.) Distribution pa

  function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
  function  htons(hostshort: u_short): u_short;
  function  htonl(hostlong: u_long): u_long;
//  function  GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
  function  GetSockName(s: TSocket; var name: TVarSin): Integer;
//  function  GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
  function  GetPeerName(s: TSocket; var name: TVarSin): Integer;
//  function  Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
  function  Connect(s: TSocket; const name: TVarSin): Integer;
  function  CloseSocket(s: TSocket): Integer;
//  function  Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
  function  Bind(s: TSocket; const addr: TVarSin): Integer;
//  function  Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
  function  Accept(s: TSocket; var addr: TVarSin): TSocket;
  function  Socket(af, Struc, Protocol: Integer): TSocket;
//  Select = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
//    timeout: PTimeVal): Longint;
//    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};

//  TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
//    cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
//    lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
//    lpCompletionRoutine: pointer): u_int;
//    stdcall;

  function GetPortService(value: string): integer;

function IsNewApi(Family: TAddrFamily): Boolean;
function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
function GetSinIP(Sin: TVarSin): string;
function GetSinPort(Sin: TVarSin): Integer;
procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;

var
  SynSockCS: SyncObjs.TCriticalSection;
  SockEnhancedApi: Boolean;
  SockWship6Api: Boolean;

{==============================================================================}
implementation

threadvar
  WSALastError: integer;
  WSALastErrorDesc: string;

var
  services: Array [0..139, 0..1] of string =
  (
    ('echo', '7'),
    ('discard', '9'),
    ('sink', '9'),
    ('null', '9'),
    ('systat', '11'),
    ('users', '11'),
    ('daytime', '13'),
    ('qotd', '17'),
    ('quote', '17'),
    ('chargen', '19'),
    ('ttytst', '19'),
    ('source', '19'),
    ('ftp-data', '20'),
    ('ftp', '21'),
    ('telnet', '23'),
    ('smtp', '25'),
    ('mail', '25'),
    ('time', '37'),
    ('timeserver', '37'),
    ('rlp', '39'),
    ('nameserver', '42'),
    ('name', '42'),
    ('nickname', '43'),
    ('whois', '43'),
    ('domain', '53'),
    ('bootps', '67'),
    ('dhcps', '67'),
    ('bootpc', '68'),
    ('dhcpc', '68'),
    ('tftp', '69'),
    ('gopher', '70'),
    ('finger', '79'),
    ('http', '80'),
    ('www', '80'),
    ('www-http', '80'),
    ('kerberos', '88'),
    ('hostname', '101'),
    ('hostnames', '101'),
    ('iso-tsap', '102'),
    ('rtelnet', '107'),
    ('pop2', '109'),
    ('postoffice', '109'),
    ('pop3', '110'),
    ('sunrpc', '111'),
    ('rpcbind', '111'),
    ('portmap', '111'),
    ('auth', '113'),
    ('ident', '113'),
    ('tap', '113'),
    ('uucp-path', '117'),
    ('nntp', '119'),
    ('usenet', '119'),
    ('ntp', '123'),
    ('epmap', '135'),
    ('loc-srv', '135'),
    ('netbios-ns', '137'),
    ('nbname', '137'),
    ('netbios-dgm', '138'),
    ('nbdatagram', '138'),
    ('netbios-ssn', '139'),
    ('nbsession', '139'),
    ('imap', '143'),
    ('imap4', '143'),
    ('pcmail-srv', '158'),
    ('snmp', '161'),
    ('snmptrap', '162'),
    ('snmp-trap', '162'),
    ('print-srv', '170'),
    ('bgp', '179'),
    ('irc', '194'),
    ('ipx', '213'),
    ('ldap', '389'),
    ('https', '443'),
    ('mcom', '443'),
    ('microsoft-ds', '445'),
    ('kpasswd', '464'),
    ('isakmp', '500'),
    ('ike', '500'),
    ('exec', '512'),
    ('biff', '512'),
    ('comsat', '512'),
    ('login', '513'),
    ('who', '513'),
    ('whod', '513'),
    ('cmd', '514'),
    ('shell', '514'),
    ('syslog', '514'),
    ('printer', '515'),
    ('spooler', '515'),
    ('talk', '517'),
    ('ntalk', '517'),
    ('efs', '520'),
    ('router', '520'),
    ('route', '520'),
    ('routed', '520'),
    ('timed', '525'),
    ('timeserver', '525'),
    ('tempo', '526'),
    ('newdate', '526'),
    ('courier', '530'),
    ('rpc', '530'),
    ('conference', '531'),
    ('chat', '531'),
    ('netnews', '532'),
    ('readnews', '532'),
    ('netwall', '533'),
    ('uucp', '540'),
    ('uucpd', '540'),
    ('klogin', '543'),
    ('kshell', '544'),
    ('krcmd', '544'),
    ('new-rwho', '550'),
    ('new-who', '550'),
    ('remotefs', '556'),
    ('rfs', '556'),
    ('rfs_server', '556'),
    ('rmonitor', '560'),
    ('rmonitord', '560'),
    ('monitor', '561'),
    ('ldaps', '636'),
    ('sldap', '636'),
    ('doom', '666'),
    ('kerberos-adm', '749'),
    ('kerberos-iv', '750'),
    ('kpop', '1109'),
    ('phone', '1167'),
    ('ms-sql-s', '1433'),
    ('ms-sql-m', '1434'),
    ('wins', '1512'),
    ('ingreslock', '1524'),
    ('ingres', '1524'),
    ('l2tp', '1701'),
    ('pptp', '1723'),
    ('radius', '1812'),
    ('radacct', '1813'),
    ('nfsd', '2049'),
    ('nfs', '2049'),
    ('knetd', '2053'),
    ('gds_db', '3050'),
    ('man', '9535')
    );

{function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
begin
  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
             (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0));
end;

function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
begin
  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
             (a^.s_un_dw.s_dw3 = 0) and
             (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and
             (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1)));
end;

function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
begin
  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
end;

function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
begin
  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
end;

function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
begin
  Result := (a^.s_un_b.s_b1 = char($FF));
end;

function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
begin
  Result := (CompareMem( a, b, sizeof(TInAddr6)));
end;

procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
begin
  FillChar(a^, sizeof(TInAddr6), 0);
end;

procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
begin
  FillChar(a^, sizeof(TInAddr6), 0);
  a^.s_un_b.s_b16 := char(1);
end;
}

{=============================================================================}

procedure NullErr;
begin
  WSALastError := 0;
  WSALastErrorDesc := '';
end;

procedure GetErrCode(E: System.Exception);
var
  SE: System.Net.Sockets.SocketException;
begin
  if E is System.Net.Sockets.SocketException then
  begin
    SE := E as System.Net.Sockets.SocketException;
    WSALastError := SE.ErrorCode;
    WSALastErrorDesc := SE.Message;
  end
end;

function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
begin
  NullErr;
  with WSData do
  begin
    wVersion := wVersionRequired;
    wHighVersion := $202;
    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
    szSystemStatus := 'Running on .NET';
    iMaxSockets := 32768;
    iMaxUdpDg := 8192;
  end;
  Result := 0;
end;

function WSACleanup: Integer;
begin
  NullErr;
  Result := 0;
end;

function WSAGetLastError: Integer;
begin
  Result := WSALastError;
end;

function WSAGetLastErrorDesc: String;
begin
  Result := WSALastErrorDesc;
end;

function GetHostName: string;
begin
  Result := System.Net.DNS.GetHostName;
end;

function Shutdown(s: TSocket; how: Integer): Integer;
begin
  Result := 0;
  NullErr;
  try
    s.ShutDown(SocketShutdown(how));
  except
    on e: System.Net.Sockets.SocketException do
    begin
      GetErrCode(e);
      Result := integer(SOCKET_ERROR);
    end;
  end;
end;

function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
  optlen: Integer): Integer;
begin
  Result := 0;
  NullErr;
  try
    s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
  except
    on e: System.Net.Sockets.SocketException do
    begin
      GetErrCode(e);
      Result := integer(SOCKET_ERROR);
    end;
  end;
end;

function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
begin
  Result := 0;
  NullErr;
  try
    s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
  except
    on e: System.Net.Sockets.SocketException do
    begin
      GetErrCode(e);
      Result := integer(SOCKET_ERROR);
    end;
  end;
end;

function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
  var optlen: Integer): Integer;
begin
  Result := 0;
  NullErr;
  try
    s.GetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
  except
    on e: System.Net.Sockets.SocketException do
    begin
      GetErrCode(e);
      Result := integer(SOCKET_ERROR);
    end;
  end;
end;

function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
//function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
begin
  NullErr;
  try
    result := s.SendTo(Buf, len, SocketFlags(flags), addrto);
  except
    on e: System.Net.Sockets.SocketException do
    begin
      GetErrCode(e);
      Result := integer(SOCKET_ERROR);