SHARE
TWEET

Untitled

a guest Mar 18th, 2012 47 Never
  1. program server;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils,
  7.   dll39;
  8.  
  9. type
  10.   ar = array [0..256] of double;
  11.  
  12. var
  13.   x, y, angle, tmpid, socket, messag, listen, bytes, bytes2 : double;
  14.   port, id : word;
  15.   len : byte;
  16.   str : ansistring;
  17.   i, k : integer;
  18.   userlist, idlist : ar;
  19.  
  20. function listfind(a: ar; b: double) : smallint;
  21. var i: smallint;
  22. begin
  23.   i := 0;
  24.   repeat
  25.   i := i + 1;
  26.   until a[i] = b;
  27.   if (i = 258) then
  28.   begin
  29.     result := -1;
  30.   end
  31.   else
  32.   begin
  33.     result := i;
  34.   end;
  35. end;
  36.  
  37. function listdel(a: ar; b: byte) : ar;
  38. var i, size: word;
  39. begin
  40.   size := listfind(a, 0);
  41.   for i := b to size do
  42.     a[i] := a[i + 1];
  43.   size := size - 1;
  44.   result := a;
  45. end;
  46.  
  47. function listadd(a: ar; b: integer) : ar;
  48. var i, size: word;
  49. begin
  50.   size := listfind(a, 0);
  51.   for i := 0 to size do
  52.   begin
  53.     if (a[i] = 0) then
  54.     begin
  55.       a[i] := b;
  56.       size := size + 1;
  57.       result := a;
  58.     end;
  59.     if (a[i] = b) then
  60.       break;
  61.   end;
  62. end;
  63.  
  64. procedure sendstring(a: ansistring; b : double); // Процедура отправки строки (sendstring('Ваш текст', socket))
  65. var i: byte;
  66. begin
  67.   clearbuffer(0);
  68.   str := a;
  69.   len := length(str);
  70.   writebyte(len, 0);
  71.   for i := 1 to len do
  72.     writebyte(ord(str[i]), 0);
  73.   messagesend(b, '', 0, 0);
  74. end;
  75.  
  76. begin
  77.   id := 1;
  78.   write('by Fil.9dll.ru'#10#13'Welcome to the server! xD'#10#13#10#13'enter the port... ');
  79.   read(port);
  80.   listen := tcplisten(port, 256, 1);
  81.   if (listen = 0) then
  82.     writeln('listen port... fail!')
  83.   else
  84.     writeln('listen port... success!'#10#13);
  85.   while(true) do
  86.   begin
  87.     socket := tcpaccept(listen, 1);
  88.     if not(socket < 0) then
  89.     begin
  90.       writeln('client connected! ', round(socket));
  91.       clearbuffer(0);
  92.       writebyte(1, 0);
  93.       writebyte(id, 0);
  94.       messagesend(socket, '', 0, 0);
  95.       idlist := listadd(idlist, id);
  96.  
  97.       {Отправка id всех остальных игроков новому игроку}
  98.       if not(userlist[0] = 0) then
  99.       begin
  100.         {Отправка новому игроку id всех игроков}
  101.         clearbuffer(0);
  102.         writebyte(2, 0);
  103.         writebyte(listfind(userlist, 0), 0);
  104.         for i := 0 to listfind(userlist, 0) - 1 do
  105.           writebyte(round(idlist[i]), 0);
  106.         messagesend(socket, '', 0, 0);
  107.         {Отправка всем id нового игрока}
  108.         clearbuffer(0) ;
  109.         writebyte(3, 0);
  110.         writebyte(id, 0);
  111.         for i := 0 to listfind(userlist, 0) - 1 do
  112.           messagesend(userlist[i], '', 0, 0);
  113.       end;
  114.       userlist := listadd(userlist, round(socket)); // Добавляем socket игрока в массив
  115.       id := id + 1;
  116.     end;
  117.     for i := 0 to listfind(userlist, 0) do
  118.     begin
  119.       messag := messagerecieve(userlist[i], 0, 0);
  120.       if (messag > 0) then
  121.       begin
  122.         //writeln('received ', round(messag), ' bytes');
  123.         bytes := round(readbyte(0));
  124.         if (bytes = 0) then // Пришло сообщение от контролера
  125.         begin
  126.           bytes2 := round(readbyte(0));
  127.           if (bytes2 = 0) then // Выключить сервер
  128.             exit;
  129.           if (bytes2 = 1) then // Запрос количества игроков
  130.           begin
  131.             clearbuffer(0);
  132.             writebyte(0, 0);
  133.             writebyte(listfind(userlist, 0), 0);
  134.             messagesend(userlist[i], '', 0, 0);
  135.           end;
  136.         end;
  137.         if (bytes = 1) then // Игрок ушел с сервера
  138.         begin
  139.           userlist := listdel(userlist, i); // Удаляем id игрока из массива
  140.           idlist := listdel(idlist, i);
  141.           writeln('client left the server!');
  142.         end;
  143.         if (bytes = 2) then // Отправка данных о игроке (айди, х, у и т.д) всем остальным игрокам
  144.         begin
  145.           tmpid := round(readbyte(0));
  146.           x := round(readshort(0));
  147.           y := round(readshort(0));
  148.           angle := round(readshort(0));
  149.           clearbuffer(0);
  150.           writebyte(4, 0);
  151.           writebyte(tmpid, 0);
  152.           writeshort(x, 0);
  153.           writeshort(y, 0);
  154.           writeshort(angle, 0);
  155.           for k := 0 to listfind(userlist, 0) - 1 do
  156.           begin
  157.             if not(userlist[i] = userlist[k]) then
  158.             begin
  159.               messagesend(userlist[k], '', 0, 0);
  160.             end;
  161.           end;
  162.         end;
  163.       end;
  164.     end;
  165.   end;
  166. readln;
  167. {
  168.             str := '';
  169.             len := round(readbyte(1));
  170.             for k := 1 to len do
  171.               str := str + chr(round(readbyte(1)));
  172.             writeln('received message: ', str, #10#13);
  173. }
  174. end.
RAW Paste Data
Top