source: trunk/Packages/synapse/sswin32.pas

Last change on this file was 84, checked in by chronos, 13 years ago
  • Stored packages in uncompressed files.
File size: 54.1 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 002.002.000 |
3|==============================================================================|
4| Content: Socket Independent Platform Layer - Win32 definition include |
5|==============================================================================|
6| Copyright (c)1999-2008, 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)2003. |
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 WIN32}
48
49//{$DEFINE WINSOCK1}
50{Note about define WINSOCK1:
51If you activate this compiler directive, then socket interface level 1.1 is
52used instead default level 2.2. Level 2.2 is not available on old W95, however
53you can install update.
54}
55
56//{$DEFINE FORCEOLDAPI}
57{Note about define FORCEOLDAPI:
58If you activate this compiler directive, then is allways used old socket API
59for name resolution. If you leave this directive inactive, then the new API
60is used, when running system allows it.
61
62For IPv6 support you must have new API!
63}
64
65{$IFDEF FPC}
66 {$MODE DELPHI}
67{$ENDIF}
68{$H+}
69{$IFDEF VER125}
70 {$DEFINE BCB}
71{$ENDIF}
72{$IFDEF BCB}
73 {$ObjExportAll On}
74 (*$HPPEMIT '/* EDE 2003-02-19 */' *)
75 (*$HPPEMIT 'namespace Synsock { using System::Shortint; }' *)
76 (*$HPPEMIT '#undef h_addr' *)
77 (*$HPPEMIT '#undef IOCPARM_MASK' *)
78 (*$HPPEMIT '#undef FD_SETSIZE' *)
79 (*$HPPEMIT '#undef IOC_VOID' *)
80 (*$HPPEMIT '#undef IOC_OUT' *)
81 (*$HPPEMIT '#undef IOC_IN' *)
82 (*$HPPEMIT '#undef IOC_INOUT' *)
83 (*$HPPEMIT '#undef FIONREAD' *)
84 (*$HPPEMIT '#undef FIONBIO' *)
85 (*$HPPEMIT '#undef FIOASYNC' *)
86 (*$HPPEMIT '#undef IPPROTO_IP' *)
87 (*$HPPEMIT '#undef IPPROTO_ICMP' *)
88 (*$HPPEMIT '#undef IPPROTO_IGMP' *)
89 (*$HPPEMIT '#undef IPPROTO_TCP' *)
90 (*$HPPEMIT '#undef IPPROTO_UDP' *)
91 (*$HPPEMIT '#undef IPPROTO_RAW' *)
92 (*$HPPEMIT '#undef IPPROTO_MAX' *)
93 (*$HPPEMIT '#undef INADDR_ANY' *)
94 (*$HPPEMIT '#undef INADDR_LOOPBACK' *)
95 (*$HPPEMIT '#undef INADDR_BROADCAST' *)
96 (*$HPPEMIT '#undef INADDR_NONE' *)
97 (*$HPPEMIT '#undef INVALID_SOCKET' *)
98 (*$HPPEMIT '#undef SOCKET_ERROR' *)
99 (*$HPPEMIT '#undef WSADESCRIPTION_LEN' *)
100 (*$HPPEMIT '#undef WSASYS_STATUS_LEN' *)
101 (*$HPPEMIT '#undef IP_OPTIONS' *)
102 (*$HPPEMIT '#undef IP_TOS' *)
103 (*$HPPEMIT '#undef IP_TTL' *)
104 (*$HPPEMIT '#undef IP_MULTICAST_IF' *)
105 (*$HPPEMIT '#undef IP_MULTICAST_TTL' *)
106 (*$HPPEMIT '#undef IP_MULTICAST_LOOP' *)
107 (*$HPPEMIT '#undef IP_ADD_MEMBERSHIP' *)
108 (*$HPPEMIT '#undef IP_DROP_MEMBERSHIP' *)
109 (*$HPPEMIT '#undef IP_DONTFRAGMENT' *)
110 (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_TTL' *)
111 (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_LOOP' *)
112 (*$HPPEMIT '#undef IP_MAX_MEMBERSHIPS' *)
113 (*$HPPEMIT '#undef SOL_SOCKET' *)
114 (*$HPPEMIT '#undef SO_DEBUG' *)
115 (*$HPPEMIT '#undef SO_ACCEPTCONN' *)
116 (*$HPPEMIT '#undef SO_REUSEADDR' *)
117 (*$HPPEMIT '#undef SO_KEEPALIVE' *)
118 (*$HPPEMIT '#undef SO_DONTROUTE' *)
119 (*$HPPEMIT '#undef SO_BROADCAST' *)
120 (*$HPPEMIT '#undef SO_USELOOPBACK' *)
121 (*$HPPEMIT '#undef SO_LINGER' *)
122 (*$HPPEMIT '#undef SO_OOBINLINE' *)
123 (*$HPPEMIT '#undef SO_DONTLINGER' *)
124 (*$HPPEMIT '#undef SO_SNDBUF' *)
125 (*$HPPEMIT '#undef SO_RCVBUF' *)
126 (*$HPPEMIT '#undef SO_SNDLOWAT' *)
127 (*$HPPEMIT '#undef SO_RCVLOWAT' *)
128 (*$HPPEMIT '#undef SO_SNDTIMEO' *)
129 (*$HPPEMIT '#undef SO_RCVTIMEO' *)
130 (*$HPPEMIT '#undef SO_ERROR' *)
131 (*$HPPEMIT '#undef SO_OPENTYPE' *)
132 (*$HPPEMIT '#undef SO_SYNCHRONOUS_ALERT' *)
133 (*$HPPEMIT '#undef SO_SYNCHRONOUS_NONALERT' *)
134 (*$HPPEMIT '#undef SO_MAXDG' *)
135 (*$HPPEMIT '#undef SO_MAXPATHDG' *)
136 (*$HPPEMIT '#undef SO_UPDATE_ACCEPT_CONTEXT' *)
137 (*$HPPEMIT '#undef SO_CONNECT_TIME' *)
138 (*$HPPEMIT '#undef SO_TYPE' *)
139 (*$HPPEMIT '#undef SOCK_STREAM' *)
140 (*$HPPEMIT '#undef SOCK_DGRAM' *)
141 (*$HPPEMIT '#undef SOCK_RAW' *)
142 (*$HPPEMIT '#undef SOCK_RDM' *)
143 (*$HPPEMIT '#undef SOCK_SEQPACKET' *)
144 (*$HPPEMIT '#undef TCP_NODELAY' *)
145 (*$HPPEMIT '#undef AF_UNSPEC' *)
146 (*$HPPEMIT '#undef SOMAXCONN' *)
147 (*$HPPEMIT '#undef AF_INET' *)
148 (*$HPPEMIT '#undef AF_MAX' *)
149 (*$HPPEMIT '#undef PF_UNSPEC' *)
150 (*$HPPEMIT '#undef PF_INET' *)
151 (*$HPPEMIT '#undef PF_MAX' *)
152 (*$HPPEMIT '#undef MSG_OOB' *)
153 (*$HPPEMIT '#undef MSG_PEEK' *)
154 (*$HPPEMIT '#undef WSABASEERR' *)
155 (*$HPPEMIT '#undef WSAEINTR' *)
156 (*$HPPEMIT '#undef WSAEBADF' *)
157 (*$HPPEMIT '#undef WSAEACCES' *)
158 (*$HPPEMIT '#undef WSAEFAULT' *)
159 (*$HPPEMIT '#undef WSAEINVAL' *)
160 (*$HPPEMIT '#undef WSAEMFILE' *)
161 (*$HPPEMIT '#undef WSAEWOULDBLOCK' *)
162 (*$HPPEMIT '#undef WSAEINPROGRESS' *)
163 (*$HPPEMIT '#undef WSAEALREADY' *)
164 (*$HPPEMIT '#undef WSAENOTSOCK' *)
165 (*$HPPEMIT '#undef WSAEDESTADDRREQ' *)
166 (*$HPPEMIT '#undef WSAEMSGSIZE' *)
167 (*$HPPEMIT '#undef WSAEPROTOTYPE' *)
168 (*$HPPEMIT '#undef WSAENOPROTOOPT' *)
169 (*$HPPEMIT '#undef WSAEPROTONOSUPPORT' *)
170 (*$HPPEMIT '#undef WSAESOCKTNOSUPPORT' *)
171 (*$HPPEMIT '#undef WSAEOPNOTSUPP' *)
172 (*$HPPEMIT '#undef WSAEPFNOSUPPORT' *)
173 (*$HPPEMIT '#undef WSAEAFNOSUPPORT' *)
174 (*$HPPEMIT '#undef WSAEADDRINUSE' *)
175 (*$HPPEMIT '#undef WSAEADDRNOTAVAIL' *)
176 (*$HPPEMIT '#undef WSAENETDOWN' *)
177 (*$HPPEMIT '#undef WSAENETUNREACH' *)
178 (*$HPPEMIT '#undef WSAENETRESET' *)
179 (*$HPPEMIT '#undef WSAECONNABORTED' *)
180 (*$HPPEMIT '#undef WSAECONNRESET' *)
181 (*$HPPEMIT '#undef WSAENOBUFS' *)
182 (*$HPPEMIT '#undef WSAEISCONN' *)
183 (*$HPPEMIT '#undef WSAENOTCONN' *)
184 (*$HPPEMIT '#undef WSAESHUTDOWN' *)
185 (*$HPPEMIT '#undef WSAETOOMANYREFS' *)
186 (*$HPPEMIT '#undef WSAETIMEDOUT' *)
187 (*$HPPEMIT '#undef WSAECONNREFUSED' *)
188 (*$HPPEMIT '#undef WSAELOOP' *)
189 (*$HPPEMIT '#undef WSAENAMETOOLONG' *)
190 (*$HPPEMIT '#undef WSAEHOSTDOWN' *)
191 (*$HPPEMIT '#undef WSAEHOSTUNREACH' *)
192 (*$HPPEMIT '#undef WSAENOTEMPTY' *)
193 (*$HPPEMIT '#undef WSAEPROCLIM' *)
194 (*$HPPEMIT '#undef WSAEUSERS' *)
195 (*$HPPEMIT '#undef WSAEDQUOT' *)
196 (*$HPPEMIT '#undef WSAESTALE' *)
197 (*$HPPEMIT '#undef WSAEREMOTE' *)
198 (*$HPPEMIT '#undef WSASYSNOTREADY' *)
199 (*$HPPEMIT '#undef WSAVERNOTSUPPORTED' *)
200 (*$HPPEMIT '#undef WSANOTINITIALISED' *)
201 (*$HPPEMIT '#undef WSAEDISCON' *)
202 (*$HPPEMIT '#undef WSAENOMORE' *)
203 (*$HPPEMIT '#undef WSAECANCELLED' *)
204 (*$HPPEMIT '#undef WSAEEINVALIDPROCTABLE' *)
205 (*$HPPEMIT '#undef WSAEINVALIDPROVIDER' *)
206 (*$HPPEMIT '#undef WSAEPROVIDERFAILEDINIT' *)
207 (*$HPPEMIT '#undef WSASYSCALLFAILURE' *)
208 (*$HPPEMIT '#undef WSASERVICE_NOT_FOUND' *)
209 (*$HPPEMIT '#undef WSATYPE_NOT_FOUND' *)
210 (*$HPPEMIT '#undef WSA_E_NO_MORE' *)
211 (*$HPPEMIT '#undef WSA_E_CANCELLED' *)
212 (*$HPPEMIT '#undef WSAEREFUSED' *)
213 (*$HPPEMIT '#undef WSAHOST_NOT_FOUND' *)
214 (*$HPPEMIT '#undef HOST_NOT_FOUND' *)
215 (*$HPPEMIT '#undef WSATRY_AGAIN' *)
216 (*$HPPEMIT '#undef TRY_AGAIN' *)
217 (*$HPPEMIT '#undef WSANO_RECOVERY' *)
218 (*$HPPEMIT '#undef NO_RECOVERY' *)
219 (*$HPPEMIT '#undef WSANO_DATA' *)
220 (*$HPPEMIT '#undef NO_DATA' *)
221 (*$HPPEMIT '#undef WSANO_ADDRESS' *)
222 (*$HPPEMIT '#undef ENAMETOOLONG' *)
223 (*$HPPEMIT '#undef ENOTEMPTY' *)
224 (*$HPPEMIT '#undef FD_CLR' *)
225 (*$HPPEMIT '#undef FD_ISSET' *)
226 (*$HPPEMIT '#undef FD_SET' *)
227 (*$HPPEMIT '#undef FD_ZERO' *)
228 (*$HPPEMIT '#undef NO_ADDRESS' *)
229 (*$HPPEMIT '#undef ADDR_ANY' *)
230 (*$HPPEMIT '#undef SO_GROUP_ID' *)
231 (*$HPPEMIT '#undef SO_GROUP_PRIORITY' *)
232 (*$HPPEMIT '#undef SO_MAX_MSG_SIZE' *)
233 (*$HPPEMIT '#undef SO_PROTOCOL_INFOA' *)
234 (*$HPPEMIT '#undef SO_PROTOCOL_INFOW' *)
235 (*$HPPEMIT '#undef SO_PROTOCOL_INFO' *)
236 (*$HPPEMIT '#undef PVD_CONFIG' *)
237 (*$HPPEMIT '#undef AF_INET6' *)
238 (*$HPPEMIT '#undef PF_INET6' *)
239{$ENDIF}
240
241interface
242
243uses
244 SyncObjs, SysUtils, Classes,
245 Windows;
246
247function InitSocketInterface(stack: String): Boolean;
248function DestroySocketInterface: Boolean;
249
250const
251{$IFDEF WINSOCK1}
252 WinsockLevel = $0101;
253{$ELSE}
254 WinsockLevel = $0202;
255{$ENDIF}
256
257type
258 u_short = Word;
259 u_int = Integer;
260 u_long = Longint;
261 pu_long = ^u_long;
262 pu_short = ^u_short;
263 TSocket = u_int;
264 TAddrFamily = integer;
265
266 TMemory = pointer;
267
268const
269 {$IFDEF WINSOCK1}
270 DLLStackName = 'wsock32.dll';
271 {$ELSE}
272 DLLStackName = 'ws2_32.dll';
273 {$ENDIF}
274 DLLwship6 = 'wship6.dll';
275
276 cLocalhost = '127.0.0.1';
277 cAnyHost = '0.0.0.0';
278 cBroadcast = '255.255.255.255';
279 c6Localhost = '::1';
280 c6AnyHost = '::0';
281 c6Broadcast = 'ffff::1';
282 cAnyPort = '0';
283
284
285const
286 FD_SETSIZE = 64;
287type
288 PFDSet = ^TFDSet;
289 TFDSet = packed record
290 fd_count: u_int;
291 fd_array: array[0..FD_SETSIZE-1] of TSocket;
292 end;
293
294const
295 FIONREAD = $4004667f;
296 FIONBIO = $8004667e;
297 FIOASYNC = $8004667d;
298
299type
300 PTimeVal = ^TTimeVal;
301 TTimeVal = packed record
302 tv_sec: Longint;
303 tv_usec: Longint;
304 end;
305
306const
307 IPPROTO_IP = 0; { Dummy }
308 IPPROTO_ICMP = 1; { Internet Control Message Protocol }
309 IPPROTO_IGMP = 2; { Internet Group Management Protocol}
310 IPPROTO_TCP = 6; { TCP }
311 IPPROTO_UDP = 17; { User Datagram Protocol }
312 IPPROTO_IPV6 = 41;
313 IPPROTO_ICMPV6 = 58;
314
315 IPPROTO_RAW = 255;
316 IPPROTO_MAX = 256;
317
318type
319
320 PInAddr = ^TInAddr;
321 TInAddr = packed record
322 case integer of
323 0: (S_bytes: packed array [0..3] of byte);
324 1: (S_addr: u_long);
325 end;
326
327 PSockAddrIn = ^TSockAddrIn;
328 TSockAddrIn = packed record
329 case Integer of
330 0: (sin_family: u_short;
331 sin_port: u_short;
332 sin_addr: TInAddr;
333 sin_zero: array[0..7] of byte);
334 1: (sa_family: u_short;
335 sa_data: array[0..13] of byte)
336 end;
337
338 TIP_mreq = record
339 imr_multiaddr: TInAddr; { IP multicast address of group }
340 imr_interface: TInAddr; { local IP address of interface }
341 end;
342
343 PInAddr6 = ^TInAddr6;
344 TInAddr6 = packed record
345 case integer of
346 0: (S6_addr: packed array [0..15] of byte);
347 1: (u6_addr8: packed array [0..15] of byte);
348 2: (u6_addr16: packed array [0..7] of word);
349 3: (u6_addr32: packed array [0..3] of integer);
350 end;
351
352 PSockAddrIn6 = ^TSockAddrIn6;
353 TSockAddrIn6 = packed record
354 sin6_family: u_short; // AF_INET6
355 sin6_port: u_short; // Transport level port number
356 sin6_flowinfo: u_long; // IPv6 flow information
357 sin6_addr: TInAddr6; // IPv6 address
358 sin6_scope_id: u_long; // Scope Id: IF number for link-local
359 // SITE id for site-local
360 end;
361
362 TIPv6_mreq = record
363 ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
364 ipv6mr_interface: integer; // Interface index.
365 padding: integer;
366 end;
367
368 PHostEnt = ^THostEnt;
369 THostEnt = packed record
370 h_name: PAnsiChar;
371 h_aliases: ^PAnsiChar;
372 h_addrtype: Smallint;
373 h_length: Smallint;
374 case integer of
375 0: (h_addr_list: ^PAnsiChar);
376 1: (h_addr: ^PInAddr);
377 end;
378
379 PNetEnt = ^TNetEnt;
380 TNetEnt = packed record
381 n_name: PAnsiChar;
382 n_aliases: ^PAnsiChar;
383 n_addrtype: Smallint;
384 n_net: u_long;
385 end;
386
387 PServEnt = ^TServEnt;
388 TServEnt = packed record
389 s_name: PAnsiChar;
390 s_aliases: ^PAnsiChar;
391 s_port: Smallint;
392 s_proto: PAnsiChar;
393 end;
394
395 PProtoEnt = ^TProtoEnt;
396 TProtoEnt = packed record
397 p_name: PAnsiChar;
398 p_aliases: ^PAnsichar;
399 p_proto: Smallint;
400 end;
401
402const
403 INADDR_ANY = $00000000;
404 INADDR_LOOPBACK = $7F000001;
405 INADDR_BROADCAST = $FFFFFFFF;
406 INADDR_NONE = $FFFFFFFF;
407 ADDR_ANY = INADDR_ANY;
408 INVALID_SOCKET = TSocket(NOT(0));
409 SOCKET_ERROR = -1;
410
411Const
412 {$IFDEF WINSOCK1}
413 IP_OPTIONS = 1;
414 IP_MULTICAST_IF = 2; { set/get IP multicast interface }
415 IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive }
416 IP_MULTICAST_LOOP = 4; { set/get IP multicast loopback }
417 IP_ADD_MEMBERSHIP = 5; { add an IP group membership }
418 IP_DROP_MEMBERSHIP = 6; { drop an IP group membership }
419 IP_TTL = 7; { set/get IP Time To Live }
420 IP_TOS = 8; { set/get IP Type Of Service }
421 IP_DONTFRAGMENT = 9; { set/get IP Don't Fragment flag }
422 {$ELSE}
423 IP_OPTIONS = 1;
424 IP_HDRINCL = 2;
425 IP_TOS = 3; { set/get IP Type Of Service }
426 IP_TTL = 4; { set/get IP Time To Live }
427 IP_MULTICAST_IF = 9; { set/get IP multicast interface }
428 IP_MULTICAST_TTL = 10; { set/get IP multicast timetolive }
429 IP_MULTICAST_LOOP = 11; { set/get IP multicast loopback }
430 IP_ADD_MEMBERSHIP = 12; { add an IP group membership }
431 IP_DROP_MEMBERSHIP = 13; { drop an IP group membership }
432 IP_DONTFRAGMENT = 14; { set/get IP Don't Fragment flag }
433 {$ENDIF}
434
435 IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop }
436 IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member }
437 IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf }
438
439 SOL_SOCKET = $ffff; {options for socket level }
440{ Option flags per-socket. }
441 SO_DEBUG = $0001; { turn on debugging info recording }
442 SO_ACCEPTCONN = $0002; { socket has had listen() }
443 SO_REUSEADDR = $0004; { allow local address reuse }
444 SO_KEEPALIVE = $0008; { keep connections alive }
445 SO_DONTROUTE = $0010; { just use interface addresses }
446 SO_BROADCAST = $0020; { permit sending of broadcast msgs }
447 SO_USELOOPBACK = $0040; { bypass hardware when possible }
448 SO_LINGER = $0080; { linger on close if data present }
449 SO_OOBINLINE = $0100; { leave received OOB data in line }
450 SO_DONTLINGER = $ff7f;
451{ Additional options. }
452 SO_SNDBUF = $1001; { send buffer size }
453 SO_RCVBUF = $1002; { receive buffer size }
454 SO_SNDLOWAT = $1003; { send low-water mark }
455 SO_RCVLOWAT = $1004; { receive low-water mark }
456 SO_SNDTIMEO = $1005; { send timeout }
457 SO_RCVTIMEO = $1006; { receive timeout }
458 SO_ERROR = $1007; { get error status and clear }
459 SO_TYPE = $1008; { get socket type }
460{ WinSock 2 extension -- new options }
461 SO_GROUP_ID = $2001; { ID of a socket group}
462 SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
463 SO_MAX_MSG_SIZE = $2003; { maximum message size }
464 SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
465 SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
466 SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA;
467 PVD_CONFIG = $3001; {configuration info for service provider }
468{ Option for opening sockets for synchronous access. }
469 SO_OPENTYPE = $7008;
470 SO_SYNCHRONOUS_ALERT = $10;
471 SO_SYNCHRONOUS_NONALERT = $20;
472{ Other NT-specific options. }
473 SO_MAXDG = $7009;
474 SO_MAXPATHDG = $700A;
475 SO_UPDATE_ACCEPT_CONTEXT = $700B;
476 SO_CONNECT_TIME = $700C;
477
478 SOMAXCONN = $7fffffff;
479
480 IPV6_UNICAST_HOPS = 8; // ???
481 IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f
482 IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl
483 IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback
484 IPV6_JOIN_GROUP = 12; // add an IP group membership
485 IPV6_LEAVE_GROUP = 13; // drop an IP group membership
486
487 MSG_NOSIGNAL = 0;
488
489 // getnameinfo constants
490 NI_MAXHOST = 1025;
491 NI_MAXSERV = 32;
492 NI_NOFQDN = $1;
493 NI_NUMERICHOST = $2;
494 NI_NAMEREQD = $4;
495 NI_NUMERICSERV = $8;
496 NI_DGRAM = $10;
497
498
499const
500 SOCK_STREAM = 1; { stream socket }
501 SOCK_DGRAM = 2; { datagram socket }
502 SOCK_RAW = 3; { raw-protocol interface }
503 SOCK_RDM = 4; { reliably-delivered message }
504 SOCK_SEQPACKET = 5; { sequenced packet stream }
505
506{ TCP options. }
507 TCP_NODELAY = $0001;
508
509{ Address families. }
510
511 AF_UNSPEC = 0; { unspecified }
512 AF_INET = 2; { internetwork: UDP, TCP, etc. }
513 AF_INET6 = 23; { Internetwork Version 6 }
514 AF_MAX = 24;
515
516{ Protocol families, same as address families for now. }
517 PF_UNSPEC = AF_UNSPEC;
518 PF_INET = AF_INET;
519 PF_INET6 = AF_INET6;
520 PF_MAX = AF_MAX;
521
522type
523 { Structure used by kernel to store most addresses. }
524 PSockAddr = ^TSockAddr;
525 TSockAddr = TSockAddrIn;
526
527 { Structure used by kernel to pass protocol information in raw sockets. }
528 PSockProto = ^TSockProto;
529 TSockProto = packed record
530 sp_family: u_short;
531 sp_protocol: u_short;
532 end;
533
534type
535 PAddrInfo = ^TAddrInfo;
536 TAddrInfo = record
537 ai_flags: integer; // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST.
538 ai_family: integer; // PF_xxx.
539 ai_socktype: integer; // SOCK_xxx.
540 ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6.
541 ai_addrlen: u_int; // Length of ai_addr.
542 ai_canonname: PAnsiChar; // Canonical name for nodename.
543 ai_addr: PSockAddr; // Binary address.
544 ai_next: PAddrInfo; // Next structure in linked list.
545 end;
546
547const
548 // Flags used in "hints" argument to getaddrinfo().
549 AI_PASSIVE = $1; // Socket address will be used in bind() call.
550 AI_CANONNAME = $2; // Return canonical name in first ai_canonname.
551 AI_NUMERICHOST = $4; // Nodename must be a numeric address string.
552
553type
554{ Structure used for manipulating linger option. }
555 PLinger = ^TLinger;
556 TLinger = packed record
557 l_onoff: u_short;
558 l_linger: u_short;
559 end;
560
561const
562
563 MSG_OOB = $01; // Process out-of-band data.
564 MSG_PEEK = $02; // Peek at incoming messages.
565
566const
567
568{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
569 WSABASEERR = 10000;
570
571{ Windows Sockets definitions of regular Microsoft C error constants }
572
573 WSAEINTR = (WSABASEERR+4);
574 WSAEBADF = (WSABASEERR+9);
575 WSAEACCES = (WSABASEERR+13);
576 WSAEFAULT = (WSABASEERR+14);
577 WSAEINVAL = (WSABASEERR+22);
578 WSAEMFILE = (WSABASEERR+24);
579
580{ Windows Sockets definitions of regular Berkeley error constants }
581
582 WSAEWOULDBLOCK = (WSABASEERR+35);
583 WSAEINPROGRESS = (WSABASEERR+36);
584 WSAEALREADY = (WSABASEERR+37);
585 WSAENOTSOCK = (WSABASEERR+38);
586 WSAEDESTADDRREQ = (WSABASEERR+39);
587 WSAEMSGSIZE = (WSABASEERR+40);
588 WSAEPROTOTYPE = (WSABASEERR+41);
589 WSAENOPROTOOPT = (WSABASEERR+42);
590 WSAEPROTONOSUPPORT = (WSABASEERR+43);
591 WSAESOCKTNOSUPPORT = (WSABASEERR+44);
592 WSAEOPNOTSUPP = (WSABASEERR+45);
593 WSAEPFNOSUPPORT = (WSABASEERR+46);
594 WSAEAFNOSUPPORT = (WSABASEERR+47);
595 WSAEADDRINUSE = (WSABASEERR+48);
596 WSAEADDRNOTAVAIL = (WSABASEERR+49);
597 WSAENETDOWN = (WSABASEERR+50);
598 WSAENETUNREACH = (WSABASEERR+51);
599 WSAENETRESET = (WSABASEERR+52);
600 WSAECONNABORTED = (WSABASEERR+53);
601 WSAECONNRESET = (WSABASEERR+54);
602 WSAENOBUFS = (WSABASEERR+55);
603 WSAEISCONN = (WSABASEERR+56);
604 WSAENOTCONN = (WSABASEERR+57);
605 WSAESHUTDOWN = (WSABASEERR+58);
606 WSAETOOMANYREFS = (WSABASEERR+59);
607 WSAETIMEDOUT = (WSABASEERR+60);
608 WSAECONNREFUSED = (WSABASEERR+61);
609 WSAELOOP = (WSABASEERR+62);
610 WSAENAMETOOLONG = (WSABASEERR+63);
611 WSAEHOSTDOWN = (WSABASEERR+64);
612 WSAEHOSTUNREACH = (WSABASEERR+65);
613 WSAENOTEMPTY = (WSABASEERR+66);
614 WSAEPROCLIM = (WSABASEERR+67);
615 WSAEUSERS = (WSABASEERR+68);
616 WSAEDQUOT = (WSABASEERR+69);
617 WSAESTALE = (WSABASEERR+70);
618 WSAEREMOTE = (WSABASEERR+71);
619
620{ Extended Windows Sockets error constant definitions }
621
622 WSASYSNOTREADY = (WSABASEERR+91);
623 WSAVERNOTSUPPORTED = (WSABASEERR+92);
624 WSANOTINITIALISED = (WSABASEERR+93);
625 WSAEDISCON = (WSABASEERR+101);
626 WSAENOMORE = (WSABASEERR+102);
627 WSAECANCELLED = (WSABASEERR+103);
628 WSAEEINVALIDPROCTABLE = (WSABASEERR+104);
629 WSAEINVALIDPROVIDER = (WSABASEERR+105);
630 WSAEPROVIDERFAILEDINIT = (WSABASEERR+106);
631 WSASYSCALLFAILURE = (WSABASEERR+107);
632 WSASERVICE_NOT_FOUND = (WSABASEERR+108);
633 WSATYPE_NOT_FOUND = (WSABASEERR+109);
634 WSA_E_NO_MORE = (WSABASEERR+110);
635 WSA_E_CANCELLED = (WSABASEERR+111);
636 WSAEREFUSED = (WSABASEERR+112);
637
638{ Error return codes from gethostbyname() and gethostbyaddr()
639 (when using the resolver). Note that these errors are
640 retrieved via WSAGetLastError() and must therefore follow
641 the rules for avoiding clashes with error numbers from
642 specific implementations or language run-time systems.
643 For this reason the codes are based at WSABASEERR+1001.
644 Note also that [WSA]NO_ADDRESS is defined only for
645 compatibility purposes. }
646
647{ Authoritative Answer: Host not found }
648 WSAHOST_NOT_FOUND = (WSABASEERR+1001);
649 HOST_NOT_FOUND = WSAHOST_NOT_FOUND;
650{ Non-Authoritative: Host not found, or SERVERFAIL }
651 WSATRY_AGAIN = (WSABASEERR+1002);
652 TRY_AGAIN = WSATRY_AGAIN;
653{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
654 WSANO_RECOVERY = (WSABASEERR+1003);
655 NO_RECOVERY = WSANO_RECOVERY;
656{ Valid name, no data record of requested type }
657 WSANO_DATA = (WSABASEERR+1004);
658 NO_DATA = WSANO_DATA;
659{ no address, look for MX record }
660 WSANO_ADDRESS = WSANO_DATA;
661 NO_ADDRESS = WSANO_ADDRESS;
662
663 EWOULDBLOCK = WSAEWOULDBLOCK;
664 EINPROGRESS = WSAEINPROGRESS;
665 EALREADY = WSAEALREADY;
666 ENOTSOCK = WSAENOTSOCK;
667 EDESTADDRREQ = WSAEDESTADDRREQ;
668 EMSGSIZE = WSAEMSGSIZE;
669 EPROTOTYPE = WSAEPROTOTYPE;
670 ENOPROTOOPT = WSAENOPROTOOPT;
671 EPROTONOSUPPORT = WSAEPROTONOSUPPORT;
672 ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT;
673 EOPNOTSUPP = WSAEOPNOTSUPP;
674 EPFNOSUPPORT = WSAEPFNOSUPPORT;
675 EAFNOSUPPORT = WSAEAFNOSUPPORT;
676 EADDRINUSE = WSAEADDRINUSE;
677 EADDRNOTAVAIL = WSAEADDRNOTAVAIL;
678 ENETDOWN = WSAENETDOWN;
679 ENETUNREACH = WSAENETUNREACH;
680 ENETRESET = WSAENETRESET;
681 ECONNABORTED = WSAECONNABORTED;
682 ECONNRESET = WSAECONNRESET;
683 ENOBUFS = WSAENOBUFS;
684 EISCONN = WSAEISCONN;
685 ENOTCONN = WSAENOTCONN;
686 ESHUTDOWN = WSAESHUTDOWN;
687 ETOOMANYREFS = WSAETOOMANYREFS;
688 ETIMEDOUT = WSAETIMEDOUT;
689 ECONNREFUSED = WSAECONNREFUSED;
690 ELOOP = WSAELOOP;
691 ENAMETOOLONG = WSAENAMETOOLONG;
692 EHOSTDOWN = WSAEHOSTDOWN;
693 EHOSTUNREACH = WSAEHOSTUNREACH;
694 ENOTEMPTY = WSAENOTEMPTY;
695 EPROCLIM = WSAEPROCLIM;
696 EUSERS = WSAEUSERS;
697 EDQUOT = WSAEDQUOT;
698 ESTALE = WSAESTALE;
699 EREMOTE = WSAEREMOTE;
700
701 EAI_ADDRFAMILY = 1; // Address family for nodename not supported.
702 EAI_AGAIN = 2; // Temporary failure in name resolution.
703 EAI_BADFLAGS = 3; // Invalid value for ai_flags.
704 EAI_FAIL = 4; // Non-recoverable failure in name resolution.
705 EAI_FAMILY = 5; // Address family ai_family not supported.
706 EAI_MEMORY = 6; // Memory allocation failure.
707 EAI_NODATA = 7; // No address associated with nodename.
708 EAI_NONAME = 8; // Nodename nor servname provided, or not known.
709 EAI_SERVICE = 9; // Servname not supported for ai_socktype.
710 EAI_SOCKTYPE = 10; // Socket type ai_socktype not supported.
711 EAI_SYSTEM = 11; // System error returned in errno.
712
713const
714 WSADESCRIPTION_LEN = 256;
715 WSASYS_STATUS_LEN = 128;
716type
717 PWSAData = ^TWSAData;
718 TWSAData = packed record
719 wVersion: Word;
720 wHighVersion: Word;
721 szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar;
722 szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar;
723 iMaxSockets: Word;
724 iMaxUdpDg: Word;
725 lpVendorInfo: PAnsiChar;
726 end;
727
728 function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
729 function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
730 function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
731 function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
732 function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
733 function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
734 procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
735 procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
736var
737 in6addr_any, in6addr_loopback : TInAddr6;
738
739procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
740function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
741procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
742procedure FD_ZERO(var FDSet: TFDSet);
743
744{=============================================================================}
745
746type
747 TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer;
748 stdcall;
749 TWSACleanup = function: Integer;
750 stdcall;
751 TWSAGetLastError = function: Integer;
752 stdcall;
753 TGetServByName = function(name, proto: PAnsiChar): PServEnt;
754 stdcall;
755 TGetServByPort = function(port: Integer; proto: PAnsiChar): PServEnt;
756 stdcall;
757 TGetProtoByName = function(name: PAnsiChar): PProtoEnt;
758 stdcall;
759 TGetProtoByNumber = function(proto: Integer): PProtoEnt;
760 stdcall;
761 TGetHostByName = function(name: PAnsiChar): PHostEnt;
762 stdcall;
763 TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt;
764 stdcall;
765 TGetHostName = function(name: PAnsiChar; len: Integer): Integer;
766 stdcall;
767 TShutdown = function(s: TSocket; how: Integer): Integer;
768 stdcall;
769 TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
770 optlen: Integer): Integer;
771 stdcall;
772 TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
773 var optlen: Integer): Integer;
774 stdcall;
775 TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
776 tolen: Integer): Integer;
777 stdcall;
778 TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer;
779 stdcall;
780 TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer;
781 stdcall;
782 TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
783 var fromlen: Integer): Integer;
784 stdcall;
785 Tntohs = function(netshort: u_short): u_short;
786 stdcall;
787 Tntohl = function(netlong: u_long): u_long;
788 stdcall;
789 TListen = function(s: TSocket; backlog: Integer): Integer;
790 stdcall;
791 TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer;
792 stdcall;
793 TInet_ntoa = function(inaddr: TInAddr): PAnsiChar;
794 stdcall;
795 TInet_addr = function(cp: PAnsiChar): u_long;
796 stdcall;
797 Thtons = function(hostshort: u_short): u_short;
798 stdcall;
799 Thtonl = function(hostlong: u_long): u_long;
800 stdcall;
801 TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
802 stdcall;
803 TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
804 stdcall;
805 TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
806 stdcall;
807 TCloseSocket = function(s: TSocket): Integer;
808 stdcall;
809 TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
810 stdcall;
811 TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
812 stdcall;
813 TTSocket = function(af, Struc, Protocol: Integer): TSocket;
814 stdcall;
815 TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
816 timeout: PTimeVal): Longint;
817 stdcall;
818
819 TGetAddrInfo = function(NodeName: PAnsiChar; ServName: PAnsiChar; Hints: PAddrInfo;
820 var Addrinfo: PAddrInfo): integer;
821 stdcall;
822 TFreeAddrInfo = procedure(ai: PAddrInfo);
823 stdcall;
824 TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PAnsiChar;
825 hostlen: DWORD; serv: PAnsiChar; servlen: DWORD; flags: integer): integer;
826 stdcall;
827
828 T__WSAFDIsSet = function (s: TSocket; var FDSet: TFDSet): Bool;
829 stdcall;
830
831 TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
832 cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
833 lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
834 lpCompletionRoutine: pointer): u_int;
835 stdcall;
836
837var
838 WSAStartup: TWSAStartup = nil;
839 WSACleanup: TWSACleanup = nil;
840 WSAGetLastError: TWSAGetLastError = nil;
841 GetServByName: TGetServByName = nil;
842 GetServByPort: TGetServByPort = nil;
843 GetProtoByName: TGetProtoByName = nil;
844 GetProtoByNumber: TGetProtoByNumber = nil;
845 GetHostByName: TGetHostByName = nil;
846 GetHostByAddr: TGetHostByAddr = nil;
847 ssGetHostName: TGetHostName = nil;
848 Shutdown: TShutdown = nil;
849 SetSockOpt: TSetSockOpt = nil;
850 GetSockOpt: TGetSockOpt = nil;
851 ssSendTo: TSendTo = nil;
852 ssSend: TSend = nil;
853 ssRecv: TRecv = nil;
854 ssRecvFrom: TRecvFrom = nil;
855 ntohs: Tntohs = nil;
856 ntohl: Tntohl = nil;
857 Listen: TListen = nil;
858 IoctlSocket: TIoctlSocket = nil;
859 Inet_ntoa: TInet_ntoa = nil;
860 Inet_addr: TInet_addr = nil;
861 htons: Thtons = nil;
862 htonl: Thtonl = nil;
863 ssGetSockName: TGetSockName = nil;
864 ssGetPeerName: TGetPeerName = nil;
865 ssConnect: TConnect = nil;
866 CloseSocket: TCloseSocket = nil;
867 ssBind: TBind = nil;
868 ssAccept: TAccept = nil;
869 Socket: TTSocket = nil;
870 Select: TSelect = nil;
871
872 GetAddrInfo: TGetAddrInfo = nil;
873 FreeAddrInfo: TFreeAddrInfo = nil;
874 GetNameInfo: TGetNameInfo = nil;
875
876 __WSAFDIsSet: T__WSAFDIsSet = nil;
877
878 WSAIoctl: TWSAIoctl = nil;
879
880var
881 SynSockCS: SyncObjs.TCriticalSection;
882 SockEnhancedApi: Boolean;
883 SockWship6Api: Boolean;
884
885type
886 TVarSin = packed record
887 case integer of
888 0: (AddressFamily: u_short);
889 1: (
890 case sin_family: u_short of
891 AF_INET: (sin_port: u_short;
892 sin_addr: TInAddr;
893 sin_zero: array[0..7] of byte);
894 AF_INET6: (sin6_port: u_short;
895 sin6_flowinfo: u_long;
896 sin6_addr: TInAddr6;
897 sin6_scope_id: u_long);
898 );
899 end;
900
901function SizeOfVarSin(sin: TVarSin): integer;
902
903function Bind(s: TSocket; const addr: TVarSin): Integer;
904function Connect(s: TSocket; const name: TVarSin): Integer;
905function GetSockName(s: TSocket; var name: TVarSin): Integer;
906function GetPeerName(s: TSocket; var name: TVarSin): Integer;
907function GetHostName: AnsiString;
908function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
909function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
910function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
911function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
912function Accept(s: TSocket; var addr: TVarSin): TSocket;
913
914function IsNewApi(Family: integer): Boolean;
915function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
916function GetSinIP(Sin: TVarSin): AnsiString;
917function GetSinPort(Sin: TVarSin): Integer;
918procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings);
919function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
920function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
921
922{==============================================================================}
923implementation
924
925var
926 SynSockCount: Integer = 0;
927 LibHandle: THandle = 0;
928 Libwship6Handle: THandle = 0;
929
930function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
931begin
932 Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
933 (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
934end;
935
936function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
937begin
938 Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
939 (a^.u6_addr32[2] = 0) and
940 (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
941 (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
942end;
943
944function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
945begin
946 Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
947end;
948
949function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
950begin
951 Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
952end;
953
954function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
955begin
956 Result := (a^.u6_addr8[0] = $FF);
957end;
958
959function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
960begin
961 Result := (CompareMem( a, b, sizeof(TInAddr6)));
962end;
963
964procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
965begin
966 FillChar(a^, sizeof(TInAddr6), 0);
967end;
968
969procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
970begin
971 FillChar(a^, sizeof(TInAddr6), 0);
972 a^.u6_addr8[15] := 1;
973end;
974
975{=============================================================================}
976procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
977var
978 I: Integer;
979begin
980 I := 0;
981 while I < FDSet.fd_count do
982 begin
983 if FDSet.fd_array[I] = Socket then
984 begin
985 while I < FDSet.fd_count - 1 do
986 begin
987 FDSet.fd_array[I] := FDSet.fd_array[I + 1];
988 Inc(I);
989 end;
990 Dec(FDSet.fd_count);
991 Break;
992 end;
993 Inc(I);
994 end;
995end;
996
997function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
998begin
999 Result := __WSAFDIsSet(Socket, FDSet);
1000end;
1001
1002procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
1003begin
1004 if FDSet.fd_count < FD_SETSIZE then
1005 begin
1006 FDSet.fd_array[FDSet.fd_count] := Socket;
1007 Inc(FDSet.fd_count);
1008 end;
1009end;
1010
1011procedure FD_ZERO(var FDSet: TFDSet);
1012begin
1013 FDSet.fd_count := 0;
1014end;
1015
1016{=============================================================================}
1017
1018function SizeOfVarSin(sin: TVarSin): integer;
1019begin
1020 case sin.sin_family of
1021 AF_INET:
1022 Result := SizeOf(TSockAddrIn);
1023 AF_INET6:
1024 Result := SizeOf(TSockAddrIn6);
1025 else
1026 Result := 0;
1027 end;
1028end;
1029
1030{=============================================================================}
1031
1032function Bind(s: TSocket; const addr: TVarSin): Integer;
1033begin
1034 Result := ssBind(s, @addr, SizeOfVarSin(addr));
1035end;
1036
1037function Connect(s: TSocket; const name: TVarSin): Integer;
1038begin
1039 Result := ssConnect(s, @name, SizeOfVarSin(name));
1040end;
1041
1042function GetSockName(s: TSocket; var name: TVarSin): Integer;
1043var
1044 len: integer;
1045begin
1046 len := SizeOf(name);
1047 FillChar(name, len, 0);
1048 Result := ssGetSockName(s, @name, Len);
1049end;
1050
1051function GetPeerName(s: TSocket; var name: TVarSin): Integer;
1052var
1053 len: integer;
1054begin
1055 len := SizeOf(name);
1056 FillChar(name, len, 0);
1057 Result := ssGetPeerName(s, @name, Len);
1058end;
1059
1060function GetHostName: AnsiString;
1061var
1062 s: AnsiString;
1063begin
1064 Result := '';
1065 setlength(s, 255);
1066 ssGetHostName(pAnsichar(s), Length(s) - 1);
1067 Result := PAnsichar(s);
1068end;
1069
1070function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
1071begin
1072 Result := ssSend(s, Buf^, len, flags);
1073end;
1074
1075function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
1076begin
1077 Result := ssRecv(s, Buf^, len, flags);
1078end;
1079
1080function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
1081begin
1082 Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto));
1083end;
1084
1085function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
1086var
1087 x: integer;
1088begin
1089 x := SizeOf(from);
1090 Result := ssRecvFrom(s, Buf^, len, flags, @from, x);
1091end;
1092
1093function Accept(s: TSocket; var addr: TVarSin): TSocket;
1094var
1095 x: integer;
1096begin
1097 x := SizeOf(addr);
1098 Result := ssAccept(s, @addr, x);
1099end;
1100
1101{=============================================================================}
1102function IsNewApi(Family: integer): Boolean;
1103begin
1104 Result := SockEnhancedApi;
1105 if not Result then
1106 Result := (Family = AF_INET6) and SockWship6Api;
1107end;
1108
1109function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
1110type
1111 pu_long = ^u_long;
1112var
1113 ProtoEnt: PProtoEnt;
1114 ServEnt: PServEnt;
1115 HostEnt: PHostEnt;
1116 r: integer;
1117 Hints1, Hints2: TAddrInfo;
1118 Sin1, Sin2: TVarSin;
1119 TwoPass: boolean;
1120
1121 function GetAddr(const IP, port: AnsiString; Hints: TAddrInfo; var Sin: TVarSin): integer;
1122 var
1123 Addr: PAddrInfo;
1124 begin
1125 Addr := nil;
1126 try
1127 FillChar(Sin, Sizeof(Sin), 0);
1128 if Hints.ai_socktype = SOCK_RAW then
1129 begin
1130 Hints.ai_socktype := 0;
1131 Hints.ai_protocol := 0;
1132 Result := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
1133 end
1134 else
1135 begin
1136 if (IP = cAnyHost) or (IP = c6AnyHost) then
1137 begin
1138 Hints.ai_flags := AI_PASSIVE;
1139 Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
1140 end
1141 else
1142 if (IP = cLocalhost) or (IP = c6Localhost) then
1143 begin
1144 Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
1145 end
1146 else
1147 begin
1148 Result := synsock.GetAddrInfo(PAnsiChar(IP), PAnsiChar(Port), @Hints, Addr);
1149 end;
1150 end;
1151 if Result = 0 then
1152 if (Addr <> nil) then
1153 Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
1154 finally
1155 if Assigned(Addr) then
1156 synsock.FreeAddrInfo(Addr);
1157 end;
1158 end;
1159
1160begin
1161 Result := 0;
1162 FillChar(Sin, Sizeof(Sin), 0);
1163 if not IsNewApi(family) then
1164 begin
1165 SynSockCS.Enter;
1166 try
1167 Sin.sin_family := AF_INET;
1168 ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
1169 ServEnt := nil;
1170 if ProtoEnt <> nil then
1171 ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
1172 if ServEnt = nil then
1173 Sin.sin_port := synsock.htons(StrToIntDef(Port, 0))
1174 else
1175 Sin.sin_port := ServEnt^.s_port;
1176 if IP = cBroadcast then
1177 Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
1178 else
1179 begin
1180 Sin.sin_addr.s_addr := synsock.inet_addr(PAnsiChar(IP));
1181 if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
1182 begin
1183 HostEnt := synsock.GetHostByName(PAnsiChar(IP));
1184 Result := synsock.WSAGetLastError;
1185 if HostEnt <> nil then
1186 Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
1187 end;
1188 end;
1189 finally
1190 SynSockCS.Leave;
1191 end;
1192 end
1193 else
1194 begin
1195 FillChar(Hints1, Sizeof(Hints1), 0);
1196 FillChar(Hints2, Sizeof(Hints2), 0);
1197 TwoPass := False;
1198 if Family = AF_UNSPEC then
1199 begin
1200 if PreferIP4 then
1201 begin
1202 Hints1.ai_family := AF_INET;
1203 Hints2.ai_family := AF_INET6;
1204 TwoPass := True;
1205 end
1206 else
1207 begin
1208 Hints2.ai_family := AF_INET;
1209 Hints1.ai_family := AF_INET6;
1210 TwoPass := True;
1211 end;
1212 end
1213 else
1214 Hints1.ai_family := Family;
1215
1216 Hints1.ai_socktype := SockType;
1217 Hints1.ai_protocol := SockProtocol;
1218 Hints2.ai_socktype := Hints1.ai_socktype;
1219 Hints2.ai_protocol := Hints1.ai_protocol;
1220
1221 r := GetAddr(IP, Port, Hints1, Sin1);
1222 Result := r;
1223 sin := sin1;
1224 if r <> 0 then
1225 if TwoPass then
1226 begin
1227 r := GetAddr(IP, Port, Hints2, Sin2);
1228 Result := r;
1229 if r = 0 then
1230 sin := sin2;
1231 end;
1232 end;
1233end;
1234
1235function GetSinIP(Sin: TVarSin): AnsiString;
1236var
1237 p: PAnsiChar;
1238 host, serv: AnsiString;
1239 hostlen, servlen: integer;
1240 r: integer;
1241begin
1242 Result := '';
1243 if not IsNewApi(Sin.AddressFamily) then
1244 begin
1245 p := synsock.inet_ntoa(Sin.sin_addr);
1246 if p <> nil then
1247 Result := p;
1248 end
1249 else
1250 begin
1251 hostlen := NI_MAXHOST;
1252 servlen := NI_MAXSERV;
1253 setlength(host, hostlen);
1254 setlength(serv, servlen);
1255 r := getnameinfo(@sin, SizeOfVarSin(sin), PAnsiChar(host), hostlen,
1256 PAnsiChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
1257 if r = 0 then
1258 Result := PAnsiChar(host);
1259 end;
1260end;
1261
1262function GetSinPort(Sin: TVarSin): Integer;
1263begin
1264 if (Sin.sin_family = AF_INET6) then
1265 Result := synsock.ntohs(Sin.sin6_port)
1266 else
1267 Result := synsock.ntohs(Sin.sin_port);
1268end;
1269
1270procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings);
1271type
1272 TaPInAddr = array[0..250] of PInAddr;
1273 PaPInAddr = ^TaPInAddr;
1274var
1275 Hints: TAddrInfo;
1276 Addr: PAddrInfo;
1277 AddrNext: PAddrInfo;
1278 r: integer;
1279 host, serv: AnsiString;
1280 hostlen, servlen: integer;
1281 RemoteHost: PHostEnt;
1282 IP: u_long;
1283 PAdrPtr: PaPInAddr;
1284 i: Integer;
1285 s: AnsiString;
1286 InAddr: TInAddr;
1287begin
1288 IPList.Clear;
1289 if not IsNewApi(Family) then
1290 begin
1291 IP := synsock.inet_addr(PAnsiChar(Name));
1292 if IP = u_long(INADDR_NONE) then
1293 begin
1294 SynSockCS.Enter;
1295 try
1296 RemoteHost := synsock.GetHostByName(PAnsiChar(Name));
1297 if RemoteHost <> nil then
1298 begin
1299 PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
1300 i := 0;
1301 while PAdrPtr^[i] <> nil do
1302 begin
1303 InAddr := PAdrPtr^[i]^;
1304 s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
1305 InAddr.S_bytes[2], InAddr.S_bytes[3]]);
1306 IPList.Add(s);
1307 Inc(i);
1308 end;
1309 end;
1310 finally
1311 SynSockCS.Leave;
1312 end;
1313 end
1314 else
1315 IPList.Add(Name);
1316 end
1317 else
1318 begin
1319 Addr := nil;
1320 try
1321 FillChar(Hints, Sizeof(Hints), 0);
1322 Hints.ai_family := AF_UNSPEC;
1323 Hints.ai_socktype := SockType;
1324 Hints.ai_protocol := SockProtocol;
1325 Hints.ai_flags := 0;
1326 r := synsock.GetAddrInfo(PAnsiChar(Name), nil, @Hints, Addr);
1327 if r = 0 then
1328 begin
1329 AddrNext := Addr;
1330 while not(AddrNext = nil) do
1331 begin
1332 if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
1333 or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
1334 begin
1335 hostlen := NI_MAXHOST;
1336 servlen := NI_MAXSERV;
1337 setlength(host, hostlen);
1338 setlength(serv, servlen);
1339 r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
1340 PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
1341 NI_NUMERICHOST + NI_NUMERICSERV);
1342 if r = 0 then
1343 begin
1344 host := PAnsiChar(host);
1345 IPList.Add(host);
1346 end;
1347 end;
1348 AddrNext := AddrNext^.ai_next;
1349 end;
1350 end;
1351 finally
1352 if Assigned(Addr) then
1353 synsock.FreeAddrInfo(Addr);
1354 end;
1355 end;
1356 if IPList.Count = 0 then
1357 IPList.Add(cAnyHost);
1358end;
1359
1360function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
1361var
1362 ProtoEnt: PProtoEnt;
1363 ServEnt: PServEnt;
1364 Hints: TAddrInfo;
1365 Addr: PAddrInfo;
1366 r: integer;
1367begin
1368 Result := 0;
1369 if not IsNewApi(Family) then
1370 begin
1371 SynSockCS.Enter;
1372 try
1373 ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
1374 ServEnt := nil;
1375 if ProtoEnt <> nil then
1376 ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
1377 if ServEnt = nil then
1378 Result := StrToIntDef(Port, 0)
1379 else
1380 Result := synsock.htons(ServEnt^.s_port);
1381 finally
1382 SynSockCS.Leave;
1383 end;
1384 end
1385 else
1386 begin
1387 Addr := nil;
1388 try
1389 FillChar(Hints, Sizeof(Hints), 0);
1390 Hints.ai_family := AF_UNSPEC;
1391 Hints.ai_socktype := SockType;
1392 Hints.ai_protocol := Sockprotocol;
1393 Hints.ai_flags := AI_PASSIVE;
1394 r := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
1395 if (r = 0) and Assigned(Addr) then
1396 begin
1397 if Addr^.ai_family = AF_INET then
1398 Result := synsock.htons(Addr^.ai_addr^.sin_port);
1399 if Addr^.ai_family = AF_INET6 then
1400 Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
1401 end;
1402 finally
1403 if Assigned(Addr) then
1404 synsock.FreeAddrInfo(Addr);
1405 end;
1406 end;
1407end;
1408
1409function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
1410var
1411 Hints: TAddrInfo;
1412 Addr: PAddrInfo;
1413 r: integer;
1414 host, serv: AnsiString;
1415 hostlen, servlen: integer;
1416 RemoteHost: PHostEnt;
1417 IPn: u_long;
1418begin
1419 Result := IP;
1420 if not IsNewApi(Family) then
1421 begin
1422 IPn := synsock.inet_addr(PAnsiChar(IP));
1423 if IPn <> u_long(INADDR_NONE) then
1424 begin
1425 SynSockCS.Enter;
1426 try
1427 RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
1428 if RemoteHost <> nil then
1429 Result := RemoteHost^.h_name;
1430 finally
1431 SynSockCS.Leave;
1432 end;
1433 end;
1434 end
1435 else
1436 begin
1437 Addr := nil;
1438 try
1439 FillChar(Hints, Sizeof(Hints), 0);
1440 Hints.ai_family := AF_UNSPEC;
1441 Hints.ai_socktype := SockType;
1442 Hints.ai_protocol := SockProtocol;
1443 Hints.ai_flags := 0;
1444 r := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
1445 if (r = 0) and Assigned(Addr)then
1446 begin
1447 hostlen := NI_MAXHOST;
1448 servlen := NI_MAXSERV;
1449 setlength(host, hostlen);
1450 setlength(serv, servlen);
1451 r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
1452 PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
1453 NI_NUMERICSERV);
1454 if r = 0 then
1455 Result := PAnsiChar(host);
1456 end;
1457 finally
1458 if Assigned(Addr) then
1459 synsock.FreeAddrInfo(Addr);
1460 end;
1461 end;
1462end;
1463
1464{=============================================================================}
1465
1466function InitSocketInterface(stack: String): Boolean;
1467begin
1468 Result := False;
1469 SockEnhancedApi := False;
1470 if stack = '' then
1471 stack := DLLStackName;
1472 SynSockCS.Enter;
1473 try
1474 if SynSockCount = 0 then
1475 begin
1476 SockEnhancedApi := False;
1477 SockWship6Api := False;
1478 LibHandle := LoadLibrary(PChar(Stack));
1479 if LibHandle <> 0 then
1480 begin
1481 WSAIoctl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAIoctl')));
1482 __WSAFDIsSet := GetProcAddress(LibHandle, PAnsiChar(AnsiString('__WSAFDIsSet')));
1483 CloseSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('closesocket')));
1484 IoctlSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ioctlsocket')));
1485 WSAGetLastError := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAGetLastError')));
1486 WSAStartup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAStartup')));
1487 WSACleanup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSACleanup')));
1488 ssAccept := GetProcAddress(LibHandle, PAnsiChar(AnsiString('accept')));
1489 ssBind := GetProcAddress(LibHandle, PAnsiChar(AnsiString('bind')));
1490 ssConnect := GetProcAddress(LibHandle, PAnsiChar(AnsiString('connect')));
1491 ssGetPeerName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getpeername')));
1492 ssGetSockName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockname')));
1493 GetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockopt')));
1494 Htonl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htonl')));
1495 Htons := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htons')));
1496 Inet_Addr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_addr')));
1497 Inet_Ntoa := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_ntoa')));
1498 Listen := GetProcAddress(LibHandle, PAnsiChar(AnsiString('listen')));
1499 Ntohl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohl')));
1500 Ntohs := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohs')));
1501 ssRecv := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recv')));
1502 ssRecvFrom := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recvfrom')));
1503 Select := GetProcAddress(LibHandle, PAnsiChar(AnsiString('select')));
1504 ssSend := GetProcAddress(LibHandle, PAnsiChar(AnsiString('send')));
1505 ssSendTo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('sendto')));
1506 SetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('setsockopt')));
1507 ShutDown := GetProcAddress(LibHandle, PAnsiChar(AnsiString('shutdown')));
1508 Socket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('socket')));
1509 GetHostByAddr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyaddr')));
1510 GetHostByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyname')));
1511 GetProtoByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobyname')));
1512 GetProtoByNumber := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobynumber')));
1513 GetServByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyname')));
1514 GetServByPort := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyport')));
1515 ssGetHostName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostname')));
1516
1517{$IFNDEF FORCEOLDAPI}
1518 GetAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getaddrinfo')));
1519 FreeAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('freeaddrinfo')));
1520 GetNameInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getnameinfo')));
1521 SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
1522 and Assigned(GetNameInfo);
1523 if not SockEnhancedApi then
1524 begin
1525 LibWship6Handle := LoadLibrary(PChar(DLLWship6));
1526 if LibWship6Handle <> 0 then
1527 begin
1528 GetAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getaddrinfo')));
1529 FreeAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('freeaddrinfo')));
1530 GetNameInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getnameinfo')));
1531 SockWship6Api := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
1532 and Assigned(GetNameInfo);
1533 end;
1534 end;
1535{$ENDIF}
1536 Result := True;
1537 end;
1538 end
1539 else Result := True;
1540 if Result then
1541 Inc(SynSockCount);
1542 finally
1543 SynSockCS.Leave;
1544 end;
1545end;
1546
1547function DestroySocketInterface: Boolean;
1548begin
1549 SynSockCS.Enter;
1550 try
1551 Dec(SynSockCount);
1552 if SynSockCount < 0 then
1553 SynSockCount := 0;
1554 if SynSockCount = 0 then
1555 begin
1556 if LibHandle <> 0 then
1557 begin
1558 FreeLibrary(libHandle);
1559 LibHandle := 0;
1560 end;
1561 if LibWship6Handle <> 0 then
1562 begin
1563 FreeLibrary(LibWship6Handle);
1564 LibWship6Handle := 0;
1565 end;
1566 end;
1567 finally
1568 SynSockCS.Leave;
1569 end;
1570 Result := True;
1571end;
1572
1573initialization
1574begin
1575 SynSockCS := SyncObjs.TCriticalSection.Create;
1576 SET_IN6_IF_ADDR_ANY (@in6addr_any);
1577 SET_LOOPBACK_ADDR6 (@in6addr_loopback);
1578end;
1579
1580finalization
1581begin
1582 SynSockCS.Free;
1583end;
1584
1585{$ENDIF}
Note: See TracBrowser for help on using the repository browser.