[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]

    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.

[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]