Source file: /~heha/hs/finger.zip/SRC/WINSOCK.PAS

unit WINSOCK;
{ Winsock.h file for Borland Pascal
 H.Haftmann
 +++ Strikte Anpassung an Delphi2 05/04, dadurch inkompatibel zum Vorgänger
}
{$C MOVEABLE PRELOAD PERMANENT}	{gleiche Attribute wie Unit SYSTEM}
{$F-,A+,G+,K+,W-}
{$I-,Q-,R-,S-}
{$V+,B-,X+,T+,P+}

interface

uses WIN31, WinTypes, WinProcs;

const
 FD_SetSize=64;

type
 PFd_Set=^TFd_Set;
 TFd_Set = record
  count: Word;
  fd_array: array[0..FD_SETSIZE-1] of Word;
 end;

 TTimeVal = record
  sec,usec:	LongInt;
 end;

const
 IOCPARM_MASK	=    $007f;
 IOC_VOID	=$20000000;
 IOC_OUT	=$40000000;
 IOC_IN		=$80000000;
 IOC_INOUT	=(IOC_IN OR IOC_OUT);

 FIONREAD	=$4004667F;
 FIONBIO	=$8004667E;
 FIOASYNC	=$8004667D;

type
 PPChar=^PChar;
 PDWord=^DWord;
 DWord=LongInt;		{eigentlich: Unsigned Long oder Cardinal}

 PInAddr=^TInAddr;	{Klassische 4-Byte-IP-Adresse}
 TInAddr=record
  case Integer of
  0: (s_b1,s_b2,s_b3,s_b4: Byte);
  1: (s_w1,s_w2:	Word);
  2: (s_addr:		DWord);
 end;

 PHostEnt=^THostEnt;
 THostEnt=record
  h_name:	PChar;
  h_aliases:	PPChar;
  h_addrtype:	Integer;
  h_length:	Integer;
  h_addr_list:	PPChar;
{statt "addr" (bzw. "h_addr") schreibe man "addr_list^"}
{macro addr addr_list^}
 end;

 PNetEnt=^TNetEnt;
 TNetEnt=record
  n_name:	PChar;
  n_aliases:	PPChar;
  n_addrtype:	Integer;
  n_net:	LongInt;
 end;

 PServEnt=^TServEnt;
 TServEnt=record
  s_name:	PChar;
  s_aliases:	PPChar;
  s_port:	Integer;
  s_proto:	PChar;
 end;

 PProtoEnt=^TProtoEnt;
 TProtoEnt=record
  p_name:	PChar;
  p_aliases:	PPchar;
  p_proto:	Integer;
 end;

const
 IPPROTO_IP	=  0;
 IPPROTO_ICMP	=  1;
 IPPROTO_GGP	=  2;
 IPPROTO_TCP	=  6;
 IPPROTO_PUP	= 12;
 IPPROTO_UDP	= 17;
 IPPROTO_IDP	= 22;
 IPPROTO_ND	= 77;

 IPPROTO_Raw	=255;
 IPPROTO_Max	=256;


 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;

 IPPORT_TFTP		= 69;
 IPPORT_RJE		= 77;
 IPPORT_Finger		= 79;
 IPPORT_TtyLink		= 87;
 IPPORT_SUPDUP		= 95;

 IPPORT_ExecServer	=512;
 IPPORT_LoginServer	=513;
 IPPORT_CmdServer	=514;
 IPPORT_EfsServer	=520;

 IPPORT_BiffUdp		=512;
 IPPORT_WhoServer	=513;
 IPPORT_RouteServer	=520;

 IPPORT_Reserved	=1024;

 IMPLINK_IP		=155;
 IMPLINK_LowExper	=156;
 IMPLINK_HighExper	=158;

type
 PSockAddr = ^TSockAddr;
 TSockAddr = record
  sa_family: Integer;
  sa_data: array[0..13] of Char;
 end;

 PSockAddrIn=^TSockAddrIn;
 TSockAddrIn=record
  sin_family: Integer;
  sin_port: Word;
  sin_addr: TInAddr;
  sin_zero: array[0..7] of Char;
 end;

const
 WSADescription_Len	=256;
 WSASys_Status_Len	=128;

type
 PWsaData=^TWsaData;
 TWsaData=record
  wVersion:	word;
  wHighVersion:	word;
  szDescription: array[0..WSADescription_Len] of char;
  szSystemStatus: array[0..WSASys_Status_Len] of char;
  iMaxSockets:	integer;
  iMaxUdpDg:	integer;
  lpVendorInfo:	PChar;
 end;

const
 IP_Options	=  1;
 INADDR_Any	=  0;    {msc}
 INADDR_None	= -1;

 INVALID_SOCKET	=$FFFF;
 SOCKET_ERROR	= -1;

 SOCK_Stream	=  1;
 SOCK_DGram	=  2;
 SOCK_Raw	=  3;
 SOCK_RDM	=  4;
 SOCK_SeqPacket	=  5;

 SO_Debug	=$0001;
 SO_AcceptConn	=$0002;
 SO_ReuseAddr	=$0004;
 SO_KeepAlive	=$0008;
 SO_DontRoute	=$0010;
 SO_BroadCast	=$0020;
 SO_UseLoopback	=$0040;
 SO_Linger	=$0080;
 SO_OobInline	=$0100;

 SO_DontLinger	=$ff7f;

 SO_SNDBUF	=$1001;
 SO_RCVBUF	=$1002;
 SO_SNDLOWAT	=$1003;
 SO_RCVLOWAT	=$1004;
 SO_SNDTIMEO	=$1005;
 SO_RCVTIMEO	=$1006;
 SO_ERROR	=$1007;
 SO_TYPE	=$1008;

 AF_UNSPEC	=  0;
 AF_UNIX	=  1;
 AF_INET	=  2;
 AF_IMPLINK	=  3;
 AF_PUP		=  4;
 AF_CHAOS	=  5;
 AF_NS		=  6;
 AF_NBS		=  7;
 AF_ECMA	=  8;
 AF_DATAKIT	=  9;
 AF_CCITT	= 10;
 AF_SNA		= 11;
 AF_DECnet	= 12;
 AF_DLI		= 13;
 AF_LAT		= 14;
 AF_HYLINK	= 15;
 AF_AppleTalk	= 16;

 AF_MAX		= 17;

type
 PSockProto=^TSockProto;
 TSockProto=record
  sp_family:	Word;
  sp_protocol:	Word;
 end;

const
 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_NBS		=AF_NBS;
 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
 PLinger=^TLinger;
 TLinger=record
  l_onoff:	Word;
  l_linger:	Word;
 end;

const
 SOL_Socket	=$ffff;

 SOMaxConn	=  5;

 MSG_OOB	= $1;
 MSG_Peek	= $2;
 MSG_DontRoute	= $4;

 MSG_MaxIOVLen	= 16;

 MaxGetHostStruct=1024;

 FD_Read	=$01;
 FD_Write	=$02;
 FD_OOB		=$04;
 FD_Accept	=$08;
 FD_Connect	=$10;
 FD_Close	=$20;

 WSABaseErr		=10000;

 WSAEINTR		=WSABaseErr+  4;
 WSAEBadF		=WSABaseErr+  9;
 WSAEFault		=WSABaseErr+ 14;
 WSAEInval		=WSABaseErr+ 22;
 WSAEMFile		=WSABaseErr+ 24;

 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;

 WSASysNotReady		=WSABaseErr+ 91;
 WSAVerNotSupported	=WSABaseErr+ 92;
 WSANotInitialised	=WSABaseErr+ 93;
 WSAHost_Not_Found	=WSABaseErr+1001;
 WSATry_Again		=WSABaseErr+1002;
 WSANo_Recovery		=WSABaseErr+1003;
 WSANo_Data		=WSABaseErr+1004;
 WSANo_Address		=WSANo_Data;

 EWOULDBLOCK		=WSAEWOULDBLOCK;
 EINPROGRESS		=WSAEINPROGRESS;
 EALREADY		=WSAEALREADY;
 ENOTSOCK		=WSAENOTSOCK;
 EDESTADDRREQ		=WSAEDESTADDRREQ;
 EMSGSIZE		=WSAEMSGSIZE;
 EPROTOTYPE		=WSAEPROTOTYPE;
 ENOPROTOOPT		=WSAENOPROTOOPT;
 EPROTONOSUPPORT	=WSAEPROTONOSUPPORT;
 ESOCKTNOSUPPORT	=WSAESOCKTNOSUPPORT;
 EOPNOTSUPP		=WSAEOPNOTSUPP;
 EPFNOSUPPORT		=WSAEPFNOSUPPORT;
 EAFNOSUPPORT		=WSAEAFNOSUPPORT;
 EADDRINUSE		=WSAEADDRINUSE;
 EADDRNOTAVAIL		=WSAEADDRNOTAVAIL;
 ENETDOWN		=WSAENETDOWN;
 ENETUNREACH		=WSAENETUNREACH;
 ENETRESET		=WSAENETRESET;
 ECONNABORTED		=WSAECONNABORTED;
 ECONNRESET		=WSAECONNRESET;
 ENOBUFS		=WSAENOBUFS;
 EISCONN		=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;
 HOST_NOT_FOUND		=WSAHOST_NOT_FOUND;
 TRY_AGAIN		=WSATRY_AGAIN;
 NO_RECOVERY		=WSANO_RECOVERY;
 NO_DATA		=WSANO_DATA;
 NO_ADDRESS		=WSANO_ADDRESS;

type
 u_short=Word;
 u_int=Word;
 TSocket=Word;

{ Library Functions: BSD equivalents }

function Accept	(s:TSocket; var addr; var addrlen:Integer):TSocket;
function Bind	(s:TSocket; const addr; namelen:integer):integer;
function CloseSocket(s:TSocket):integer;
function Connect(s:TSocket; const name; namelen:integer):integer;
function IoctlSocket(s:TSocket; cmd:Longint; var argp:LongInt):integer;
function GetPeerName(s:TSocket; const name:Tsockaddr; var namelen:Integer):integer;
function GetSockName(s:TSocket; const name:Tsockaddr; var namelen:Integer):integer;
function GetSockOpt(s:TSocket; level, optname:integer; var optval; var optlen:Integer):integer;
function htonl	(hostlong:LongInt):LongInt;
function htons	(hostshort:Word):Word;
function inet_addr(cp:PChar):LongInt;  { four-byte internet address }
function inet_ntoa(inaddr:LongInt):PChar;	{!! Win32: TInAddr !!}
function Listen	(s:TSocket; backlog:integer):integer;
function ntohl	(netlong:LongInt):LongInt;
function ntohs	(netshort:Word):Word;
function Recv	(s:TSocket; var buf; len, flags:Integer):integer;
function RecvFrom(s:TSocket; var buf; len, flags:Integer; const from:Tsockaddr; var fromlen:Integer):integer;
function Select	(nfds:integer; var readfds, writefds, exceptfds:Tfd_set; const timeout:TTimeVal):Longint;
function Send	(s:TSocket; const buf; len, flags:Integer):integer;
function SendTo	(s:TSocket; const buf; len, flags:Integer; const addrto:Tsockaddr; tolen:Integer):integer;
function SetSockOpt(s:TSocket; level, optname:integer; const optval; optlen:integer):integer;
function Shutdown(s:TSocket; how:integer):integer;
function Socket	(af, struct, protocol:integer):TSocket;
function GetHostByAddr(addr:PChar; len, struct:integer):PHostEnt;
function GetHostbyName(name:PChar):PHostEnt;
function GetHostName(name:PChar; len:integer):integer;
function GetServByPort(port:integer; proto:PChar):PServEnt;
function GetServByName(name, proto:PChar):PServEnt;
function GetProtoByNumber(proto:integer):PProtoEnt;
function GetProtoByName(name:PChar):PProtoEnt;

{ Library Funtions: WSA extensions }

function WSAStartup (wVersionRequired:word; var lpWSData:TWSADATA):integer;
function WSACleanup:integer;
procedure WSASetLastError (iError:integer);
function WSAGetLastError:integer;
function WSAIsBlocking:BOOL;
function WSAUnhookBlockingHook:integer;
function WSASetBlockingHook (lpBlockFunc:TFarProc):TFarProc;
function WSACancelBlockingCall:integer;
function WSAAsyncGetServByName (HWindow:HWnd; wMsg:Word; name, proto, buf:PChar; buflen:integer):THandle;
function WSAAsyncGetServByPort ( HWindow:HWnd; wMsg, port:Word; proto, buf:PChar; buflen:integer):THandle;
function WSAAsyncGetProtoByName (HWindow:HWnd; wMsg:Word; name, buf:PChar; buflen:integer):THandle;
function WSAAsyncGetProtoByNumber (HWindow:HWnd; wMsg:Word; number:integer; buf:PChar; buflen:integer):THandle;
function WSAAsyncGetHostByName (HWindow:HWnd; wMsg:Word; name, buf:PChar; buflen:integer):THandle;
function WSAAsyncGetHostByAddr (HWindow:HWnd; wMsg:Word; addr:PChar; len, struct:integer;
				buf:PChar; buflen:integer):THandle;
function WSACancelAsyncRequest (hAsyncTaskHandle:THandle):integer;
function WSAAsyncSelect (s:TSocket; HWindow:HWnd; wMsg:Word; lEvent:longint):integer;

{ Macro functions }

function WSAMakeSyncReply (Buflen, Error:Word):LongInt;
inline($5A/$58);    { POP DX AX : MakeLong()}
function WSAMakeSelectReply (Event, Error:Word):LongInt;
inline($5A/$58);    { POP DX AX : MakeLong()}
function WSAGetAsyncBuflen (Param:LongInt):Word;
inline($58/$5A);    { POP AX DX : LoWord()}
function WSAGetAsyncError (Param:LongInt):Word;
inline($5A/$58);    { POP DX AX : HiWord()}
function WSAGetSelectEvent (Param:LongInt):Word;
inline($58/$5A);    { POP AX DX : LoWord()}
function WSAGetSelectError (Param:LongInt):Word;
inline($5A/$58);    { POP DX AX : HiWord()}

{ Static linkable function }

function OpenSock(Sock:TSocket; host,port:PChar):Integer;

implementation

function Accept;			external 'WINSOCK' index   1;
function Bind;				external 'WINSOCK' index   2;
function CloseSocket;			external 'WINSOCK' index   3;
function Connect;			external 'WINSOCK' index   4;
function GetPeerName;			external 'WINSOCK' index   5;
function GetSockName;			external 'WINSOCK' index   6;
function GetSockOpt;			external 'WINSOCK' index   7;
function htonl;				external 'WINSOCK' index   8;
function htons;				external 'WINSOCK' index   9;
function inet_addr;			external 'WINSOCK' index  10;
function inet_ntoa;			external 'WINSOCK' index  11;
function IoctlSocket;			external 'WINSOCK' index  12;
function Listen;			external 'WINSOCK' index  13;
function ntohl;				external 'WINSOCK' index  14;
function ntohs;				external 'WINSOCK' index  15;
function Recv;				external 'WINSOCK' index  16;
function RecvFrom;			external 'WINSOCK' index  17;
function Select;			external 'WINSOCK' index  18;
function Send;				external 'WINSOCK' index  19;
function SendTo;			external 'WINSOCK' index  20;
function SetSockOpt;			external 'WINSOCK' index  21;
function ShutDown;			external 'WINSOCK' index  22;
function Socket;			external 'WINSOCK' index  23;

function GetHostByAddr;			external 'WINSOCK' index  51;
function GetHostByName;			external 'WINSOCK' index  52;
function GetProtoByName;		external 'WINSOCK' index  53;
function GetProtoByNumber;		external 'WINSOCK' index  54;
function GetServByName;			external 'WINSOCK' index  55;
function GetServByPort;			external 'WINSOCK' index  56;
function GetHostName;			external 'WINSOCK' index  57;

function WSAAsyncSelect;    		external 'WINSOCK' index 101;
function WSAAsyncGetHostByAddr;		external 'WINSOCK' index 102;
function WSAAsyncGetHostByName;		external 'WINSOCK' index 103;
function WSAAsyncGetProtoByNumber;	external 'WINSOCK' index 104;
function WSAAsyncGetprotoByName;	external 'WINSOCK' index 105;
function WSAAsyncGetServByPort;		external 'WINSOCK' index 106;
function WSAAsyncGetServByName;		external 'WINSOCK' index 107;
function WSACancelAsyncRequest;		external 'WINSOCK' index 108;
function WSASetBlockingHook; 		external 'WINSOCK' index 109;
function WSAUnhookBlockingHook;		external 'WINSOCK' index 110;
function WSAGetLastError;		external 'WINSOCK' index 111;
procedure WSASetLastError;		external 'WINSOCK' index 112;
function WSACancelBlockingCall;		external 'WINSOCK' index 113;
function WSAIsBlocking;			external 'WINSOCK' index 114;
function WSAStartup;			external 'WINSOCK' index 115;
function WSACleanup;			external 'WINSOCK' index 116;

function OpenSock(Sock:TSocket; host,port:PChar):Integer;
 type
  LongRec=record
   lo,hi:Word;
  end;
 var
  sa: TSockAddrIn;
  he: PHostEnt;
  se: PServEnt;
 begin
  FillChar(sa,sizeof(sa),0);
  sa.sin_family:=AF_INET;
  if LongRec(port).hi=0 then sa.sin_port:=htons(LongRec(port).lo)
  else begin
   se:=PServEnt(GetServByName(port,nil));
   if se=nil then begin
    OpenSock:=-2;	{code for "cannot resolve port name (string)"}
    exit;
   end;
   sa.sin_port:=se^.s_port;
  end;

  sa.sin_addr.s_addr:=inet_addr(host);
  if sa.sin_addr.s_addr=INADDR_None then begin
   he:=GetHostByName(host);
   if he=nil then begin
    OpenSock:=-3;	{code for "cannot evaluate/resolve IP address"}
    exit;
   end;
   sa.sin_addr.s_addr:=PDWord(he^.h_addr_list^)^;
  end;

  if Connect(Sock,sa,sizeof(sa))=SOCKET_Error then begin
   OpenSock:=-4;	{code for "cannot open socket connection"}
   exit;
  end;
  OpenSock:=0;		{code for success}
 end;

end.
Detected encoding: OEM (CP437)1
Wrong umlauts? - Assume file is ANSI (CP1252) encoded