{******************************************************************************
  WINSOCK.DLL Interface unit for Delphi 1.0
  Written by David Hollis (hollis@nadn.navy.mil)         3/31/95
  Revised by José Antonio Borges (antonio2@nce.ufrj.br)  1/09/98
*******************************************************************************}

unit Winsock;
interface

uses WinTypes;

const

{* Sockets Error Codes *}
  WSAEINTR             = 10004;
  WSAEBADF             = 10009;
  WSAEACCES            = 10013;
  WSAEFAULT            = 10014;
  WSAEINVAL            = 10022;
  WSAEMFILE            = 10024;
  WSAEWOULDBLOCK       = 10035;
  WSAEINPROGRESS       = 10036;
  WSAEALREADY          = 10037;
  WSAENOTSOCK          = 10038;
  WSAEDESTADDRREQ      = 10039;
  WSAEMSGSIZE          = 10040;
  WSAEPROTOTYPE        = 10041;
  WSAENOPROTOOPT       = 10042;
  WSAEPROTONOSUPPORT   = 10043;
  WSAESOCKNOSUPPORT    = 10044;
  WSAEOPNOTSUPP        = 10045;
  WSAEPFNOSUPPORT      = 10046;
  WSAEAFNOSUPPORT      = 10047;
  WSAEADDRINUSE        = 10048;
  WSAEADDRNOTAVAIL     = 10049;
  WSAENETDOWN          = 10050;
  WSAENETUNREACH       = 10051;
  WSAENETRESET         = 10052;
  WSAECONNABORTED      = 10053;
  WSAECONNRESET        = 10054;
  WSAENOBUFS           = 10055;
  WSAEISCONN           = 10056;
  WSAENOTCONN          = 10057;
  WSAESHUTDOWN         = 10058;
  WSAETOOMANYREFS      = 10059;
  WSAETIMEDOUT         = 10060;
  WSAECONNREFUSED      = 10061;
  WSAELOOP             = 10062;
  WSAENAMETOOLONG      = 10063;
  WSAEHOSTDOWN         = 10064;
  WSAEHOSTUNREACH      = 10065;
  WSASYSNOTREADY       = 10091; {* returned by WSAStartup   *}
                                {* - net subsystem unusable *}
  WSASAVERNOTSUPPORTED = 10092; {* returned by WSAStartup   *}
                                {* - Win Sockets cannot support this app *}
  WSANOTINITIALISED    = 10093; {* returned by anything by WSAStartup    *}
                                {* - WSAStartup has not been performed   *}
  WSAHOST_NOT_FOUND    = 11001;
  WSATRY_AGAIN         = 11002;
  WSANO_RECOVERY       = 11003;
  WSANO_DATA           = 11004;

const
   SOCK_STREAM	  = 1;		{* stream socket *}
   SOCK_DGRAM	  = 2;		{* datagram socket *}
   SOCK_RAW	  = 3;		{* raw-protocol interface *}
   SOCK_RDM	  = 4;		{* reliably-delivered message *}
   SOCK_SEQPACKET = 5;		{* sequenced packet stream *}

   AF_UNSPEC = 0;		{* unspecified *}
   AF_INET   = 2;   		{* internetwork: UDP, TCP, etc. *}

   IPPROTO_IP	 = 0;		{* dummy for IP *}
   IPPROTO_ICMP	 = 1;		{* control message protocol *}
   IPPROTO_IGMP	 = 2;		{* group control protocol *}
   IPPROTO_GGP	 = 3;		{* gateway^2 (deprecated) *}
   IPPROTO_TCP	 = 6;		{* tcp *}
   IPPROTO_EGP	 = 8;		{* exterior gateway protocol *}
   IPPROTO_PUP	 = 12;		{* pup *}
   IPPROTO_UDP	 = 17;		{* user datagram protocol *}
   IPPROTO_IDP	 = 22;		{* xns idp *}
   IPPROTO_HELLO = 63;		{* "hello" routing protocol *}
   IPPROTO_ND	 = 77;		{* UNOFFICIAL net disk proto *}
   IPPROTO_RAW	 = 255;		{* raw IP packet *}
   IPPROTO_MAX	 = 256;

   INADDR_ANY = 0;


   WSADESCRIPTION_LEN = 256;
   WSASYS_STATUS_LEN  = 128;

   FD_SETSIZE = 64;

type
  short = integer;

  SOCKET = word;
  LPWSAData = record
              wVersion: word;
              wHighVersion: word;
              szDescription: array [0..WSADESCRIPTION_LEN] of char;
              szSystemStatus: array [0..WSASYS_STATUS_LEN] of char;
              iMaxSockets: word;
              iMaxUdpDg: word;
              lpVendorInfo: PChar;
            end;

  pHostList = ^hostList;
  hostList = array [0..100] of PChar;

  phostent = ^hostent;
  hostent = record
              h_name: PChar;
              h_aliases: ^PChar;
              h_addrtype: short;
              h_length: short;
              h_addr_list: pHostList;
            end;

  protoent = record
               p_name: PChar;
               p_aliases: ^PChar;
               p_proto: short;
             end;

  pServent = ^servent;
  servent = record
              s_name: PChar;
              s_aliases: ^PChar;
              s_port: short;
              s_proto: PChar;
            end;

  in_addr = record
              case longint of
                0: (S_addr: longint);
                1: (s_w1,s_w2: word);
                2: (s_b1,s_b2,s_b3,s_b4: byte);
            end;

  sockaddr_in = record
              	  sin_family: short;
                  sin_port: word;
	          sin_addr: in_addr;
	          sin_zero: array [0..7] of char;
                end;

  sockaddr = sockaddr_in;

  Pfd_set = ^fd_set;
  fd_set = record
             fd_count: short;
             fd_array: array[0..FD_SETSIZE-1] of SOCKET;
           end;

  timeval = record
            tv_sec: longint;
            tv_usec: longint;
            end;

{*****           Socket Routines             ******}

function accept(s: SOCKET;var addr: sockaddr;var addrlen: integer): SOCKET;
function bind(s: SOCKET;var name: sockaddr;namelen: integer): integer;
function closesocket(s: SOCKET): integer;
function connect(s: SOCKET;var name: sockaddr;namelen: integer): integer;
function getpeername(s: SOCKET;var name: sockaddr;
                     var namelen: integer): integer;
function getsockname(s: SOCKET;var name: sockaddr;
                     var namelen: integer): integer;
function getsockopt(s: SOCKET;level: integer;optname: integer;optval: PChar;
                    var optlen: integer): integer;
function htonl(hostlong: longint): longint;
function htons(hostshort: short): short;
function inet_addr (cp: PChar): longint;
function inet_ntoa(addr: longint): PChar;
function ioctlsocket(s: SOCKET;cmd: longint;var argp: longint): integer;
function listen(s: SOCKET;backlog: integer): integer;
function ntohl(netlong: longint): longint;
function ntohs(netshort: short): short;
function recv(s: integer;buf: PChar;len: integer;flags: integer): integer;
function recvfrom(s: integer;buf: PChar;len,flags: integer;var from: sockaddr;
                  var fromlen: integer): integer;
function select(nfds: integer;readfds, writefds, exceptfds: Pfd_set;
                var timeout: timeval): longint;
function send(s: SOCKET;buf: PChar;len: integer;flags: integer): integer;
function sendto(s: SOCKET;buf: PChar;len,flags: integer;var toaddr: sockaddr;
                tolen: integer): integer;
function setsockopt(s: SOCKET;level: integer;optname: integer;optval: PChar;
                    optlen: integer): integer;
function shutdown(s: SOCKET;how: integer): integer;
function _socket(af: integer;itype: integer;protocol: integer): SOCKET;

{*****          Database Routines            ******}

function gethostbyaddr(Addr: PChar;len: integer;itype: integer): phostent;
function gethostbyname(name: PChar): phostent;
function gethostname(name: PChar;namelen: integer): integer;
function getprotobyname(name: PChar): pointer;
function getprotobynumber(number: integer): pointer;
function getservbyname(name: PChar;proto: PChar): pServent;
function getservbyport(port: integer;proto: PChar): pServent;

{***** Microsoft Windows-specific Extensions ******}

function WSAAsyncGetHostByAddr(w: HWnd;Msg: word;Addr: PChar;
                               len: integer;itype: integer;buf: PChar;
                               blen: integer): THandle;
function WSAAsyncGetHostByName(w: Hwnd;Msg: word;name: PChar;buf: PChar;
                               buflen: integer): THandle;
function WSAAsyncGetProtoByName(w: HWnd;Msg: word;name: PChar;buf: PChar;
                                buflen: integer): THandle;
function WSAAsyncGetProtoByNumber(w: HWnd;Msg: word;number: integer;buf: PChar;
                                  buflen: integer): THandle;
function WSAAsyncGetServByName(w: HWnd;Msg: word;name: PChar;proto: PChar;
                               buf: PChar;buflen: integer): THandle;
function WSAAsyncGetServByPort(w: HWnd;Msg: word;port: integer;proto: PChar;
                               buf: PChar;buflen: integer): THandle;
function WSAAsyncSelect(s: SOCKET;Wnd: HWnd;wMsg: word;
                        lEvent: longint): integer;
function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): integer;
function WSACancelBlockingCall: integer;
function WSACleanup: integer;
function WSAGetLastError: integer;
function WSAIsBlocking: boolean;
function WSASetBlockingHook: byte; {* Not implemented *}
procedure WSASetLastError(iError: integer);
function WSAStartup(wVersionRequired: word;var WSAData: LPWSADATA): integer;
function WSAUnhookBlockingHook: integer;

{***** originally Berkeley macros ******}

procedure FD_ZERO (var fSet: fd_set);
procedure FD_CLR (s: SOCKET; var fSet: fd_set);
procedure _FD_SET (s: SOCKET; var fSet: fd_set);
function FD_ISSET (s: SOCKET; var fSet: fd_set): boolean;
function __WSAFDIsSet (s: SOCKET; pfSet: Pfd_set): integer;

implementation

{$F+}
function WSAAsyncGetHostByAddr; external 'WINSOCK' name 'WSAAsyncGetHostByAddr';
function WSAAsyncGetHostByName; external 'WINSOCK' name 'WSAAsyncGetHostByName';
function WSAAsyncGetProtoByName; external 'WINSOCK' name 'WSAAsyncGetProtoByName';
function WSAAsyncGetProtoByNumber; external 'WINSOCK' name 'WSAAsyncGetProtoByNumber';
function WSAAsyncGetServByName; external 'WINSOCK' name 'WSAAsyncGetServByName';
function WSAAsyncGetServByPort; external 'WINSOCK' name 'WSAAsyncGetServByPort';
function WSAAsyncSelect; external 'WINSOCK' name 'WSAAsyncSelect';
function WSACancelAsyncRequest; external 'WINSOCK' name 'WSACancelAsyncRequest';
function WSACancelBlockingCall; external 'WINSOCK' name 'WSACancelBlockingCall';
function WSACleanup; external 'WINSOCK' name 'WSACleanup';
function WSAGetLastError; external 'WINSOCK' name 'WSAGetLastError';
function WSAIsBlocking; external 'WINSOCK' name 'WSAIsBlocking';
function WSASetBlockingHook; external 'WINSOCK' name 'WSASetBlockingHook';
procedure WSASetLastError; external 'WINSOCK' name 'WSASetLastError';
function WSAStartup; external 'WINSOCK' name 'WSAStartup';
function WSAUnhookBlockingHook; external 'WINSOCK' name 'WSAUnhookBlockingHook';
function gethostbyaddr; external 'WINSOCK' name 'gethostbyaddr';
function gethostbyname; external 'WINSOCK' name 'gethostbyname';
function gethostname; external 'WINSOCK' name 'gethostname';
function getprotobyname; external 'WINSOCK' name 'getprotobyname';
function getprotobynumber; external 'WINSOCK' name 'getprotobynumber';
function getservbyname; external 'WINSOCK' name 'getservbyname';
function getservbyport; external 'WINSOCK' name 'getservbyport';
function accept; external 'WINSOCK' name 'accept';
function bind; external 'WINSOCK' name 'bind';
function closesocket; external 'WINSOCK' name 'closesocket';
function connect; external 'WINSOCK' name 'connect';
function getpeername; external 'WINSOCK' name 'getpeername';
function getsockname; external 'WINSOCK' name 'getsockname';
function getsockopt; external 'WINSOCK' name 'getsockopt';
function htonl; external 'WINSOCK' name 'htonl';
function htons; external 'WINSOCK' name 'htons';
function inet_addr; external 'WINSOCK' name 'inet_addr';
function inet_ntoa; external 'WINSOCK' name 'inet_ntoa';
function ioctlsocket; external 'WINSOCK' name 'ioctlsocket';
function listen; external 'WINSOCK' name 'listen';
function ntohl; external 'WINSOCK' name 'ntohl';
function ntohs; external 'WINSOCK' name 'ntohs';
function recv; external 'WINSOCK' name 'recv';
function recvfrom; external 'WINSOCK' name 'recvfrom';
function select; external 'WINSOCK' name 'select';
function send; external 'WINSOCK' name 'send';
function sendto; external 'WINSOCK' name 'sendto';
function setsockopt; external 'WINSOCK' name 'setsockopt';
function shutdown; external 'WINSOCK' name 'shutdown';
function _socket; external 'WINSOCK' name 'socket';
function __WSAFDIsSet; external 'WINSOCK' index 151;

{$F-}

{*** routines to substitute the original Berkeley macros ***}

procedure FD_ZERO (var fSet: fd_set);
begin
    fSet.fd_count := 0;
end;

procedure FD_CLR (s: SOCKET; var fSet: fd_set);
var i, j: integer;
begin
    with fSet do
        begin
            for i := 0 to fd_count-1 do
                if fd_array[i] = s then
                    begin
                        for j := i to fd_count-2 do
                            fd_array[j] := fd_array[j+1];
                        fd_count := fd_count - 1;
                        exit;
                    end;
        end;
end;

procedure _FD_SET (s: SOCKET; var fSet: fd_set);
begin
    with fSet do
        begin
            fd_array [fd_count] := s;
            fd_count := fd_count + 1;
        end;
end;

function FD_ISSET (s: SOCKET; var fSet: fd_set): boolean;
var i: integer;
begin
    FD_ISSET := __WSAFDIsSet (s, @fSet) <> 0;
end;

end. {* WINSOCK.PAS *}
