Context Navigation

ssdotnet.pas

Last change on this file was 60, checked in by chronos, 12 years ago
Moved: Packages belongs to Demo instead of ChronisPlatform.
File size: 35.3 KB

Line
1	{==============================================================================\|
2	\| Project : Ararat Synapse \| 001.000.002 \|
3	\|==============================================================================\|
4	\| Content: Socket Independent Platform Layer - .NET definition include \|
5	\|==============================================================================\|
6	\| Copyright (c)2004, Lukas Gebauer \|
7	\| All rights reserved. \|
8	\| \|
9	\| Redistribution and use in source and binary forms, with or without \|
10	\| modification, are permitted provided that the following conditions are met: \|
11	\| \|
12	\| Redistributions of source code must retain the above copyright notice, this \|
13	\| list of conditions and the following disclaimer. \|
14	\| \|
15	\| Redistributions in binary form must reproduce the above copyright notice, \|
16	\| this list of conditions and the following disclaimer in the documentation \|
17	\| and/or other materials provided with the distribution. \|
18	\| \|
19	\| Neither the name of Lukas Gebauer nor the names of its contributors may \|
20	\| be used to endorse or promote products derived from this software without \|
21	\| specific prior written permission. \|
22	\| \|
23	\| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" \|
24	\| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \|
25	\| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \|
26	\| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR \|
27	\| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \|
28	\| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR \|
29	\| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER \|
30	\| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \|
31	\| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \|
32	\| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH \|
33	\| DAMAGE. \|
34	\|==============================================================================\|
35	\| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).\|
36	\| Portions created by Lukas Gebauer are Copyright (c)2004. \|
37	\| All Rights Reserved. \|
38	\|==============================================================================\|
39	\| Contributor(s): \|
40	\|==============================================================================\|
41	\| History: see HISTORY.HTM from distribution package \|
42	\| (Found at URL: http://www.ararat.cz/synapse/) \|
43	\|==============================================================================}
44
45	{:@exclude}
46
47	{$IFDEF CIL}
48
49	interface
50
51	uses
52	SyncObjs, SysUtils, Classes,
53	System.Net,
54	System.Net.Sockets;
55
56	const
57	DLLStackName = '';
58	WinsockLevel = $0202;
59
60	function InitSocketInterface(stack: string): Boolean;
61	function DestroySocketInterface: Boolean;
62
63	type
64	u_char = Char;
65	u_short = Word;
66	u_int = Integer;
67	u_long = Longint;
68	pu_long = ^u_long;
69	pu_short = ^u_short;
70	PSockAddr = IPEndPoint;
71	DWORD = integer;
72	ULong = cardinal;
73	TMemory = Array of byte;
74	TLinger = LingerOption;
75	TSocket = socket;
76	TAddrFamily = AddressFamily;
77
78	const
79	WSADESCRIPTION_LEN = 256;
80	WSASYS_STATUS_LEN = 128;
81	type
82	PWSAData = ^TWSAData;
83	TWSAData = packed record
84	wVersion: Word;
85	wHighVersion: Word;
86	szDescription: array[0..WSADESCRIPTION_LEN] of Char;
87	szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
88	iMaxSockets: Word;
89	iMaxUdpDg: Word;
90	// lpVendorInfo: PChar;
91	end;
92
93	const
94	MSG_NOSIGNAL = 0;
95	INVALID_SOCKET = nil;
96	AF_UNSPEC = AddressFamily.Unspecified;
97	AF_INET = AddressFamily.InterNetwork;
98	AF_INET6 = AddressFamily.InterNetworkV6;
99	SOCKET_ERROR = integer(-1);
100
101	FIONREAD = integer($4004667f);
102	FIONBIO = integer($8004667e);
103	FIOASYNC = integer($8004667d);
104
105	SOMAXCONN = integer($7fffffff);
106
107	IPPROTO_IP = ProtocolType.IP;
108	IPPROTO_ICMP = ProtocolType.Icmp;
109	IPPROTO_IGMP = ProtocolType.Igmp;
110	IPPROTO_TCP = ProtocolType.Tcp;
111	IPPROTO_UDP = ProtocolType.Udp;
112	IPPROTO_RAW = ProtocolType.Raw;
113	IPPROTO_IPV6 = ProtocolType.IPV6;
114	//
115	IPPROTO_ICMPV6 = ProtocolType.Icmp; //??
116
117	SOCK_STREAM = SocketType.Stream;
118	SOCK_DGRAM = SocketType.Dgram;
119	SOCK_RAW = SocketType.Raw;
120	SOCK_RDM = SocketType.Rdm;
121	SOCK_SEQPACKET = SocketType.Seqpacket;
122
123	SOL_SOCKET = SocketOptionLevel.Socket;
124	SOL_IP = SocketOptionLevel.Ip;
125
126
127	IP_OPTIONS = SocketOptionName.IPOptions;
128	IP_HDRINCL = SocketOptionName.HeaderIncluded;
129	IP_TOS = SocketOptionName.TypeOfService; { set/get IP Type Of Service }
130	IP_TTL = SocketOptionName.IpTimeToLive; { set/get IP Time To Live }
131	IP_MULTICAST_IF = SocketOptionName.MulticastInterface; { set/get IP multicast interface }
132	IP_MULTICAST_TTL = SocketOptionName.MulticastTimeToLive; { set/get IP multicast timetolive }
133	IP_MULTICAST_LOOP = SocketOptionName.MulticastLoopback; { set/get IP multicast loopback }
134	IP_ADD_MEMBERSHIP = SocketOptionName.AddMembership; { add an IP group membership }
135	IP_DROP_MEMBERSHIP = SocketOptionName.DropMembership; { drop an IP group membership }
136	IP_DONTFRAGMENT = SocketOptionName.DontFragment; { set/get IP Don't Fragment flag }
137
138	IPV6_UNICAST_HOPS = 8; // TTL
139	IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f
140	IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl
141	IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback
142	IPV6_JOIN_GROUP = 12; // add an IP group membership
143	IPV6_LEAVE_GROUP = 13; // drop an IP group membership
144
145	SO_DEBUG = SocketOptionName.Debug; { turn on debugging info recording }
146	SO_ACCEPTCONN = SocketOptionName.AcceptConnection; { socket has had listen() }
147	SO_REUSEADDR = SocketOptionName.ReuseAddress; { allow local address reuse }
148	SO_KEEPALIVE = SocketOptionName.KeepAlive; { keep connections alive }
149	SO_DONTROUTE = SocketOptionName.DontRoute; { just use interface addresses }
150	SO_BROADCAST = SocketOptionName.Broadcast; { permit sending of broadcast msgs }
151	SO_USELOOPBACK = SocketOptionName.UseLoopback; { bypass hardware when possible }
152	SO_LINGER = SocketOptionName.Linger; { linger on close if data present }
153	SO_OOBINLINE = SocketOptionName.OutOfBandInline; { leave received OOB data in line }
154	SO_DONTLINGER = SocketOptionName.DontLinger;
155	{ Additional options. }
156	SO_SNDBUF = SocketOptionName.SendBuffer; { send buffer size }
157	SO_RCVBUF = SocketOptionName.ReceiveBuffer; { receive buffer size }
158	SO_SNDLOWAT = SocketOptionName.SendLowWater; { send low-water mark }
159	SO_RCVLOWAT = SocketOptionName.ReceiveLowWater; { receive low-water mark }
160	SO_SNDTIMEO = SocketOptionName.SendTimeout; { send timeout }
161	SO_RCVTIMEO = SocketOptionName.ReceiveTimeout; { receive timeout }
162	SO_ERROR = SocketOptionName.Error; { get error status and clear }
163	SO_TYPE = SocketOptionName.Type; { get socket type }
164
165	{ WinSock 2 extension -- new options }
166	// SO_GROUP_ID = $2001; { ID of a socket group}
167	// SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
168	// SO_MAX_MSG_SIZE = $2003; { maximum message size }
169	// SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
170	// SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
171	// SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA;
172	// PVD_CONFIG = $3001; {configuration info for service provider }
173	{ Option for opening sockets for synchronous access. }
174	// SO_OPENTYPE = $7008;
175	// SO_SYNCHRONOUS_ALERT = $10;
176	// SO_SYNCHRONOUS_NONALERT = $20;
177	{ Other NT-specific options. }
178	// SO_MAXDG = $7009;
179	// SO_MAXPATHDG = $700A;
180	// SO_UPDATE_ACCEPT_CONTEXT = $700B;
181	// SO_CONNECT_TIME = $700C;
182
183
184	{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
185	WSABASEERR = 10000;
186
187	{ Windows Sockets definitions of regular Microsoft C error constants }
188
189	WSAEINTR = (WSABASEERR+4);
190	WSAEBADF = (WSABASEERR+9);
191	WSAEACCES = (WSABASEERR+13);
192	WSAEFAULT = (WSABASEERR+14);
193	WSAEINVAL = (WSABASEERR+22);
194	WSAEMFILE = (WSABASEERR+24);
195
196	{ Windows Sockets definitions of regular Berkeley error constants }
197
198	WSAEWOULDBLOCK = (WSABASEERR+35);
199	WSAEINPROGRESS = (WSABASEERR+36);
200	WSAEALREADY = (WSABASEERR+37);
201	WSAENOTSOCK = (WSABASEERR+38);
202	WSAEDESTADDRREQ = (WSABASEERR+39);
203	WSAEMSGSIZE = (WSABASEERR+40);
204	WSAEPROTOTYPE = (WSABASEERR+41);
205	WSAENOPROTOOPT = (WSABASEERR+42);
206	WSAEPROTONOSUPPORT = (WSABASEERR+43);
207	WSAESOCKTNOSUPPORT = (WSABASEERR+44);
208	WSAEOPNOTSUPP = (WSABASEERR+45);
209	WSAEPFNOSUPPORT = (WSABASEERR+46);
210	WSAEAFNOSUPPORT = (WSABASEERR+47);
211	WSAEADDRINUSE = (WSABASEERR+48);
212	WSAEADDRNOTAVAIL = (WSABASEERR+49);
213	WSAENETDOWN = (WSABASEERR+50);
214	WSAENETUNREACH = (WSABASEERR+51);
215	WSAENETRESET = (WSABASEERR+52);
216	WSAECONNABORTED = (WSABASEERR+53);
217	WSAECONNRESET = (WSABASEERR+54);
218	WSAENOBUFS = (WSABASEERR+55);
219	WSAEISCONN = (WSABASEERR+56);
220	WSAENOTCONN = (WSABASEERR+57);
221	WSAESHUTDOWN = (WSABASEERR+58);
222	WSAETOOMANYREFS = (WSABASEERR+59);
223	WSAETIMEDOUT = (WSABASEERR+60);
224	WSAECONNREFUSED = (WSABASEERR+61);
225	WSAELOOP = (WSABASEERR+62);
226	WSAENAMETOOLONG = (WSABASEERR+63);
227	WSAEHOSTDOWN = (WSABASEERR+64);
228	WSAEHOSTUNREACH = (WSABASEERR+65);
229	WSAENOTEMPTY = (WSABASEERR+66);
230	WSAEPROCLIM = (WSABASEERR+67);
231	WSAEUSERS = (WSABASEERR+68);
232	WSAEDQUOT = (WSABASEERR+69);
233	WSAESTALE = (WSABASEERR+70);
234	WSAEREMOTE = (WSABASEERR+71);
235
236	{ Extended Windows Sockets error constant definitions }
237
238	WSASYSNOTREADY = (WSABASEERR+91);
239	WSAVERNOTSUPPORTED = (WSABASEERR+92);
240	WSANOTINITIALISED = (WSABASEERR+93);
241	WSAEDISCON = (WSABASEERR+101);
242	WSAENOMORE = (WSABASEERR+102);
243	WSAECANCELLED = (WSABASEERR+103);
244	WSAEEINVALIDPROCTABLE = (WSABASEERR+104);
245	WSAEINVALIDPROVIDER = (WSABASEERR+105);
246	WSAEPROVIDERFAILEDINIT = (WSABASEERR+106);
247	WSASYSCALLFAILURE = (WSABASEERR+107);
248	WSASERVICE_NOT_FOUND = (WSABASEERR+108);
249	WSATYPE_NOT_FOUND = (WSABASEERR+109);
250	WSA_E_NO_MORE = (WSABASEERR+110);
251	WSA_E_CANCELLED = (WSABASEERR+111);
252	WSAEREFUSED = (WSABASEERR+112);
253
254	{ Error return codes from gethostbyname() and gethostbyaddr()
255	(when using the resolver). Note that these errors are
256	retrieved via WSAGetLastError() and must therefore follow
257	the rules for avoiding clashes with error numbers from
258	specific implementations or language run-time systems.
259	For this reason the codes are based at WSABASEERR+1001.
260	Note also that [WSA]NO_ADDRESS is defined only for
261	compatibility purposes. }
262
263	{ Authoritative Answer: Host not found }
264	WSAHOST_NOT_FOUND = (WSABASEERR+1001);
265	HOST_NOT_FOUND = WSAHOST_NOT_FOUND;
266	{ Non-Authoritative: Host not found, or SERVERFAIL }
267	WSATRY_AGAIN = (WSABASEERR+1002);
268	TRY_AGAIN = WSATRY_AGAIN;
269	{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
270	WSANO_RECOVERY = (WSABASEERR+1003);
271	NO_RECOVERY = WSANO_RECOVERY;
272	{ Valid name, no data record of requested type }
273	WSANO_DATA = (WSABASEERR+1004);
274	NO_DATA = WSANO_DATA;
275	{ no address, look for MX record }
276	WSANO_ADDRESS = WSANO_DATA;
277	NO_ADDRESS = WSANO_ADDRESS;
278
279	EWOULDBLOCK = WSAEWOULDBLOCK;
280	EINPROGRESS = WSAEINPROGRESS;
281	EALREADY = WSAEALREADY;
282	ENOTSOCK = WSAENOTSOCK;
283	EDESTADDRREQ = WSAEDESTADDRREQ;
284	EMSGSIZE = WSAEMSGSIZE;
285	EPROTOTYPE = WSAEPROTOTYPE;
286	ENOPROTOOPT = WSAENOPROTOOPT;
287	EPROTONOSUPPORT = WSAEPROTONOSUPPORT;
288	ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT;
289	EOPNOTSUPP = WSAEOPNOTSUPP;
290	EPFNOSUPPORT = WSAEPFNOSUPPORT;
291	EAFNOSUPPORT = WSAEAFNOSUPPORT;
292	EADDRINUSE = WSAEADDRINUSE;
293	EADDRNOTAVAIL = WSAEADDRNOTAVAIL;
294	ENETDOWN = WSAENETDOWN;
295	ENETUNREACH = WSAENETUNREACH;
296	ENETRESET = WSAENETRESET;
297	ECONNABORTED = WSAECONNABORTED;
298	ECONNRESET = WSAECONNRESET;
299	ENOBUFS = WSAENOBUFS;
300	EISCONN = WSAEISCONN;
301	ENOTCONN = WSAENOTCONN;
302	ESHUTDOWN = WSAESHUTDOWN;
303	ETOOMANYREFS = WSAETOOMANYREFS;
304	ETIMEDOUT = WSAETIMEDOUT;
305	ECONNREFUSED = WSAECONNREFUSED;
306	ELOOP = WSAELOOP;
307	ENAMETOOLONG = WSAENAMETOOLONG;
308	EHOSTDOWN = WSAEHOSTDOWN;
309	EHOSTUNREACH = WSAEHOSTUNREACH;
310	ENOTEMPTY = WSAENOTEMPTY;
311	EPROCLIM = WSAEPROCLIM;
312	EUSERS = WSAEUSERS;
313	EDQUOT = WSAEDQUOT;
314	ESTALE = WSAESTALE;
315	EREMOTE = WSAEREMOTE;
316
317
318	type
319	TVarSin = IPEndpoint;
320
321	{ function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
322	function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
323	function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
324	function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
325	function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
326	function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
327	procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
328	procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
329	var
330	in6addr_any, in6addr_loopback : TInAddr6;
331	}
332
333	{procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
334	function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
335	procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
336	procedure FD_ZERO(var FDSet: TFDSet);
337	}
338	{=============================================================================}
339
340	function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
341	function WSACleanup: Integer;
342	function WSAGetLastError: Integer;
343	function WSAGetLastErrorDesc: String;
344	function GetHostName: string;
345	function Shutdown(s: TSocket; how: Integer): Integer;
346	// function SetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
347	// optlen: Integer): Integer;
348	function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
349	optlen: Integer): Integer;
350	function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
351	function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
352	var optlen: Integer): Integer;
353	// function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
354	// tolen: Integer): Integer;
355	/// function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
356	/// function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
357	/// function Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
358	// function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
359	// var fromlen: Integer): Integer;
360	/// function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
361	function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
362	function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
363	function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
364	function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
365	function ntohs(netshort: u_short): u_short;
366	function ntohl(netlong: u_long): u_long;
367	function Listen(s: TSocket; backlog: Integer): Integer;
368	function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
369	function htons(hostshort: u_short): u_short;
370	function htonl(hostlong: u_long): u_long;
371	// function GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
372	function GetSockName(s: TSocket; var name: TVarSin): Integer;
373	// function GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
374	function GetPeerName(s: TSocket; var name: TVarSin): Integer;
375	// function Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
376	function Connect(s: TSocket; const name: TVarSin): Integer;
377	function CloseSocket(s: TSocket): Integer;
378	// function Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
379	function Bind(s: TSocket; const addr: TVarSin): Integer;
380	// function Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
381	function Accept(s: TSocket; var addr: TVarSin): TSocket;
382	function Socket(af, Struc, Protocol: Integer): TSocket;
383	// Select = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
384	// timeout: PTimeVal): Longint;
385	// {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};
386
387	// TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
388	// cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
389	// lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
390	// lpCompletionRoutine: pointer): u_int;
391	// stdcall;
392
393	function GetPortService(value: string): integer;
394
395	function IsNewApi(Family: TAddrFamily): Boolean;
396	function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
397	function GetSinIP(Sin: TVarSin): string;
398	function GetSinPort(Sin: TVarSin): Integer;
399	procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
400	function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
401	function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
402
403	var
404	SynSockCS: SyncObjs.TCriticalSection;
405	SockEnhancedApi: Boolean;
406	SockWship6Api: Boolean;
407
408	{==============================================================================}
409	implementation
410
411	threadvar
412	WSALastError: integer;
413	WSALastErrorDesc: string;
414
415	var
416	services: Array [0..139, 0..1] of string =
417	(
418	('echo', '7'),
419	('discard', '9'),
420	('sink', '9'),
421	('null', '9'),
422	('systat', '11'),
423	('users', '11'),
424	('daytime', '13'),
425	('qotd', '17'),
426	('quote', '17'),
427	('chargen', '19'),
428	('ttytst', '19'),
429	('source', '19'),
430	('ftp-data', '20'),
431	('ftp', '21'),
432	('telnet', '23'),
433	('smtp', '25'),
434	('mail', '25'),
435	('time', '37'),
436	('timeserver', '37'),
437	('rlp', '39'),
438	('nameserver', '42'),
439	('name', '42'),
440	('nickname', '43'),
441	('whois', '43'),
442	('domain', '53'),
443	('bootps', '67'),
444	('dhcps', '67'),
445	('bootpc', '68'),
446	('dhcpc', '68'),
447	('tftp', '69'),
448	('gopher', '70'),
449	('finger', '79'),
450	('http', '80'),
451	('www', '80'),
452	('www-http', '80'),
453	('kerberos', '88'),
454	('hostname', '101'),
455	('hostnames', '101'),
456	('iso-tsap', '102'),
457	('rtelnet', '107'),
458	('pop2', '109'),
459	('postoffice', '109'),
460	('pop3', '110'),
461	('sunrpc', '111'),
462	('rpcbind', '111'),
463	('portmap', '111'),
464	('auth', '113'),
465	('ident', '113'),
466	('tap', '113'),
467	('uucp-path', '117'),
468	('nntp', '119'),
469	('usenet', '119'),
470	('ntp', '123'),
471	('epmap', '135'),
472	('loc-srv', '135'),
473	('netbios-ns', '137'),
474	('nbname', '137'),
475	('netbios-dgm', '138'),
476	('nbdatagram', '138'),
477	('netbios-ssn', '139'),
478	('nbsession', '139'),
479	('imap', '143'),
480	('imap4', '143'),
481	('pcmail-srv', '158'),
482	('snmp', '161'),
483	('snmptrap', '162'),
484	('snmp-trap', '162'),
485	('print-srv', '170'),
486	('bgp', '179'),
487	('irc', '194'),
488	('ipx', '213'),
489	('ldap', '389'),
490	('https', '443'),
491	('mcom', '443'),
492	('microsoft-ds', '445'),
493	('kpasswd', '464'),
494	('isakmp', '500'),
495	('ike', '500'),
496	('exec', '512'),
497	('biff', '512'),
498	('comsat', '512'),
499	('login', '513'),
500	('who', '513'),
501	('whod', '513'),
502	('cmd', '514'),
503	('shell', '514'),
504	('syslog', '514'),
505	('printer', '515'),
506	('spooler', '515'),
507	('talk', '517'),
508	('ntalk', '517'),
509	('efs', '520'),
510	('router', '520'),
511	('route', '520'),
512	('routed', '520'),
513	('timed', '525'),
514	('timeserver', '525'),
515	('tempo', '526'),
516	('newdate', '526'),
517	('courier', '530'),
518	('rpc', '530'),
519	('conference', '531'),
520	('chat', '531'),
521	('netnews', '532'),
522	('readnews', '532'),
523	('netwall', '533'),
524	('uucp', '540'),
525	('uucpd', '540'),
526	('klogin', '543'),
527	('kshell', '544'),
528	('krcmd', '544'),
529	('new-rwho', '550'),
530	('new-who', '550'),
531	('remotefs', '556'),
532	('rfs', '556'),
533	('rfs_server', '556'),
534	('rmonitor', '560'),
535	('rmonitord', '560'),
536	('monitor', '561'),
537	('ldaps', '636'),
538	('sldap', '636'),
539	('doom', '666'),
540	('kerberos-adm', '749'),
541	('kerberos-iv', '750'),
542	('kpop', '1109'),
543	('phone', '1167'),
544	('ms-sql-s', '1433'),
545	('ms-sql-m', '1434'),
546	('wins', '1512'),
547	('ingreslock', '1524'),
548	('ingres', '1524'),
549	('l2tp', '1701'),
550	('pptp', '1723'),
551	('radius', '1812'),
552	('radacct', '1813'),
553	('nfsd', '2049'),
554	('nfs', '2049'),
555	('knetd', '2053'),
556	('gds_db', '3050'),
557	('man', '9535')
558	);
559
560	{function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
561	begin
562	Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
563	(a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0));
564	end;
565
566	function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
567	begin
568	Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
569	(a^.s_un_dw.s_dw3 = 0) and
570	(a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and
571	(a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1)));
572	end;
573
574	function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
575	begin
576	Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
577	end;
578
579	function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
580	begin
581	Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
582	end;
583
584	function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
585	begin
586	Result := (a^.s_un_b.s_b1 = char($FF));
587	end;
588
589	function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
590	begin
591	Result := (CompareMem( a, b, sizeof(TInAddr6)));
592	end;
593
594	procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
595	begin
596	FillChar(a^, sizeof(TInAddr6), 0);
597	end;
598
599	procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
600	begin
601	FillChar(a^, sizeof(TInAddr6), 0);
602	a^.s_un_b.s_b16 := char(1);
603	end;
604	}
605
606	{=============================================================================}
607
608	procedure NullErr;
609	begin
610	WSALastError := 0;
611	WSALastErrorDesc := '';
612	end;
613
614	procedure GetErrCode(E: System.Exception);
615	var
616	SE: System.Net.Sockets.SocketException;
617	begin
618	if E is System.Net.Sockets.SocketException then
619	begin
620	SE := E as System.Net.Sockets.SocketException;
621	WSALastError := SE.ErrorCode;
622	WSALastErrorDesc := SE.Message;
623	end
624	end;
625
626	function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
627	begin
628	NullErr;
629	with WSData do
630	begin
631	wVersion := wVersionRequired;
632	wHighVersion := $202;
633	szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
634	szSystemStatus := 'Running on .NET';
635	iMaxSockets := 32768;
636	iMaxUdpDg := 8192;
637	end;
638	Result := 0;
639	end;
640
641	function WSACleanup: Integer;
642	begin
643	NullErr;
644	Result := 0;
645	end;
646
647	function WSAGetLastError: Integer;
648	begin
649	Result := WSALastError;
650	end;
651
652	function WSAGetLastErrorDesc: String;
653	begin
654	Result := WSALastErrorDesc;
655	end;
656
657	function GetHostName: string;
658	begin
659	Result := System.Net.DNS.GetHostName;
660	end;
661
662	function Shutdown(s: TSocket; how: Integer): Integer;
663	begin
664	Result := 0;
665	NullErr;
666	try
667	s.ShutDown(SocketShutdown(how));
668	except
669	on e: System.Net.Sockets.SocketException do
670	begin
671	GetErrCode(e);
672	Result := integer(SOCKET_ERROR);
673	end;
674	end;
675	end;
676
677	function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
678	optlen: Integer): Integer;
679	begin
680	Result := 0;
681	NullErr;
682	try
683	s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
684	except
685	on e: System.Net.Sockets.SocketException do
686	begin
687	GetErrCode(e);
688	Result := integer(SOCKET_ERROR);
689	end;
690	end;
691	end;
692
693	function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
694	begin
695	Result := 0;
696	NullErr;
697	try
698	s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
699	except
700	on e: System.Net.Sockets.SocketException do
701	begin
702	GetErrCode(e);
703	Result := integer(SOCKET_ERROR);
704	end;
705	end;
706	end;
707
708	function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
709	var optlen: Integer): Integer;
710	begin
711	Result := 0;
712	NullErr;
713	try
714	s.GetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
715	except
716	on e: System.Net.Sockets.SocketException do
717	begin
718	GetErrCode(e);
719	Result := integer(SOCKET_ERROR);
720	end;
721	end;
722	end;
723
724	function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
725	//function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
726	begin
727	NullErr;
728	try
729	result := s.SendTo(Buf, len, SocketFlags(flags), addrto);
730	except
731	on e: System.Net.Sockets.SocketException do
732	begin
733	GetErrCode(e);
734	Result := integer(SOCKET_ERROR);
735	end;
736	end;
737	end;
738
739	function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
740	//function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
741	begin
742	NullErr;
743	try
744	result := s.Send(Buf, len, SocketFlags(flags));
745	except
746	on e: System.Net.Sockets.SocketException do
747	begin
748	GetErrCode(e);
749	Result := integer(SOCKET_ERROR);
750	end;
751	end;
752	end;
753
754	function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
755	//function Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
756	begin
757	NullErr;
758	try
759	result := s.Receive(Buf, len, SocketFlags(flags));
760	except
761	on e: System.Net.Sockets.SocketException do
762	begin
763	GetErrCode(e);
764	Result := integer(SOCKET_ERROR);
765	end;
766	end;
767	end;
768
769	//function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
770	// var fromlen: Integer): Integer;
771	function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
772	//function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
773	var
774	EP: EndPoint;
775	begin
776	NullErr;
777	try
778	EP := from;
779	result := s.ReceiveFrom(Buf, len, SocketFlags(flags), EndPoint(EP));
780	from := EP as IPEndPoint;
781	except
782	on e: System.Net.Sockets.SocketException do
783	begin
784	GetErrCode(e);
785	Result := integer(SOCKET_ERROR);
786	end;
787	end;
788	end;
789
790	function ntohs(netshort: u_short): u_short;
791	begin
792	Result := IPAddress.NetworkToHostOrder(NetShort);
793	end;
794
795	function ntohl(netlong: u_long): u_long;
796	begin
797	Result := IPAddress.NetworkToHostOrder(NetLong);
798	end;
799
800	function Listen(s: TSocket; backlog: Integer): Integer;
801	begin
802	Result := 0;
803	NullErr;
804	try
805	s.Listen(backlog);
806	except
807	on e: System.Net.Sockets.SocketException do
808	begin
809	GetErrCode(e);
810	Result := integer(SOCKET_ERROR);
811	end;
812	end;
813	end;
814
815	function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
816	var
817	inv, outv: TMemory;
818	begin
819	Result := 0;
820	NullErr;
821	try
822	if cmd = DWORD(FIONBIO) then
823	s.Blocking := arg = 0
824	else
825	begin
826	inv := BitConverter.GetBytes(arg);
827	outv := BitConverter.GetBytes(integer(0));
828	s.IOControl(cmd, inv, outv);
829	arg := BitConverter.ToInt32(outv, 0);
830	end;
831	except
832	on e: System.Net.Sockets.SocketException do
833	begin
834	GetErrCode(e);
835	Result := integer(SOCKET_ERROR);
836	end;
837	end;
838	end;
839
840	function htons(hostshort: u_short): u_short;
841	begin
842	Result := IPAddress.HostToNetworkOrder(Hostshort);
843	end;
844
845	function htonl(hostlong: u_long): u_long;
846	begin
847	Result := IPAddress.HostToNetworkOrder(HostLong);
848	end;
849
850	//function GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
851	function GetSockName(s: TSocket; var name: TVarSin): Integer;
852	begin
853	Result := 0;
854	NullErr;
855	try
856	Name := s.localEndPoint as IPEndpoint;
857	except
858	on e: System.Net.Sockets.SocketException do
859	begin
860	GetErrCode(e);
861	Result := integer(SOCKET_ERROR);
862	end;
863	end;
864	end;
865
866	//function GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
867	function GetPeerName(s: TSocket; var name: TVarSin): Integer;
868	begin
869	Result := 0;
870	NullErr;
871	try
872	Name := s.RemoteEndPoint as IPEndpoint;
873	except
874	on e: System.Net.Sockets.SocketException do
875	begin
876	GetErrCode(e);
877	Result := integer(SOCKET_ERROR);
878	end;
879	end;
880	end;
881
882	//function Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
883	function Connect(s: TSocket; const name: TVarSin): Integer;
884	begin
885	Result := 0;
886	NullErr;
887	try
888	s.Connect(name);
889	except
890	on e: System.Net.Sockets.SocketException do
891	begin
892	GetErrCode(e);
893	Result := integer(SOCKET_ERROR);
894	end;
895	end;
896	end;
897
898	function CloseSocket(s: TSocket): Integer;
899	begin
900	Result := 0;
901	NullErr;
902	try
903	s.Close;
904	except
905	on e: System.Net.Sockets.SocketException do
906	begin
907	Result := integer(SOCKET_ERROR);
908	end;
909	end;
910	end;
911
912	//function Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
913	function Bind(s: TSocket; const addr: TVarSin): Integer;
914	begin
915	Result := 0;
916	NullErr;
917	try
918	s.Bind(addr);
919	except
920	on e: System.Net.Sockets.SocketException do
921	begin
922	GetErrCode(e);
923	Result := integer(SOCKET_ERROR);
924	end;
925	end;
926	end;
927
928	//function Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
929	function Accept(s: TSocket; var addr: TVarSin): TSocket;
930	begin
931	NullErr;
932	try
933	result := s.Accept();
934	except
935	on e: System.Net.Sockets.SocketException do
936	begin
937	GetErrCode(e);
938	Result := nil;
939	end;
940	end;
941	end;
942
943	function Socket(af, Struc, Protocol: Integer): TSocket;
944	begin
945	NullErr;
946	try
947	result := TSocket.Create(AddressFamily(af), SocketType(Struc), ProtocolType(Protocol));
948	except
949	on e: System.Net.Sockets.SocketException do
950	begin
951	GetErrCode(e);
952	Result := nil;
953	end;
954	end;
955	end;
956
957	{=============================================================================}
958	function GetPortService(value: string): integer;
959	var
960	n: integer;
961	begin
962	Result := 0;
963	value := Lowercase(value);
964	for n := 0 to High(Services) do
965	if services[n, 0] = value then
966	begin
967	Result := strtointdef(services[n, 1], 0);
968	break;
969	end;
970	if Result = 0 then
971	Result := StrToIntDef(value, 0);
972	end;
973
974	{=============================================================================}
975	function IsNewApi(Family: TAddrFamily): Boolean;
976	begin
977	Result := true;
978	end;
979
980	function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
981	var
982	IPs: array of IPAddress;
983	n: integer;
984	ip4, ip6: string;
985	sip: string;
986	begin
987	sip := '';
988	ip4 := '';
989	ip6 := '';
990	IPs := Dns.Resolve(IP).AddressList;
991	for n :=low(IPs) to high(IPs) do begin
992	if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then
993	ip4 := IPs[n].toString;
994	if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then
995	ip6 := IPs[n].toString;
996	if (ip4 <> '') and (ip6 <> '') then
997	break;
998	end;
999	case Family of
1000	AF_UNSPEC:
1001	begin
1002	if (ip4 <> '') and (ip6 <> '') then
1003	begin
1004	if PreferIP4 then
1005	sip := ip4
1006	else
1007	Sip := ip6;
1008	end
1009	else
1010	begin
1011	sip := ip4;
1012	if (ip6 <> '') then
1013	sip := ip6;
1014	end;
1015	end;
1016	AF_INET:
1017	sip := ip4;
1018	AF_INET6:
1019	sip := ip6;
1020	end;
1021	sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port));
1022	end;
1023
1024	function GetSinIP(Sin: TVarSin): string;
1025	begin
1026	Result := Sin.Address.ToString;
1027	end;
1028
1029	function GetSinPort(Sin: TVarSin): Integer;
1030	begin
1031	Result := Sin.Port;
1032	end;
1033
1034	procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
1035	var
1036	IPs :array of IPAddress;
1037	n: integer;
1038	begin
1039	IPList.Clear;
1040	IPs := Dns.Resolve(Name).AddressList;
1041	for n := low(IPs) to high(IPs) do
1042	begin
1043	if not(((Family = AF_INET6) and (IPs[n].AddressFamily = AF_INET))
1044	or ((Family = AF_INET) and (IPs[n].AddressFamily = AF_INET6))) then
1045	begin
1046	IPList.Add(IPs[n].toString);
1047	end;
1048	end;
1049	end;
1050
1051	function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
1052	var
1053	n: integer;
1054	begin
1055	Result := StrToIntDef(port, 0);
1056	if Result = 0 then
1057	begin
1058	port := Lowercase(port);
1059	for n := 0 to High(Services) do
1060	if services[n, 0] = port then
1061	begin
1062	Result := strtointdef(services[n, 1], 0);
1063	break;
1064	end;
1065	end;
1066	end;
1067
1068	function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
1069	begin
1070	Result := Dns.GetHostByAddress(IP).HostName;
1071	end;
1072
1073
1074	{=============================================================================}
1075	function InitSocketInterface(stack: string): Boolean;
1076	begin
1077	Result := True;
1078	end;
1079
1080	function DestroySocketInterface: Boolean;
1081	begin
1082	NullErr;
1083	Result := True;
1084	end;
1085
1086	initialization
1087	begin
1088	SynSockCS := SyncObjs.TCriticalSection.Create;
1089	// SET_IN6_IF_ADDR_ANY (@in6addr_any);
1090	// SET_LOOPBACK_ADDR6 (@in6addr_loopback);
1091	end;
1092
1093	finalization
1094	begin
1095	NullErr;
1096	SynSockCS.Free;
1097	end;
1098
1099	{$ENDIF}

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/Demo/Packages/synapse/ssdotnet.pas

Download in other formats: