net_wins.pas

雷神之锤2(Quake2)Delphi源码

        Continue;
      end;

      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; // struct timeval
  fdset: TFDSet;
//	extern cvar_t *dedicated;
  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.