UNIT Winsock; { WINSOCK.H converted to Pascal - Darryl Luff 15Nov95 } { Not fully tested, please send corrections to either:} { dluff@ibm.net, luffd@ocean.com.au, or } { Darryl Luff at Fido 3:632/506.4 } interface USES WinTypes; TYPE { basic type definitions, from BSD sys/types.h } u_char = Byte; u_short = Word; u_int = Word; u_long = Longint; { not really, as longint is signed } { new type to be used in all instances which refer to sockets } TSocket = u_int; { macros to manipulate the socket arrays } CONST FD_SETSIZE = 64; TYPE Tfd_set = Record { originally fd_set but name clashed } fd_count : u_short; fd_array : Array[0..FD_SETSIZE-1] OF TSocket; END; FUNCTION __WSAFDIsSet(s : TSocket; VAR fds : Tfd_set): Integer; {external } PROCEDURE FD_CLR(fd : TSocket; VAR fdset : Tfd_set); FUNCTION FD_ISSET(fd : TSocket; VAR fdset : Tfd_set): Integer; PROCEDURE FD_SET(fd : TSocket; VAR fdset : Tfd_set); PROCEDURE FD_ZERO(VAR fdset : Tfd_set); { structure used in select() call, from BSD sys/time.h } TYPE timeval = Record tv_sec, { seconds } tv_usec : Longint; { microseconds } END; { operations on timevals } FUNCTION timerisset(tvp : timeval): Longint; FUNCTION timercmp(tvp, uvp : timeval; cmp : String): Boolean; { the original timercmp took a third parameter of the operator } { (was a 'c' macro. But, the original couldn't handle 2 } { character operators ('>=' etc) so we're a bit better off. } { commands for ioctlsocket(), taken from BSD fcntl.h } CONST IOCPARM_MASK = $7F; { parms must be <= 128 bytes } IOC_VOID = $20000000; { no parameters } IOC_OUT = $40000000; { copy out parameters } IOC_IN = $80000000; { copy in parameters } IOC_INOUT = IOC_IN OR IOC_OUT; { $20000000 distinguishes new and old ioctl's } FUNCTION _IO(x, y : Byte): Longint; FUNCTION _IOR(x : Char; y : Byte; tSize : Integer): Longint; { original took a type as the third parameter, and } { used 'sizeof' to get size. (c macro) } FUNCTION _IOW(x : Char; y, tSize : Longint): Longint; {FUNCTION _IOW(x : Char; y : Byte; tSize : Word): Longint;} { as above } FUNCTION FIONREAD: Longint; { get number of bytes to read } FUNCTION FIONBIO: Longint; { set/clear non-blocking I/O } FUNCTION FIOASYNC: Longint; { set/clear async I/O } FUNCTION SIOCSHIWAT: Longint; {set high watermark } FUNCTION SIOCGHIWAT: Longint; { get high watermark } FUNCTION SIOCSLOWAT: Longint; { set lo watermark } FUNCTION SIOCGLOWAT: Longint; { get lo watermark } FUNCTION SIOCATMARK: Longint; { at oob mark ? } { structures returned by network database library, taken } { from BSD file netdb.h. All addresses are supplied in } { host order, and returned in network order. } CONST MAXALIASES = 99; { ? } MAXADDRESSES = 99; {?} TYPE PAliasList = ^TAliasList; TAliasList = Array[0..MAXALIASES-1] OF PChar; PAddressList = ^TAddressList; TAddressList = Array[0..MAXADDRESSES-1] OF ^u_long; { I made these up for the below } Phostent = ^hostent; hostent = Record h_name : PChar; { official name of host } h_aliases : PAliasList; { see above } h_addrtype : Integer; { host address type } h_length : Integer; { length of address } CASE Boolean OF False : (h_addr_list : PAddressList); True : (h_addr : ^u_long); { #define h_addr h_addr_list[0] for compatibility } END; { assumed here that a network number fits into 32 bits } netent = Record n_name : PChar; { official name of net } n_aliases : PAliasList; { alias list } n_addrtype : Integer; { net address type } n_net : Longint; { network # } END; Pservent = ^servent; servent = Record s_name : PChar; { official service name } s_aliases : PAliasList; { alias list } s_port : Integer; { port # } s_proto : PChar; { protocol to use } END; Pprotoent = ^protoent; protoent = Record p_name : PChar; { official protocol name } p_aliases : PAliasList; { alias list } p_proto : Integer; { protocol # } END; { constants and structures defined by the internet system, } { Per RFC790, Sept. 1981. taken from BSD netinet/in.h } CONST { protocols } IPPROTO_IP = 0; { dummy for IP } IPPROTO_ICMP = 1; { control message protocol } IPPROTO_GGP = 2; { gateway^2 (deprecated) } IPPROTO_TCP = 6; { tcp } IPPROTO_PUP = 12; { pup } IPPROTO_UDP = 17; { udp } IPPROTO_IDP = 22; { xns idp } IPPROTO_ND = 77; { UNOFFICIAL net disk proto } IPPROTO_RAW = 255; { raw IP packet } IPPROTO_MAX = 256; { port/socket numbers: network standard functions } IPPORT_ECHO = 7; IPPORT_DISCARD = 9; IPPORT_SYSTAT = 11; IPPORT_DAYTIME = 13; IPPORT_NETSTAT = 15; IPPORT_FTP = 21; IPPORT_TELNET = 23; IPPORT_SMTP = 25; IPPORT_TIMESERVER = 37; IPPORT_NAMESERVER = 42; IPPORT_WHOIS = 43; IPPORT_MTP = 57; { port/socket numbers: host specific functions } IPPORT_TFTP = 69; IPPORT_RJE = 77; IPPORT_FINGER = 79; IPPORT_TTYLINK = 87; IPPORT_SUPDUP = 95; { UNIX TCP sockets } IPPORT_EXECSERVER = 512; IPPORT_LOGINSERVER = 513; IPPORT_CMDSERVER = 514; IPPORT_EFSSERVER = 520; { UNIX UDP sockets } IPPORT_BIFFUDP = 512; IPPORT_WHOSERVER = 513; IPPORT_ROUTESERVER = 520; { ports < IPPORT_RESERVED are reserved for } { priveledged processes (eg. root) } IPPORT_RESERVED = 1024; { link numbers } IMPLINK_IP = 155; IMPLINK_LOWEXPER = 156; IMPLINK_HIGHEXPER = 158; TYPE { internet address (old style... should be updated } in_addr = Record CASE Integer OF 0 : (s_b1, s_b2, s_b3, s_b4 : Byte); {S_un_b} 1 : (s_w1, s_w2 : Word); {S_un_w} 2 : (s_addr : Longint) {S_addr} END; { S_un; } {#define s_addr S_un.s_addr} {#define s_host S_un.s_un_b.s_b2} {#define s_net S_un.S_un_b.s_b1} {#define s_imp S_un.S_un_w.s_w2} {#define s_impno S_un_b.s_b4} {#define s_lh S_un.S_un_b.b_s3} CONST { definition of bits in internet address integers. } { on subnets, the decomposition of addresses to } { host and net parts is done according to the } { subnet masks, not the masks here. } {#define IN_CLASSA(i) (((long)(i) & 0x80000000) == 0) } IN_CLASSA_NET = $FF000000; IN_CLASSA_NSHIFT = 24; IN_CLASSA_HOST = $00FFFFFF; IN_CLASSA_MAX = 128; {#define IN_CLASSB(i) (((long)(i) & 0xc0000000) == 0x80000000) } IN_CLASSB_NET = $FFFF0000; IN_CLASSB_NSHIFT = 16; IN_CLASSB_HOST = $0000FFFF; IN_CLASSB_MAX = 65536; {#define IN_CLASSC(i) (((long)(i) & 0xc0000000) == 0xc0000000) } IN_CLASSC_NET = $FFFFFF00; IN_CLASSC_NSHIFT = 8; IN_CLASSC_HOST = $000000FF; INADDR_ANY = $00000000; INADDR_LOOPBACK = $7F000001; INADDR_BROADCAST = $FFFFFFFF; INADDR_NONE = $FFFFFFFF; TYPE { socket addresses, internet style } sockaddr_in = Record sin_family : Integer; sin_port : u_short; sin_addr : in_addr; sin_zero : Array[0..7] OF Char END; CONST WSADESCRIPTION_LEN = 256; WSASYS_STATUS_LEN = 128; TYPE WSAData = Record wVersion : WORD; wHighVersion : WORD; szDescription : Array[0..WSADESCRIPTION_LEN+1] OF Char; szSystemStatus : Array[0..WSASYS_STATUS_LEN+1] OF Char; iMaxSockets : Word; { unsigned short } iMaxUdpDg : Word; { unsigned short } lpVendorInfo : Pointer; END; LPWSADATA = ^WSAData; { options for use with [gs]etsockopt at the IP level } CONST IP_OPTIONS = 1; { set/get IP per-packet options } { definitions related to sockets: types, address families, options } { taken from BSD sys/socket.h } { this is used instead of -1, since the TSocket type is unsigned } INVALID_SOCKET = NOT(0); SOCKET_ERROR = -1; { types } SOCK_STREAM = 1; { stream socket } SOCK_DGRAM = 2; { datagram socket } SOCK_RAW = 3; { raw-protocol service } SOCK_RDM = 4; { reliably-delivered message } SOCK_SEQPACKET = 5; { sequenced packet stream } { option flags per socket } SO_DEBUG = $0001; { turn on debugging info recording } SO_ACCEOTCONN = $0002; { socket has had listen() } SO_REUSEADDR = $0004; { allow local address reuse } SO_KEEPALIVE = $0008; { keep connections alive } SO_DONTROUTE = $0010; { just use interface addresses } SO_BROADCAST = $0020; { permit sending of broadcast messages } SO_USELOOPBACK = $0040; { bypass hardware when possible } SO_LINGER = $0080; { linger on close if data present } SO_OOBINLINE = $0100; { leave received OOB data in line } SO_DONTLINGER = NOT (SO_LINGER); { additional options } SO_SNDBUF = $1001; { send buffer size } SO_RCVBUF = $1002; { receive buffer size } SO_SNDLOWAT = $1003; { send low-water mark } SO_RCVLOWAT = $1004; { receive low-water mark } SO_SNDTIMEO = $1005; { send timeout } SO_RCVTIMEO = $1006; { receive timeout } SO_ERROR = $1007; { get error status and clear } SO_TYPE = $1008; { get socket type } { TCP options } TCP_NODELAY = $0001; { address families } AF_UNSPEC = 0; { unspecified } AF_UNIX = 1; { local to host (pipes, portals) } AF_INET = 2; { internetwork: UDP, TCP etc } AF_IMPLINK = 3; { arpanet imp addresses } AF_PUP = 4; { pup protocols: eg. BSP } AF_CHAOS = 5; { mit CHAOS protocols } AF_NS = 6; { XEROX NS protocols } AF_ISO = 7; { ISO protocols } AF_OSI = AF_ISO; AF_ECMA = 8; { european computer manufacturers } AF_DATAKIT = 9; { datakit protocols } AF_CCITT = 10; { CCITT protocols, X.25 etc } AF_SNA = 11; { IBM SNA } AF_DECnet = 12; { DECnet } AF_DLI = 13; { Direct data link interface } AF_LAT = 14; { LAT } AF_HYLINK = 15; { NSC Hyperchannel } AF_APPLETALK = 16; { AppleTalk } AF_NETBIOS = 17; { NetBios-style addresses } AF_MAX = 18; TYPE { structure used by the kernel to store most addresses } Psockaddr = ^sockaddr; sockaddr = record sa_family : u_short; { address family } sa_data : Array[0..13] OF Char; { up to 14 bytes of direct address } END; { structure used by the kernel to pass protocol } { information in raw sockets. } sockproto = Record sp_family : u_short; { address family } sp_protocol : u_short; { protocol } END; CONST { protocol families, same as address families for now } PF_UNSPEC = AF_UNSPEC; PF_UNIX = AF_UNIX; PF_INET = AF_INET; PF_IMPLINK = AF_IMPLINK; PF_PUP = AF_PUP; PF_CHAOS = AF_CHAOS; PF_NS = AF_NS; PF_ISO = AF_ISO; PF_OSI = AF_OSI; PF_ECMA = AF_ECMA; PF_DATAKIT = AF_DATAKIT; PF_CCITT = AF_CCITT; PF_SNA = AF_SNA; PF_DECnet = AF_DECnet; PF_DLI = AF_DLI; PF_LAT = AF_LAT; PF_HYLINK = AF_HYLINK; PF_APPLETALK = AF_APPLETALK; PF_MAX = AF_MAX; TYPE { structure used for manipulating linger option } linger = Record l_onoff : u_short; { option on/off } l_linger : u_short; { linger time } END; CONST { level number for (get/set)sockopt() to apply to socket itself } SOL_SOCKET = $FFFF; { OPTIONS FOR SOCKET LEVEL } { MAXIMUM QUEUE LENGTH SPECIFIABLE BY LISTEN } SOMAXCONN = 5; MSG_OOB = 1; { process out-of-band packet } MSG_PEEK = 2; { peek at incoming messages } MSG_DONTROUTE = 4; { send without using routing tables } MSG_MAXIOVLEN = 16; { define constant based on RFC883, used by gethostbyxxxx() calls } MAXGETHOSTSTRUCT = 1024; { define flags to be used with the WSAAsynchSelect() call } FD_READ = $01; FD_WRITE = $02; FD_OOB = $04; FD_ACCEPT = $08; FD_CONNECT = $10; FD_CLOSE = $20; { all windows sockets error constants are biased } { by WSABASEERR from the 'Normal' } WSABASEERR = 10000; WSAEINTR = WSABASEERR+4; WSAEBADF = WSABASEERR+9; WSAEACCES = WSABASEERR+13; WSAEFAULT = WSABASEERR+14; WSAEINVAL = WSABASEERR+22; WSAEMFILE = WSABASEERR+24; { windows sockets definitions of regular berkeley error constants } WSAEWOULDBLOCK = WSABASEERR+35; WSAEINPROGRESS = WSABASEERR+36; WSAEALREADY = WSABASEERR+37; WSAENOTSOCK = WSABASEERR+38; WSAEDESTADDRREQ = WSABASEERR+39; WSAEMSGSIZE = WSABASEERR+40; WSAEPROTOTYPE = WSABASEERR+41; WSAENOPROTOOPT = WSABASEERR+42; WSAEPROTONOSUPPORT = WSABASEERR+43; WSAESOCKTNOSUPPORT = WSABASEERR+44; WSAEOPNOTSUPP = WSABASEERR+45; WSAEPFNOSUPPORT = WSABASEERR+46; WSAEAFNOSUPPORT = WSABASEERR+47; WSAEADDRINUSE = WSABASEERR+48; WSAEADDRNOTAVAIL = WSABASEERR+49; WSAENETDOWN = WSABASEERR+50; WSAENETUNREACH = WSABASEERR+51; WSAENETRESET = WSABASEERR+52; WSAECONNABORTED = WSABASEERR+53; WSAECONNRESET = WSABASEERR+54; WSAENOBUFS = WSABASEERR+55; WSAEISCONN = WSABASEERR+56; WSAENOTCONN = WSABASEERR+57; WSAESHUTDOWN = WSABASEERR+58; WSAETOOMANYREFS = WSABASEERR+59; WSAETIMEDOUT = WSABASEERR+60; WSAECONNREFUSED = WSABASEERR+61; WSAELOOP = WSABASEERR+62; WSAENAMETOOLONG = WSABASEERR+63; WSAEHOSTDOWN = WSABASEERR+64; WSAEHOSTUNREACH = WSABASEERR+65; WSAENOTEMPTY = WSABASEERR+66; WSAEPROCLIM = WSABASEERR+67; WSAEUSERS = WSABASEERR+68; WSAEDQUOT = WSABASEERR+69; WSAESTALE = WSABASEERR+70; WSAEREMOTE = WSABASEERR+71; { extended windows sockets error constant definitions } WSASYSNOTREADY = WSABASEERR+91; WSAVERNOTSUPPORTED = WSABASEERR+92; WSANOTINITIALISED = WSABASEERR+93; { error return codes from gethostbyname() and gethostbyaddr() } { (when using the resolver). note that these errors are } { retrieved via WSAGetLastError() and must therefore follow } { the rules for avoiding clashes with error numbers from } { specific implementations or language run-time systems. for } { this reason the codes are based at WSABASEERR+1001. note } { also that [WSA]NO_ADDRESS is defined only for compatibility } { purposes. } {#define h_errno WSAGetLastError() } FUNCTION h_errno: Longint; CONST { authoritative answer: host not found } WSAHOST_NOT_FOUND = WSABASEERR+1001; HOST_NOT_FOUND = WSAHOST_NOT_FOUND; { non-authoritative: host not found, or SERVERFAIL } WSATRY_AGAIN = WSABASEERR+1002; TRY_AGAIN = WSATRY_AGAIN; { non-recoverable errors, FORMERR, REFUSED, NOTIMP } WSANO_RECOVERY = WSABASEERR+1003; NO_RECOVERY = WSANO_RECOVERY; { valid name, no data record of requested type } WSANO_DATA = WSABASEERR+1004; NO_DATA = WSANO_DATA; { no address, look for MX record } WSANO_ADDRESS = WSANO_DATA; NO_ADDRESS = WSANO_ADDRESS; { windows sockets errors redefined as regular berkley error constants } EWOULDBLOCK = WSAEWOULDBLOCK; EINPROGRESS = WSAEINPROGRESS; EALREADY = WSAEALREADY; ENOTSOCK = WSAENOTSOCK; EDESTADDRREQ = WSAEDESTADDRREQ; EMSGSIZE = WSAEMSGSIZE; EPROTOTYPE = WSAEPROTOTYPE; ENOPROTOOPT = WSAENOPROTOOPT; EPROTONOSUPPORT = WSAEPROTONOSUPPORT; ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; EOPNOTSUPPORT = WSAEOPNOTSUPP; EPFNOSUPPORT = WSAEPFNOSUPPORT; EAFNOSUPPORT = WSAEAFNOSUPPORT; EADDRINUSE = WSAEADDRINUSE; EADDRNOTAVAIL = WSAEADDRNOTAVAIL; ENETDOWN = WSAENETDOWN; ENETUNREACH = WSAENETUNREACH; ENETRESET = WSAENETRESET; ECONNABORTED = WSAECONNABORTED; ECONNRESET = WSAECONNRESET; ENOBUFS = WSAENOBUFS; EISCONNN = WSAEISCONN; ENOTCONN = WSAENOTCONN; ESHUTDOWN = WSAESHUTDOWN; ETOOMANYREFS = WSAETOOMANYREFS; ETIMEDOUT = WSAETIMEDOUT; ECONNREFUSED = WSAECONNREFUSED; ELOOP = WSAELOOP; ENAMETOOLONG = WSAENAMETOOLONG; EHOSTDOWN = WSAEHOSTDOWN; EHOSTUNREACH = WSAEHOSTUNREACH; ENOTEMPTY = WSAENOTEMPTY; EPROCLIM = WSAEPROCLIM; EUSERS = WSAEUSERS; EDQUOT = WSAEDQUOT; ESTALE = WSAESTALE; EREMOTE = WSAEREMOTE; { socket function prototypes } FUNCTION accept(s : TSocket; VAR addr : sockaddr; VAR addrlen : Integer): TSocket; FUNCTION bind(s : TSocket; {const} VAR addr : sockaddr; namelen : Integer): Integer; FUNCTION closesocket(s : TSocket): Integer; FUNCTION connect(s : TSocket; {const}VAR name : sockaddr; namelen : Integer): Integer; FUNCTION ioctlsocket(s : TSocket; cmd : LONGINT; VAR argp : u_long): Integer; FUNCTION gethostname(name : PChar; namelen : Integer): Integer; FUNCTION getpeername(s : TSocket; VAR name : sockaddr; VAR namelen : Integer): Integer; FUNCTION getsockname(s : TSocket; VAR name : sockaddr; namelen : Integer): Integer; FUNCTION getsockopt(s : TSocket; VAR name : sockaddr; namelen : Integer): Integer; FUNCTION htonl(hostlong : u_long): u_long; FUNCTION htons(hostshort: u_short): u_short; FUNCTION inet_addr({const}cp : PChar): u_long; FUNCTION inet_ntoa(in_ : in_addr): Char; FUNCTION listen(s : TSocket; backlog : Integer): Integer; FUNCTION ntohl(netlong : u_long): u_long; FUNCTION ntohs(netshort : u_short): u_short; FUNCTION recv(s : TSocket; buf : Pointer; len, flags : Integer): Integer; FUNCTION recvfrom(s : TSocket; buf : Pointer; len, flags : Integer; VAR from : sockaddr; VAR fromLen : Integer): Integer; FUNCTION select(nfds : Integer; VAR readfds, writefds, exceptfds : Tfd_set; {const}VAR timeout : timeval): Integer; FUNCTION send(s : TSocket; buf : Pointer; len, flags : Integer): Integer; FUNCTION sendto(s : TSocket; buf : Pointer; len, flags : Integer; {const}VAR to_ : sockaddr; tolen : Integer): Integer; FUNCTION setsockopt(s : TSocket; level, optname : Integer; optval : Pointer; optlen : Integer): Integer; FUNCTION shutdown(s : TSocket; how : integer): Integer; FUNCTION socket(af, typ, protocol : Integer): TSocket; { database function prototypes } FUNCTION gethostbyaddr({const}addr : Pointer; len, typ : Integer): Phostent; FUNCTION gethostbyname({const}name : PChar): Phostent; FUNCTION getservbyport(port : Integer; proto : Pointer): Pservent; FUNCTION getservbyname({const}name : PChar; proto : PChar{Pointer}): Pservent; FUNCTION getprotobynumber(proto : Integer): Pprotoent; FUNCTION getprotobyname(name : PChar): Pprotoent; { windows extension function prototypes } FUNCTION WSACleanup: integer; FUNCTION WSAStartup(wVersionRequired : Word; lpwsaData_ : LPWSADATA): Integer; FUNCTION WSASetLastError(iError : Integer): Integer; FUNCTION WSAGetLastError: Integer; FUNCTION WSAIsBlocking: WordBOOL; FUNCTION WSAUnhookBlockingHook: Integer; FUNCTION WSASetBlockingHook(lpBlockFunc : TFARPROC): TFARPROC; FUNCTION WSACancelBlockingCall: Integer; FUNCTION WSAAsyncGetServByName(hWnd_ : HWND; wMsg : u_int; {const} name : PChar; {const} proto : Pointer; buf : Pointer; buflen : Integer): Integer; FUNCTION WSAAsyncGetServByPort(hWnd_ : HWND; wMsg : u_int; port : Integer; {const} proto : Pointer; buf : Pointer; buflen : Integer): Integer; FUNCTION WSAAsyncGetProtoByName(hWnd_ : HWND; wMsg : u_int; {const}name : PChar; buf : Pointer; buflen : Integer): Integer; FUNCTION WSAAsyncGetProtoByNumber(hWnd_ : HWND; wMsg : u_int; number : Integer; buf : Pointer; buflen : Integer): Integer; FUNCTION WSAAsyncGetHostByName(hwnd_ : HWND; wMsg : Integer; name : PChar; buf : Pointer; buflen : Integer): Integer; FUNCTION WSAAsynchGetHostByAddr(hwnd_ : HWND; wMsg : u_int; addr : Pointer; len, typ : Integer; {const}buf : Pointer; buflen : Integer): Integer; FUNCTION WSACancelAsyncRequest(hAsyncTaskhandle : THANDLE): Integer; FUNCTION WSAAsyncSelect(s : TSocket; hwnd_ : HWND; wmsg : u_int; lEvent : Longint): Integer; {TYPE { windows extended data types } {xx not needed xx } implementation PROCEDURE FD_CLR(fd : TSocket; VAR fdset : Tfd_set); VAR q : Integer; BEGIN q := 0; WHILE (q < FD_SETSIZE) AND (fdset.fd_array[q] <> fd) DO Inc(q); IF (fdset.fd_array[q] = fd) THEN BEGIN FOR q := q TO fdset.fd_count-1 DO fdset.fd_array[q] := fdset.fd_array[q+1]; Dec(fdset.fd_count) END END; FUNCTION FD_ISSET(fd : TSocket; VAR fdset : Tfd_set): Integer; BEGIN FD_ISSET := __WSAFDIsSet(fd, fdset) END; PROCEDURE FD_SET(fd : TSocket; VAR fdset : Tfd_set); BEGIN IF (fdset.fd_count < FD_SETSIZE-1) THEN BEGIN Inc(fdset.fd_count); fdset.fd_array[fdset.fd_count] := fd END END; PROCEDURE FD_ZERO(VAR fdset : Tfd_set); BEGIN fdset.fd_count := 0; END; { operations on timevals } FUNCTION timercmp(tvp, uvp : timeval; cmp : String): Boolean; { the original timercmp took a third parameter of the operator } { (was a 'c' macro. But, the original couldn't handle 2 } { character operators ('>=' etc) so we're a bit better off. } BEGIN IF (cmp = '>') THEN BEGIN { greater than? } timercmp := (tvp.tv_sec > uvp.tv_sec) OR ((tvp.tv_sec = uvp.tv_sec) AND (tvp.tv_usec > uvp.tv_usec)) END ELSE IF (cmp = '=') THEN BEGIN { equal ? } timercmp := (tvp.tv_sec = uvp.tv_sec) AND (tvp.tv_usec = uvp.tv_usec) END ELSE IF (cmp = '<') THEN BEGIN { less than? } timercmp := (tvp.tv_sec < uvp.tv_sec) OR ((tvp.tv_sec = uvp.tv_sec) AND (tvp.tv_usec < uvp.tv_usec)) END ELSE IF (cmp = '>=') OR (cmp = '=>') THEN BEGIN { greater or equal? } timercmp := (tvp.tv_sec >= uvp.tv_sec) OR ((tvp.tv_sec = uvp.tv_sec) AND (tvp.tv_usec >= uvp.tv_usec)) END ELSE IF (cmp = '<=') OR (cmp = '=<') THEN BEGIN { less or equal? } timercmp := (tvp.tv_sec <= uvp.tv_sec) OR ((tvp.tv_sec = uvp.tv_sec) AND (tvp.tv_usec <= uvp.tv_usec)) END ELSE { error } timercmp := False; END; FUNCTION timerisset(tvp : timeval): Longint; BEGIN timerisset := tvp.tv_sec OR tvp.tv_usec END; { commands for ioctlsocket() } FUNCTION _IO(x, y : Byte): Longint; BEGIN _IO := IOC_VOID OR (x SHL 8) OR y END; FUNCTION _IOR(x : Char; y : Byte; tSize : Integer): Longint; { original took a type as the third parameter, and } { used 'sizeof' to get size. (c macro) } VAR lRes, lTemp : Longint; BEGIN lRes := IOC_OUT; lTemp := tSize AND IOCPARM_MASK; lRes := lRes OR (lTemp SHL 16); lTemp := Byte(x); lRes := lRes OR (lTemp SHL 8); lRes := lRes OR y; {_IOR := IOC_OUT OR ((tSize AND IOCPARM_MASK) SHL 16) OR (Byte(x) SHL 8) OR y} _IOR := lRes END; FUNCTION _IOW(x : Char; y, tSize : Longint): Longint; { as above } VAR lRes, lTemp : Longint; BEGIN {lRes := IOC_IN; lTemp := tSize AND IOCPARM_MASK; lRes := lRes OR (lTemp SHL 16); lTemp := Byte(x); lRes := lRes OR (lTemp SHL 8); lRes := lRes OR y;} lRes := IOC_IN OR ((tSize AND IOCPARM_MASK) SHL 16) OR (Longint(x) SHL 8) OR y; {_IOW := IOC_IN OR ((tSize AND IOCPARM_MASK) SHL 16) OR (Byte(x) SHL 8) OR y} _IOW := lRes END; FUNCTION FIONREAD: Longint; { get number of bytes to read } BEGIN FIONREAD := _IOR('f', 127, Sizeof(u_long)) END; FUNCTION FIONBIO: Longint; { set/clear non-blocking I/O } BEGIN FIONBIO := _IOW('f', 126, Sizeof(u_long)) END; FUNCTION FIOASYNC: Longint; { set/clear async I/O } BEGIN FIOASYNC := _IOW('f', 125, Sizeof(u_long)) END; FUNCTION SIOCSHIWAT: Longint; {set high watermark } BEGIN SIOCSHIWAT := _IOW('s', 0, Sizeof(u_long)) END; FUNCTION SIOCGHIWAT: Longint; { get high watermark } BEGIN SIOCGHIWAT := _IOR('s', 1, Sizeof(u_long)) END; FUNCTION SIOCSLOWAT: Longint; { set lo watermark } BEGIN SIOCSLOWAT := _IOW('s', 2, Sizeof(u_long)) END; FUNCTION SIOCGLOWAT: Longint; { get lo watermark } BEGIN SIOCGLOWAT := _IOR('s', 3, Sizeof(u_long)) END; FUNCTION SIOCATMARK: Longint; { at oob mark ? } BEGIN SIOCATMARK := _IOR('s', 7, Sizeof(u_long)) END; FUNCTION h_errno: Longint; {#define h_errno WSAGetLastError() } BEGIN h_errno := WSAGetLastError; END; { winsock function prototypes } FUNCTION accept(s : TSocket; VAR addr : sockaddr; VAR addrlen : Integer): TSocket; external 'WINSOCK' index 1; FUNCTION bind(s : TSocket; {const} VAR addr : sockaddr; namelen : Integer): Integer; external 'WINSOCK' index 2; FUNCTION closesocket(s : TSocket): Integer; external 'WINSOCK' index 3; FUNCTION connect(s : TSocket; {const}VAR name : sockaddr; namelen : Integer): Integer; external 'WINSOCK' index 4; FUNCTION getpeername(s : TSocket; VAR name : sockaddr; VAR namelen : Integer): Integer; external 'WINSOCK' index 5; FUNCTION getsockname(s : TSocket; VAR name : sockaddr; namelen : Integer): Integer; external 'WINSOCK' index 6; FUNCTION getsockopt(s : TSocket; VAR name : sockaddr; namelen : Integer): Integer; external 'WINSOCK' index 7; FUNCTION htonl(hostlong : u_long): u_long; external 'WINSOCK' index 8; FUNCTION htons(hostshort: u_short): u_short; external 'WINSOCK' index 9; FUNCTION inet_addr({const}cp : PChar): u_long; external 'WINSOCK' index 10; FUNCTION inet_ntoa(in_ : in_addr): Char; external 'WINSOCK' index 11; FUNCTION ioctlsocket(s : TSocket; cmd : LONGINT; VAR argp : u_long): Integer; external 'WINSOCK' index 12; FUNCTION listen(s : TSocket; backlog : Integer): Integer; external 'WINSOCK' index 13; FUNCTION ntohl(netlong : u_long): u_long; external 'WINSOCK' index 14; FUNCTION ntohs(netshort : u_short): u_short; external 'WINSOCK' index 15; FUNCTION recv(s : TSocket; buf : Pointer; len, flags : Integer): Integer; external 'WINSOCK' index 16; FUNCTION recvfrom(s : TSocket; buf : Pointer; len, flags : Integer; VAR from : sockaddr; VAR fromLen : Integer): Integer; external 'WINSOCK' index 17; FUNCTION select(nfds : Integer; VAR readfds, writefds, exceptfds : Tfd_set; {const}VAR timeout : timeval): Integer; external 'WINSOCK' index 18; FUNCTION send(s : TSocket; buf : Pointer; len, flags : Integer): Integer; external 'WINSOCK' index 19; FUNCTION sendto(s : TSocket; buf : Pointer; len, flags : Integer; {const}VAR to_ : sockaddr; tolen : Integer): Integer; external 'WINSOCK' index 20; FUNCTION setsockopt(s : TSocket; level, optname : Integer; optval : Pointer; optlen : Integer): Integer; external 'WINSOCK' index 21; FUNCTION shutdown(s : TSocket; how : integer): Integer; external 'WINSOCK' index 22; FUNCTION socket(af, typ, protocol : Integer): TSocket; external 'WINSOCK' index 23; { database function prototypes } FUNCTION gethostbyaddr({const}addr : Pointer; len, typ : Integer): Phostent; external 'WINSOCK' index 51; FUNCTION gethostbyname({const}name : PChar): Phostent; external 'WINSOCK' index 52; FUNCTION getprotobyname(name : PChar): Pprotoent; external 'WINSOCK' index 53; FUNCTION getprotobynumber(proto : Integer): Pprotoent; external 'WINSOCK' index 54; FUNCTION getservbyname({const}name : PChar; proto : PChar{Pointer}): Pservent; external 'WINSOCK' index 55; FUNCTION getservbyport(port : Integer; proto : Pointer): Pservent; external 'WINSOCK' index 56; FUNCTION gethostname(name : PChar; namelen : Integer): Integer; external 'WINSOCK' index 57; { windows extension function prototypes } FUNCTION WSAAsyncSelect(s : TSocket; hwnd_ : HWND; wmsg : u_int; lEvent : Longint): Integer; external 'WINSOCK' index 101; FUNCTION WSAAsynchGetHostByAddr(hwnd_ : HWND; wMsg : u_int; addr : Pointer; len, typ : Integer; {const}buf : Pointer; buflen : Integer): Integer; external 'WINSOCK' index 102; FUNCTION WSAAsyncGetHostByName(hwnd_ : HWND; wMsg : Integer; name : PChar; buf : Pointer; buflen : Integer): Integer; external 'WINSOCK' index 103; FUNCTION WSAAsyncGetProtoByNumber(hWnd_ : HWND; wMsg : u_int; number : Integer; buf : Pointer; buflen : Integer): Integer; external 'WINSOCK' index 104; FUNCTION WSAAsyncGetProtoByName(hWnd_ : HWND; wMsg : u_int; {const}name : PChar; buf : Pointer; buflen : Integer): Integer; external 'WINSOCK' index 105; FUNCTION WSAAsyncGetServByPort(hWnd_ : HWND; wMsg : u_int; port : Integer; {const} proto : Pointer; buf : Pointer; buflen : Integer): Integer; external 'WINSOCK' index 106; FUNCTION WSAAsyncGetServByName(hWnd_ : HWND; wMsg : u_int; {const} name : PChar; {const} proto : Pointer; buf : Pointer; buflen : Integer): Integer; external 'WINSOCK' index 107; FUNCTION WSACancelAsyncRequest(hAsyncTaskhandle : THANDLE): Integer; external 'WINSOCK' index 108; FUNCTION WSASetBlockingHook(lpBlockFunc : TFARPROC): TFARPROC; external 'WINSOCK' index 109; FUNCTION WSAUnhookBlockingHook: Integer; external 'WINSOCK' index 110; FUNCTION WSAGetLastError: Integer; external 'WINSOCK' index 111; FUNCTION WSASetLastError(iError : Integer): Integer; external 'WINSOCK' index 112; FUNCTION WSACancelBlockingCall: Integer; external 'WINSOCK' index 113; FUNCTION WSAIsBlocking: WordBOOL; external 'WINSOCK' index 114; FUNCTION WSAStartup(wVersionRequired : Word; lpwsaData_ : LPWSADATA): Integer; external 'WINSOCK' index 115; FUNCTION WSACleanup: integer; external 'WINSOCK' index 116; FUNCTION __WSAFDIsSet(s : TSocket; VAR fds : Tfd_set): Integer; external 'WINSOCK' index 151; END.