winsock.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

{ 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 Berkeley error constants }
 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;

type
  { Basic system type definitions, taken from the BSD file sys/types.h. }
  u_char   = byte;
  u_short  = word;
  u_int    = word;
  u_long   = longint;
  short    = word;

  { low level handle wich refer to sockets }
  TSocket = u_int;

  { Select uses arrays of SOCKETs. }
  TFDSet = packed record
    fd_count : u_short;
    fd_array : array [0..(FD_SETSIZE - 1)] of TSocket;
  end;
  PFDSet = ^TFDSet;

  {  Structure used in select() call, taken from the BSD file sys/time.h. }
  TTimeVal = packed record
    tv_sec  : longint;
    tv_usec : longint;
  end;
  PTimeVal = ^TTimeVal;

  { Structures returned by network data base library, taken from the
    BSD file netdb.h.  All addresses are supplied in host order, and
    returned in network order (suitable for use in system calls). }

  HostEnt = record
    h_name      : PChar;          { official name of host }
    h_aliases   : ^PChar;         { alias list }
    h_addrtype  : short;          { host address type }
    h_length    : short;          { length of address }
    h_addr_list : ^PChar;         { list of addresses }
  end;
  PHostEnt = ^HostEnt;

  NetEnt = record
    n_name     : PChar;           { official name of net }
    n_aliases  : ^PChar;          { alias list }
    n_addrtype : short;           { net address type }
    n_net      : u_long;          {  network # }
  end;
  PNetEnt = ^NetEnt;

  ServEnt = record
    s_name    : PChar;            { official service name }
    s_aliases : ^PChar;           { alias list }
    s_port    : integer;          { port # }
    s_proto   : PChar;            { protocol to use }
  end;
  PServEnt = ^ServEnt;

  Protoent = record
    p_name    : PChar;            { official protocol name }
    p_aliases : ^PChar;           { alias list }
    p_proto   : integer;          { protocol # }
  end;
  Pprotoent = ^protoent;

  {  Internet address (old style... should be updated) }
  SunB = packed record
    s_b1, s_b2, s_b3, s_b4: u_char;
  end;

  SunW = packed record
    s_w1, s_w2: u_short;
  end;

  TInAddr = packed record
    case integer of
      0: (S_un_b: SunB);
      1: (S_un_w: SunW);
      2: (S_addr: u_long);
  end;
  PInAddr = ^TInAddr;

  { Socket address, internet style. }
  TSockAddrIn = packed record
    case integer of
    0: (sin_family : u_short;
        sin_port   : u_short;
        sin_addr   : TInAddr;
        sin_zero   : array[0..7] of char);
    1: (sa_family: u_short;
        sa_data: array [0..13] of char);
  end;
  PSockAddrIn = ^TSockAddrIn;
  TSockAddr   = TSockAddrIn;

  PWSADATA = ^TWSADATA;
  TWSADATA = packed record
    wVersion       : word;
    wHighVersion   : word;
    szDescription  : array [0..WSADESCRIPTION_LEN] of char;
    szSystemStatus : array [0..WSASYS_STATUS_LEN] of char;
    iMaxSockets    : u_short;
    iMaxUdpDg      : u_short;
    lpVendorInfo   : PChar;
  end;

  { Structure used by kernel to pass protocol information in raw sockets. }
  TSockProto = packed record
    sp_family   : u_short;
    sp_protocol : u_short;
  end;

  {  Structure used for manipulating linger option. }
  TLinger = packed record
    l_onoff  : u_short;
    l_linger : u_short;
  end;

{ Socket function prototypes }

function accept(s: TSocket; var addr: TSockAddr; var addrlen: Integer): TSocket;
function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer;
function closesocket(s: TSocket): Integer;
function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer;
function ioctlsocket(s: TSocket; cmd: Longint; var arg: u_long): Integer;
function getpeername(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
function getsockname(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
function getsockopt(s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer;
function htonl(hostlong: u_long): u_long;
function htons(hostshort: u_short): u_short;
function inet_addr(cp: PChar): u_long;
function inet_ntoa(inaddr: TInAddr): PChar;
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; var Buf; len, flags: Integer): Integer;
function recvfrom(s: TSocket; var Buf; len, flags: Integer;
  var from: TSockAddr; var fromlen: Integer): Integer; 
function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
  timeout: PTimeVal): Longint;
function send(s: TSocket; var Buf; len, flags: Integer): Integer; 
function sendto(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr;
  tolen: Integer): Integer; 
function setsockopt(s: TSocket; level, optname: Integer; optval: PChar;
  optlen: Integer): Integer; 
function shutdown(s: TSocket; how: Integer): Integer; 
function socket(af, struct, protocol: Integer): TSocket;
function gethostbyaddr(addr: Pointer; 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;
function WSAStartup(wVersionRequired: word; var WSData: 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: u_int; 
  name, proto, buf: PChar; buflen: Integer): THandle; 
function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int;
  proto, buf: PChar; buflen: Integer): THandle; 
function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int;
  name, buf: PChar; buflen: Integer): THandle; 
function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer;
  buf: PChar; buflen: Integer): THandle;
function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int;
  name, buf: PChar; buflen: Integer): THandle;
function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar;
  len, struct: Integer; buf: PChar; buflen: Integer): THandle;
function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer;
function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer;
function WSARecvEx(s: TSocket; var buf; len: Integer; var flags: Integer): Integer;
function WSAMakeSyncReply(Buflen, Error: Word): Longint;
function WSAMakeSelectReply(Event, Error: Word): Longint;
function WSAGetAsyncBuflen(Param: Longint): Word;
function WSAGetAsyncError(Param: Longint): Word;
function WSAGetSelectEvent(Param: Longint): Word;
function WSAGetSelectError(Param: Longint): Word;


implementation

function WSAMakeSyncReply;
begin
  WSAMakeSyncReply:= MakeLong(Buflen, Error);
end;

function WSAMakeSelectReply;
begin
  WSAMakeSelectReply:= MakeLong(Event, Error);
end;

function WSAGetAsyncBuflen;
begin
  WSAGetAsyncBuflen:= LOWORD(Param);
end;

function WSAGetAsyncError;
begin
  WSAGetAsyncError:= HIWORD(Param);
end;

function WSAGetSelectEvent;
begin
  WSAGetSelectEvent:= LOWORD(Param);
end;

function WSAGetSelectError;
begin
  WSAGetSelectError:= HIWORD(Param);
end;

function accept;            external    winsocket name 'accept';
function bind;              external    winsocket name 'bind';
function closesocket;       external    winsocket name 'closesocket';
function connect;           external    winsocket name 'connect';
function getpeername;       external    winsocket name 'getpeername';
function getsockname;       external    winsocket name 'getsockname';
function getsockopt;        external    winsocket name 'getsockopt';
function htonl;             external    winsocket name 'htonl';
function htons;             external    winsocket name 'htons';
function inet_addr;         external    winsocket name 'inet_addr';
function inet_ntoa;         external    winsocket name 'inet_ntoa';
function ioctlsocket;       external    winsocket name 'ioctlsocket';
function listen;            external    winsocket name 'listen';
function ntohl;             external    winsocket name 'ntohl';
function ntohs;             external    winsocket name 'ntohs';
function recv;              external    winsocket name 'recv';
function recvfrom;          external    winsocket name 'recvfrom';
function select;            external    winsocket name 'select';
function send;              external    winsocket name 'send';
function sendto;            external    winsocket name 'sendto';
function setsockopt;        external    winsocket name 'setsockopt';
function shutdown;          external    winsocket name 'shutdown';
function socket;            external    winsocket name 'socket';

function gethostbyaddr;     external    winsocket name 'gethostbyaddr';
function gethostbyname;     external    winsocket name 'gethostbyname';
function getprotobyname;    external    winsocket name 'getprotobyname';
function getprotobynumber;  external    winsocket name 'getprotobynumber';
function getservbyname;     external    winsocket name 'getservbyname';
function getservbyport;     external    winsocket name 'getservbyport';
function gethostname;       external    winsocket name 'gethostname';

function WSAAsyncSelect;        external winsocket name 'WSAAsyncSelect';
function WSARecvEx;             external winsocket name 'WSARecvEx';
function WSAAsyncGetHostByAddr; external winsocket name 'WSAAsyncGetHostByAddr';
function WSAAsyncGetHostByName; external winsocket name 'WSAAsyncGetHostByName';
function WSAAsyncGetProtoByNumber; external winsocket name 'WSAAsyncGetProtoByNumber';
function WSAAsyncGetprotoByName; external winsocket name 'WSAAsyncGetprotoByName';
function WSAAsyncGetServByPort; external winsocket name 'WSAAsyncGetServByPort';
function WSAAsyncGetServByName; external winsocket name 'WSAAsyncGetServByName';
function WSACancelAsyncRequest; external winsocket name 'WSACancelAsyncRequest';
function WSASetBlockingHook;    external winsocket name 'WSASetBlockingHook';
function WSAUnhookBlockingHook; external winsocket name 'WSAUnhookBlockingHook';
function WSAGetLastError;       external winsocket name 'WSAGetLastError';
procedure WSASetLastError;      external winsocket name 'WSASetLastError';
function WSACancelBlockingCall; external winsocket name 'WSACancelBlockingCall';
function WSAIsBlocking;         external winsocket name 'WSAIsBlocking';
function WSAStartup;            external winsocket name 'WSAStartup';
function WSACleanup;            external winsocket name 'WSACleanup';

end.