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 fIPC;{$J+}

    35 interface

    36 uses Messages, WinSock, Windows;

    37 const

    38       IN_IPC_PORT  = 46631;

    39       WM_ASYNC_IPCEVENT = WM_USER + 1;

    40 

    41 function InitIPCServer: boolean;

    42 procedure SendIPC(s: shortstring);

    43 procedure IPCEvent(sock: TSocket; lParam: LPARAM);

    44 

    45 var DemoFileName: string;

    46 

    47 implementation

    48 uses fGUI, fMisc, fNet, uConsts, fGame, SysUtils, fConsts;

    49 

    50 var hIPCListenSockTCP : TSocket = INVALID_SOCKET;

    51     hIPCServerSocket  : TSocket = INVALID_SOCKET;

    52 

    53 function InitIPCServer: boolean;

    54 var myaddrTCP: TSockAddrIn;

    55     t: integer;

    56 begin

    57 Result:= false;

    58 hIPCListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0);

    59 myaddrTCP.sin_family      := AF_INET;

    60 myaddrTCP.sin_addr.s_addr := $0100007F;

    61 myaddrTCP.sin_port        := htons(IN_IPC_PORT);

    62 t:= sizeof(TSockAddrIn);

    63 if (   bind(hIPCListenSockTCP, myaddrTCP, t) <> 0) then exit;

    64 if ( listen(hIPCListenSockTCP, 1)            <> 0) then exit;

    65 WSAAsyncSelect(hIPCListenSockTCP, hwndMain, WM_ASYNC_IPCEVENT, FD_ACCEPT or FD_READ or FD_CLOSE);

    66 Result:= true

    67 end;

    68 

    69 procedure SendIPC(s: shortstring);

    70 begin

    71 if hIPCServerSocket <> INVALID_SOCKET then

    72    begin

    73    send(hIPCServerSocket, s[0], Succ(byte(s[0])), 0);

    74    if fWriteDemo then

    75       if not((Length(s) > 5) and (copy(s, 1, 5) = 'ebind')) then

    76          WriteRawToDemo(s)

    77    end;

    78 end;

    79 

    80 procedure SendConfig;

    81 const cBufLength = $10000;

    82 {$INCLUDE revision.inc}

    83 var f: file;

    84     buf: array[0..Pred(cBufLength)] of byte;

    85     i, t: integer;

    86     s: shortstring;

    87     sbuf:string;

    88 begin

    89 SendIPC('WFrontend svn ' + cRevision);

    90 SendIPC(format('e$sound %d',[SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0)]));

    91 case GameType of

    92     gtLocal: begin

    93              SendIPC('eaddteam');

    94              ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg');

    95              SendIPC('ecolor 65535');

    96              SendIPC('eadd hh0 0');

    97              SendIPC('eadd hh1 0');

    98              SendIPC('eadd hh2 0');

    99              SendIPC('eadd hh3 0');

   100              SendIPC('eaddteam');

   101              ExecCFG(Pathz[ptTeams] + 'test.cfg');

   102              SendIPC('eadd hh0 1');

   103              SendIPC('eadd hh1 1');

   104              SendIPC('eadd hh2 1');

   105              SendIPC('eadd hh3 1');

   106              SendIPC('ecolor 16776960');

   107              end;

   108      gtDemo: begin

   109              AssignFile(f, DemoFileName);

   110              {$I-}

   111              Reset(f, 1);

   112              if IOResult <> 0 then

   113                 begin

   114                 SendIPC('ECannot open file: "' + Pathz[ptDemos] + sbuf + '"');

   115                 exit;

   116                 end;

   117              s:= 'TD';

   118              s[0]:= #6;

   119              PLongWord(@s[3])^:= FileSize(f);

   120              SendIPC(s);  // посылаем тип игры - демо и размер демки

   121              BlockRead(f, buf, cBufLength, t); // вырезаем seed

   122              i:= 0;

   123              while (chr(buf[i]) <> cDemoSeedSeparator)and (i < t) do inc(i);

   124              inc(i);

   125              // посылаем остаток файла

   126              repeat

   127              while i < t do

   128                    begin

   129                    CopyMemory(@s[0], @buf[i], Succ(buf[i]));

   130                    SendIPC(s);

   131                    inc(i, buf[i]);

   132                    inc(i)

   133                    end;

   134              i:= 0;

   135              BlockRead(f, buf, cBufLength, t);

   136              until t = 0;

   137              Closefile(f);

   138              {$I+}

   139              end;

   140      gtNet: SendNet('C');

   141      end;

   142 end;

   143 

   144 procedure ParseIPCCommand(s: shortstring);

   145 begin

   146 case s[1] of

   147      '?': if GameType = gtNet then SendNet('?') else SendIPC('!');

   148      'C': SendConfig;

   149      else if GameType = gtNet then SendNet(s);

   150           if fWriteDemo and (s[1] <> '+') then WriteRawToDemo(s)

   151      end;

   152 end;

   153 

   154 procedure IPCEvent(sock: TSocket; lParam: LPARAM);

   155 const sipc: string = '';

   156 var WSAEvent: word;

   157     i: integer;

   158     buf: array[0..255] of byte;

   159     s: shortstring absolute buf;

   160 begin

   161 WSAEvent:= WSAGETSELECTEVENT(lParam);

   162 case WSAEvent of

   163    FD_CLOSE: begin

   164              closesocket(sock);

   165              hIPCServerSocket:= INVALID_SOCKET;

   166              exit

   167              end;

   168     FD_READ: begin

   169              repeat

   170              i:= recv(sock, buf[1], 255, 0);

   171              if i > 0 then

   172                 begin

   173                 buf[0]:= i;

   174                 sipc:= sipc + s;

   175                 SplitStream2Commands(sipc, ParseIPCCommand);

   176                 end;

   177              until i < 1;

   178              end;

   179  FD_ACCEPT:  hIPCServerSocket:= accept(hIPCListenSockTCP, nil, nil);

   180    end

   181 end;

   182 

   183 end.