hedgewars/fNet.pas
changeset 25 27aa8030322b
parent 24 79c411363184
child 26 e32fa14529f8
equal deleted inserted replaced
24:79c411363184 25:27aa8030322b
     1 (*
       
     2  * Hedgewars, a worms-like game
       
     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
       
     4  *
       
     5  * Distributed under the terms of the BSD-modified licence:
       
     6  *
       
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
       
     8  * of this software and associated documentation files (the "Software"), to deal
       
     9  * with the Software without restriction, including without limitation the
       
    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
       
    11  * sell copies of the Software, and to permit persons to whom the Software is
       
    12  * furnished to do so, subject to the following conditions:
       
    13  *
       
    14  * 1. Redistributions of source code must retain the above copyright notice,
       
    15  *    this list of conditions and the following disclaimer.
       
    16  * 2. Redistributions in binary form must reproduce the above copyright notice,
       
    17  *    this list of conditions and the following disclaimer in the documentation
       
    18  *    and/or other materials provided with the distribution.
       
    19  * 3. The name of the author may not be used to endorse or promote products
       
    20  *    derived from this software without specific prior written permission.
       
    21  *
       
    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
       
    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
       
    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
       
    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
       
    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
       
    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
       
    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
       
    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
       
    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
       
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
       
    32  *)
       
    33 
       
    34 unit fNet;{$J+}
       
    35 interface
       
    36 uses Messages, WinSock, Windows;
       
    37 const
       
    38       NET_PORT = 46632;
       
    39       WM_ASYNC_NETEVENT = WM_USER + 2;
       
    40 
       
    41 procedure SendNet(s: shortstring);
       
    42 procedure SendNetAndWait(s: shortstring);
       
    43 procedure NetConnect;
       
    44 procedure NetEvent(sock: TSocket; lParam: LPARAM);
       
    45 
       
    46 var
       
    47     TeamCount: LongWord;
       
    48 
       
    49 implementation
       
    50 uses fGUI, fMisc, fGame, fIPC, uConsts, IniFiles, SysUtils;
       
    51 var
       
    52     hNetClientSocket: TSocket = INVALID_SOCKET;
       
    53     isPonged: boolean;
       
    54 
       
    55 procedure SendNet(s: shortstring);
       
    56 begin
       
    57 if hNetClientSocket <> INVALID_SOCKET then
       
    58    send(hNetClientSocket, s[0], Succ(byte(s[0])), 0)
       
    59 end;
       
    60 
       
    61 procedure SendNetAndWait(s: shortstring);
       
    62 begin
       
    63 SendNet(s);
       
    64 SendNet('?');
       
    65 isPonged:= false;
       
    66 repeat
       
    67   ProcessMessages;
       
    68   sleep(1)
       
    69 until isPonged
       
    70 end;
       
    71 
       
    72 procedure ParseNetCommand(s: shortstring);
       
    73 var sbuf : string;
       
    74 begin
       
    75 case s[1] of
       
    76      '?': SendNet('!');
       
    77      'i': begin
       
    78           sbuf:= GetWindowTextStr(HNetNameEdit);
       
    79           SendNet('n' + sbuf);;
       
    80           end;
       
    81      'z': begin
       
    82           seed:= copy(s, 2, length(s) - 1)
       
    83           end;
       
    84      'G': begin
       
    85           GameType:= gtNet;
       
    86           GameStart
       
    87           end;
       
    88      '@': ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg');
       
    89      '!': begin
       
    90           isPonged:= true;
       
    91           SendIPC('!');
       
    92           end;
       
    93      'T': TeamCount:= PLongWord(@s[2])^
       
    94      else SendIPC(s) end;
       
    95 end;
       
    96 
       
    97 procedure NetConnect;
       
    98 var rmaddr: SOCKADDR_IN;
       
    99     inif: TIniFile;
       
   100     sbuf1,sbuf2: string;
       
   101 begin
       
   102 sbuf1:= GetWindowTextStr(HNetIPEdit);
       
   103 inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');
       
   104 inif.WriteString('Net','IP' , sbuf1);
       
   105 sbuf2:= GetWindowTextStr(HNetNameEdit);
       
   106 inif.WriteString('Net','Nick', sbuf2);
       
   107 inif.Free;
       
   108 SetWindowText(HNetConnectionStatic,'Connecting...');
       
   109 rmaddr.sin_family      := AF_INET;
       
   110 rmaddr.sin_addr.s_addr := inet_addr(PChar(sbuf1));
       
   111 rmaddr.sin_port        := htons(NET_PORT);
       
   112 hNetClientSocket:= socket(AF_INET, SOCK_STREAM, 0);
       
   113 if INVALID_SOCKET = hNetClientSocket then
       
   114    begin
       
   115    MessageBox(hwndMain,'connect failed','failed',MB_OK);
       
   116    SetWindowText(HNetConnectionStatic,'Error on connect');
       
   117    exit
       
   118    end;
       
   119 WSAAsyncSelect(hNetClientSocket, hwndMain, WM_ASYNC_NETEVENT, FD_CONNECT or FD_READ or FD_CLOSE);
       
   120 connect(hNetClientSocket, rmaddr, sizeof(rmaddr))
       
   121 end;
       
   122 
       
   123 procedure NetEvent(sock: TSocket; lParam: LPARAM);
       
   124 const snet: string = '';
       
   125 var WSAEvent: word;
       
   126     i: integer;
       
   127     buf: array[0..255] of byte;
       
   128     s: shortstring absolute buf;
       
   129 begin
       
   130 WSAEvent:= WSAGETSELECTEVENT(lParam);
       
   131 case WSAEvent of
       
   132    FD_CLOSE: begin
       
   133              closesocket(sock);
       
   134 //           hIPCServerSocket:= INVALID_SOCKET;      гм-гм... FIXME: что-то тут должно быть имхо
       
   135              SetWindowText(HNetConnectionStatic, 'Disconnected');
       
   136              GameType:= gtLocal
       
   137              end;
       
   138     FD_READ: begin
       
   139              repeat
       
   140              i:= recv(sock, buf[1], 255, 0);
       
   141              if i > 0 then
       
   142                 begin
       
   143                 buf[0]:= i;
       
   144                 snet:= snet + s;
       
   145                 SplitStream2Commands(snet, ParseNetCommand);
       
   146                 end;
       
   147              until i < 1
       
   148              end;
       
   149  FD_CONNECT: begin
       
   150              i:= WSAGETSELECTERROR(lParam);
       
   151              if i<>0 then
       
   152                 begin
       
   153                 closesocket(sock);
       
   154                 MessageBox(hwndMain,'Error on connect', 'Error', MB_OK);
       
   155                 SetWindowText(HNetConnectionStatic, 'Error on connect')
       
   156                 end else
       
   157                 begin
       
   158                 SetWindowText(HNetConnectionStatic,'connected');
       
   159                 GameType:= gtNet
       
   160                 end;
       
   161              end
       
   162     end
       
   163 end;
       
   164 
       
   165 end.