net_wins.pas

delphi编的不错的贪吃蛇

      if (dedicated.value <> 0) then    // let dedicated servers continue after errors
        Com_Printf('NET_GetPacket: %s from %s'#10,
          [NET_ErrorString, NET_AdrToString(net_from)])
      else
        Com_Error(ERR_DROP, 'NET_GetPacket: %s from %s',
          [NET_ErrorString, NET_AdrToString(net_from)]);
      Continue;
    end;

    if (ret = net_message.maxsize) then
    begin
      Com_Printf('Oversize packet from %s'#10, [NET_AdrToString(net_from)]);
      Continue;
    end;

    net_message.cursize := ret;
    Result := True;
    Exit;
  end;

  Result := False;
end;

//=============================================================================

procedure NET_SendPacket(sock: netsrc_t; length: Integer; data: Pointer; const to_: netadr_t);
var
  ret: Integer;
  addr: sockaddr;
  net_socket: Integer;
  err: Integer;
begin
  if (to_.type_ = NA_LOOPBACK) then
  begin
    NET_SendLoopPacket(sock, length, data, to_);
    Exit;
  end;

  if (to_.type_ = NA_BROADCAST) then
  begin
    net_socket := ip_sockets[sock];
    if (net_socket = 0) then
      Exit;
  end
  else if (to_.type_ = NA_IP) then
  begin
    net_socket := ip_sockets[sock];
    if (net_socket = 0) then
      Exit;
  end
  else if (to_.type_ = NA_IPX) then
  begin
    net_socket := ipx_sockets[sock];
    if (net_socket = 0) then
      Exit;
  end
  else if (to_.type_ = NA_BROADCAST_IPX) then
  begin
    net_socket := ipx_sockets[sock];
    if (net_socket = 0) then
      Exit;
  end
  else
  begin
    Com_Error(ERR_FATAL, 'NET_SendPacket: bad address type', []);
    Exit;                               //Clootie: to fool compiler
  end;

  NetadrToSockadr(to_, addr);

{$IFDEF USE_JWA}
  ret := sendto(net_socket, data, length, 0, @addr, SizeOf(addr));
{$ELSE}
  ret := sendto(net_socket, data^, length, 0, addr, SizeOf(addr));
{$ENDIF}
  if (ret = -1) then
  begin
    err := WSAGetLastError;

    // wouldblock is silent
    if (err = WSAEWOULDBLOCK) then
      Exit;

    // some PPP links dont allow broadcasts
    if (err = WSAEADDRNOTAVAIL) and
      ((to_.type_ = NA_BROADCAST) or (to_.type_ = NA_BROADCAST_IPX)) then
      Exit;

    if (dedicated.value <> 0) then      // let dedicated servers continue after errors
    begin
      Com_Printf('NET_SendPacket ERROR: %s to %s'#10,
        [NET_ErrorString, NET_AdrToString(to_)]);
    end
    else
    begin
      if (err = WSAEADDRNOTAVAIL) then
      begin
        Com_DPrintf('NET_SendPacket Warning: %s : %s'#10,
          [NET_ErrorString, NET_AdrToString(to_)]);
      end
      else
      begin
        Com_Error(ERR_DROP, 'NET_SendPacket ERROR: %s to %s'#10,
          [NET_ErrorString, NET_AdrToString(to_)]);
      end;
    end;
  end;
end;

//=============================================================================

{*
====================
NET_Socket
====================
*}
function NET_IPSocket(net_interface: PChar; port: Integer): Integer;
var
  newsocket: Integer;
  address: sockaddr_in;
  _true: Integer; // qboolean
  i: Integer;
  err: Integer;
begin
  _true := 1;
  i := 1;

  newsocket := socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);
  if (newsocket = -1) then
  begin
    err := WSAGetLastError;
    if (err <> WSAEAFNOSUPPORT) then
      Com_Printf('WARNING: UDP_OpenSocket: socket: %s', [NET_ErrorString]);
    Result := 0;
    Exit;
  end;

  // make it non-blocking
{$IFDEF USE_JWA}
  if (ioctlsocket(newsocket, FIONBIO, Cardinal(_true)) = -1) then
{$ELSE}
  if (ioctlsocket(newsocket, FIONBIO, _true) = -1) then
{$ENDIF}
  begin
    Com_Printf('WARNING: UDP_OpenSocket: ioctl FIONBIO: %s'#10, [NET_ErrorString]);
    Result := 0;
    Exit;
  end;

  // make it broadcast capable
  if (setsockopt(newsocket, SOL_SOCKET, SO_BROADCAST, PChar(@i), SizeOf(i)) = -1) then
  begin
    Com_Printf('WARNING: UDP_OpenSocket: setsockopt SO_BROADCAST: %s'#10, [NET_ErrorString]);
    Result := 0;
    Exit;
  end;

  if (net_interface = nil) or (net_interface[0] = #0) or
    (StrIComp(net_interface, 'localhost') = 0) then
    address.sin_addr.s_addr := INADDR_ANY
  else
    NET_StringToSockaddr(net_interface, sockaddr(address));

  if (port = PORT_ANY) then
    address.sin_port := 0
  else
    address.sin_port := htons(port);

  address.sin_family := AF_INET;

{$IFDEF USE_JWA}
  if (bind(newsocket, @address, SizeOf(address)) = -1) then
{$ELSE}
  if (bind(newsocket, address, SizeOf(address)) = -1) then
{$ENDIF}
  begin
    Com_Printf('WARNING: UDP_OpenSocket: bind: %s'#10, [NET_ErrorString]);
    closesocket(newsocket);
    Result := 0;
    Exit;
  end;

  Result := newsocket;
end;

{*
====================
NET_OpenIP
====================
*}
procedure NET_OpenIP;
var
  ip: cvar_p;
  port: Integer;
  dedicated: Integer;
begin
  ip := Cvar_Get('ip', 'localhost', CVAR_NOSET);

  dedicated := Round(Cvar_VariableValue('dedicated'));

  if (ip_sockets[NS_SERVER] = 0) then
  begin
    port := Round(Cvar_Get('ip_hostport', '0', CVAR_NOSET).value);
    if (port = 0) then
    begin
      port := Round(Cvar_Get('hostport', '0', CVAR_NOSET).value);
      if (port = 0) then
      begin
        port := Round(Cvar_Get('port', va('%d', [PORT_SERVER]), CVAR_NOSET).value);
      end;
    end;
    ip_sockets[NS_SERVER] := NET_IPSocket(ip.string_, port);
    if (ip_sockets[NS_SERVER] = 0) and (dedicated <> 0) then
      Com_Error(ERR_FATAL, 'Couldn''t allocate dedicated server IP port', []);
  end;

  // dedicated servers don't need client ports
  if (dedicated <> 0) then
    Exit;

  if (ip_sockets[NS_CLIENT] = 0) then
  begin
    port := Round(Cvar_Get('ip_clientport', '0', CVAR_NOSET).value);
    if (port = 0) then
    begin
      port := Round(Cvar_Get('clientport', va('%d', [PORT_CLIENT]), CVAR_NOSET).value);
      if (port = 0) then
        port := PORT_ANY;
    end;
    ip_sockets[NS_CLIENT] := NET_IPSocket(ip.string_, port);
    if (ip_sockets[NS_CLIENT] = 0) then
      ip_sockets[NS_CLIENT] := NET_IPSocket(ip.string_, PORT_ANY);
  end;
end;

{*
====================
IPX_Socket
====================
*}
function NET_IPXSocket(port: Integer): Integer;
var
  newsocket: Integer;
  address: sockaddr_in;
  _true: Integer;
  err: Integer;
begin
  _true := 1;

  newsocket := socket(PF_IPX, SOCK_DGRAM, NSPROTO_IPX);
  if (newsocket = -1) then
  begin
    err := WSAGetLastError;
    if (err <> WSAEAFNOSUPPORT) then
      Com_Printf('WARNING: IPX_Socket: socket: %s'#10, [NET_ErrorString]);
    Result := 0;
    Exit;
  end;

  // make it non-blocking
{$IFDEF USE_JWA}
  if (ioctlsocket(newsocket, FIONBIO, Cardinal(_true)) = -1) then
{$ELSE}
  if (ioctlsocket(newsocket, FIONBIO, _true) = -1) then
{$ENDIF}
  begin
    Com_Printf('WARNING: IPX_Socket: ioctl FIONBIO: %s'#10, [NET_ErrorString]);
    Result := 0;
    Exit;
  end;

  // make it broadcast capable
  if (setsockopt(newsocket, SOL_SOCKET, SO_BROADCAST, PChar(@_true), SizeOf(_true)) = -1) then
  begin
    Com_Printf('WARNING: IPX_Socket: setsockopt SO_BROADCAST: %s'#10, [NET_ErrorString]);
    Result := 0;
    Exit;
  end;

  PSockAddrIPX(@address).sa_family := AF_IPX;
  FillChar(PSockAddrIPX(@address).sa_netnum, 4, 0);
  FillChar(PSockAddrIPX(@address).sa_nodenum, 6, 0);
  if (port = PORT_ANY) then
    PSockAddrIPX(@address).sa_socket := 0
  else
    PSockAddrIPX(@address).sa_socket := htons(port);

{$IFDEF USE_JWA}
  if (bind(newsocket, PSockAddr(@address), SizeOf(address)) = -1) then
{$ELSE}
  if (bind(newsocket, address, SizeOf(address)) = -1) then
{$ENDIF}
  begin
    Com_Printf('WARNING: IPX_Socket: bind: %s'#10, [NET_ErrorString]);
    closesocket(newsocket);
    Result := 0;
    Exit;
  end;

  Result := newsocket;
end;

{*
====================
NET_OpenIPX
====================
*}
procedure NET_OpenIPX;
var
  port: Integer;
  dedicated: Integer;
begin
  dedicated := Round(Cvar_VariableValue('dedicated'));

  if (ipx_sockets[NS_SERVER] = 0) then
  begin
    port := Round(Cvar_Get('ipx_hostport', '0', CVAR_NOSET).value);
    if (port = 0) then
    begin
      port := Round(Cvar_Get('hostport', '0', CVAR_NOSET).value);
      if (port = 0) then
      begin
        port := Round(Cvar_Get('port', va('%d', [PORT_SERVER]), CVAR_NOSET).value);
      end;
    end;
    ipx_sockets[NS_SERVER] := NET_IPXSocket(port);
  end;

  // dedicated servers don't need client ports
  if (dedicated <> 0) then
    Exit;

  if (ipx_sockets[NS_CLIENT] = 0) then
  begin
    port := Round(Cvar_Get('ipx_clientport', '0', CVAR_NOSET).value);
    if (port = 0) then
    begin
      port := Round(Cvar_Get('clientport', va('%d', [PORT_CLIENT]), CVAR_NOSET).value);
      if (port = 0) then
        port := PORT_ANY;
    end;
    ipx_sockets[NS_CLIENT] := NET_IPXSocket(port);
    if (ipx_sockets[NS_CLIENT] = 0) then
      ipx_sockets[NS_CLIENT] := NET_IPXSocket(PORT_ANY);
  end;
end;

{*
====================
NET_Config

A single player game will only use the loopback code
====================
*}
procedure NET_Config(multiplayer: qboolean);
const
{$IFDEF COMPILER6_UP}{$WRITEABLECONST ON}{$ENDIF}
  old_config: qboolean = False;
{$IFDEF COMPILER6_UP}{$WRITEABLECONST OFF}{$ENDIF}
var
  i: netsrc_t;
begin
  if (old_config = multiplayer) then
    Exit;

  old_config := multiplayer;

  if not multiplayer then
  begin                                 // shut down any existing sockets
    for i := NS_CLIENT to NS_SERVER do
    begin
      if (ip_sockets[i] <> 0) then
      begin
        closesocket(ip_sockets[i]);
        ip_sockets[i] := 0;
      end;
      if (ipx_sockets[i] <> 0) then
      begin
        closesocket(ipx_sockets[i]);
        ipx_sockets[i] := 0;
      end;
    end;
  end
  else
  begin                                 // open sockets
    if (noudp.value = 0) then
      NET_OpenIP;
    if (noipx.value = 0) then
      NET_OpenIPX;
  end;
end;

// sleeps msec or until net socket is ready

procedure NET_Sleep(msec: Integer);
var
  timeout: timeval;
  fdset: TFDSet;
  i: Integer;
begin
  if (dedicated = nil) or (dedicated.value = 0) then
    Exit;                               // we're not a server, just run full speed

  FD_ZERO(fdset);
  i := 0;
  if (ip_sockets[NS_SERVER] <> 0) then
  begin
{$IFDEF USE_JWA}
    _FD_SET(ip_sockets[NS_SERVER], fdset); // network socket
{$ELSE}
    FD_SET(ip_sockets[NS_SERVER], fdset); // network socket
{$ENDIF}
    i := ip_sockets[NS_SERVER];
  end;
  if (ipx_sockets[NS_SERVER] <> 0) then
  begin
{$IFDEF USE_JWA}
    _FD_SET(ipx_sockets[NS_SERVER], fdset); // network socket
{$ELSE}
    FD_SET(ipx_sockets[NS_SERVER], fdset); // network socket
{$ENDIF}
    if (ipx_sockets[NS_SERVER] > i) then
      i := ipx_sockets[NS_SERVER];
  end;
  timeout.tv_sec := msec div 1000;
  timeout.tv_usec := (msec mod 1000) * 1000;
  select(i + 1, @fdset, nil, nil, @timeout);
end;

//===================================================================

var
  winsockdata: WSADATA;

{*
====================
NET_Init
====================
*}
procedure NET_Init;
var
  //  wVersionRequested: Word; //Clootie: never used
  r: Integer;
begin
  //  wVersionRequested := MAKEWORD(1, 1); //Clootie: never used

  r := WSAStartup(MAKEWORD(1, 1), winsockdata);

  if (r <> 0) then
    Com_Error(ERR_FATAL, 'Winsock initialization failed.', []);

  Com_Printf('Winsock Initialized'#10, []);

  noudp := Cvar_Get('noudp', '0', CVAR_NOSET);
  noipx := Cvar_Get('noipx', '0', CVAR_NOSET);

  net_shownet := Cvar_Get('net_shownet', '0', 0);
end;

{*
====================
NET_Shutdown
====================
*}
procedure NET_Shutdown;
begin
  NET_Config(False);                    // close sockets

  WSACleanup;
end;

{*
====================
NET_ErrorString
====================
*}
function NET_ErrorString: PChar;
var
  code: Integer;
begin
  code := WSAGetLastError;
  case (code) of
    WSAEINTR: Result := 'WSAEINTR';
    WSAEBADF: Result := 'WSAEBADF';
    WSAEACCES: Result := 'WSAEACCES';
    WSAEDISCON: Result := 'WSAEDISCON';
    WSAEFAULT: Result := 'WSAEFAULT';
    WSAEINVAL: Result := 'WSAEINVAL';
    WSAEMFILE: Result := 'WSAEMFILE';
    WSAEWOULDBLOCK: Result := 'WSAEWOULDBLOCK';
    WSAEINPROGRESS: Result := 'WSAEINPROGRESS';
    WSAEALREADY: Result := 'WSAEALREADY';
    WSAENOTSOCK: Result := 'WSAENOTSOCK';
    WSAEDESTADDRREQ: Result := 'WSAEDESTADDRREQ';
    WSAEMSGSIZE: Result := 'WSAEMSGSIZE';
    WSAEPROTOTYPE: Result := 'WSAEPROTOTYPE';
    WSAENOPROTOOPT: Result := 'WSAENOPROTOOPT';
    WSAEPROTONOSUPPORT: Result := 'WSAEPROTONOSUPPORT';
    WSAESOCKTNOSUPPORT: Result := 'WSAESOCKTNOSUPPORT';
    WSAEOPNOTSUPP: Result := 'WSAEOPNOTSUPP';
    WSAEPFNOSUPPORT: Result := 'WSAEPFNOSUPPORT';
    WSAEAFNOSUPPORT: Result := 'WSAEAFNOSUPPORT';
    WSAEADDRINUSE: Result := 'WSAEADDRINUSE';
    WSAEADDRNOTAVAIL: Result := 'WSAEADDRNOTAVAIL';
    WSAENETDOWN: Result := 'WSAENETDOWN';
    WSAENETUNREACH: Result := 'WSAENETUNREACH';
    WSAENETRESET: Result := 'WSAENETRESET';
    WSAECONNABORTED: Result := 'WSWSAECONNABORTEDAEINTR';
    WSAECONNRESET: Result := 'WSAECONNRESET';
    WSAENOBUFS: Result := 'WSAENOBUFS';
    WSAEISCONN: Result := 'WSAEISCONN';
    WSAENOTCONN: Result := 'WSAENOTCONN';
    WSAESHUTDOWN: Result := 'WSAESHUTDOWN';
    WSAETOOMANYREFS: Result := 'WSAETOOMANYREFS';
    WSAETIMEDOUT: Result := 'WSAETIMEDOUT';
    WSAECONNREFUSED: Result := 'WSAECONNREFUSED';
    WSAELOOP: Result := 'WSAELOOP';
    WSAENAMETOOLONG: Result := 'WSAENAMETOOLONG';
    WSAEHOSTDOWN: Result := 'WSAEHOSTDOWN';
    WSASYSNOTREADY: Result := 'WSASYSNOTREADY';
    WSAVERNOTSUPPORTED: Result := 'WSAVERNOTSUPPORTED';
    WSANOTINITIALISED: Result := 'WSANOTINITIALISED';
    WSAHOST_NOT_FOUND: Result := 'WSAHOST_NOT_FOUND';
    WSATRY_AGAIN: Result := 'WSATRY_AGAIN';
    WSANO_RECOVERY: Result := 'WSANO_RECOVERY';
    WSANO_DATA: Result := 'WSANO_DATA';
  else
    Result := 'NO ERROR';
  end;
end;

end.