В последнее время я получил уже несколько однотипных жалоб со стороны знакомых разработчиков, заключающиеся в том, что в инете нормальных примеров по сетям, реализованных на Sockets API, почти не найти, а то что есть, то это в основном простенькие, сделанные на тяп-ляп при помощи компонентов, UDP чаты и не более того (конечно мой чатик к этому не относится :] )

Поэтому я уделил время новой статейке из серии сетевого программирования, в которой решил описать структуру пусть даже и простого эхо-сервера, но зато уже с ориентацией на учёт и обработку подключений. Поэтому думаю что многие заметят в этом полезное деяние)

В данной статье будет рассмотрена разработка сервера и клиента на протоколе UDP средствами стандартных сокетов(сокеты Беркли) в блокирующем режиме.
Для определения готовности сокетов будет использоваться функция select().

Логически предшествующие статьи:
Введение в протокол UDP и пример с исходниками простого чата.

Для начала, как и для любого проекта, определимся что вообще мы хотим видеть в конечном результате, а т.е. сформируем цель, чтобы в ходе разработке наш креативный разум не начал дёргаться в разные стороны и тем самым заставлять наш проект страдать перфекционизмом)

И так, цель данного урока или статьи(как кому удобнее):

создать приложение-сервер на протоколе UDP. Организовать структуру для обработки клиентов и механизм моментального зеркального ответа принятых сообщений;
создать приложение-клиент на протоколе UDP. С возможностью цикличных посылок пакетов установленной длины(в байтах) и с установленной периодичностью. Возможность считать кол-во пакетов(для статистики потери) и замерять отклик сервера;
Работа сокетов будет реализована в блокирующем режиме с использованием функции select().

Вот этого и будем придерживаться.

Начнём с сервера

Весь код, который касается сетевого взаимодействия, можно разделить на несколько частей:

инициация использования процессом библиотеки WinSock;
создание серверного сокета;
формирование сетевого адреса с учётом установленного порта и привязка сокета к этому адресу;
обработка пакетов от клиентов;
закрытие серверного сокета.

Далее приведён листинг основного модуля сервера:

unit uFormMain;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
  StdCtrls, ComCtrls, ExtCtrls, ImgList, CoolTrayIcon, AppEvnts, Menus,  
  MMSystem, WinSock,   
  uSockUtils, uWebSettingForm, uAboutForm, uCadencerStack, uSettings,  
  uFileManager, uArrayUtils, uSimpleUtils;  
  
const  
  c_CLI_TIMER = 8.0; // sec  
  
type  
  TServerStatus = (ssStarted, ssStoped);  
  
  PClientConnection = ^TClientConnection;  
  TClientConnection = record  
    s_addr    : u_long;  // адрес сокета клиента  
    s_port    : u_short;  // порт сокета клиента  
    timer   : single;  // таймер "жизни" клиента  
  end;  
  
  TFormMain = class(TForm)  
  {$REGION ' FORM ELEMENTS and METHODS '}  
    //...  
  {$ENDREGION}  
  private  
    fActivated  : boolean; // активирована ли форма  
    fServStatus : TServerStatus;  
    fServSocket : TSocket;  
    fClients    : TList; // лист указателей PClientConnection  
    f_id_timer  : cardinal;  
    fTimerEnabled : boolean; // для транзакции итерации таймера  
    procedure SetServerStatus(aStatus: TServerStatus);  
    procedure StartServer;  
    procedure StopServer;  
    procedure TimerCreate(var a_id_timer: cardinal);  
    procedure ClearClients;  
    procedure ServerSocketProgress(aDTime: double);  
    procedure ClientsSocketProgress(aDTime: double);  
    procedure TimerProgress(aDTime: double);  
  end;  
  
var  
  FormMain: TFormMain;  
  tf, t1, t2  : int64; // pulse generator vars   
  
// funcs  
  procedure TimerCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;  
  
implementation  
  
{$R *.DFM}  
  
procedure TimerCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD);  
begin  
  QueryPerformanceCounter(t2);  
  FormMain.TimerProgress((t2 - t1) / tf);  
  QueryPerformanceCounter(t1);  
end;  
  
procedure TFormMain.FormCreate(Sender: TObject);  
begin  
  // ... здесь я навожу марафет формы ...
   // 1. инициация библы сокетов процессом программы  
  if not suWSAInit then  
  begin  
    MessageDlg('Ошибка при инициализации библиотеки WinSock', mtError, [mbOK], 0);  
    Application.Terminate;  
  end;  
  fActivated := False;  
  fServStatus := ssStoped;  
  QueryPerformanceFrequency(tf);  
  fClients := TList.Create;  
end;  
  
procedure TFormMain.FormDestroy(Sender: TObject);  
begin  
  FreeAndNil(fClients);  
end;  
  
procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
  if fServStatus = ssStarted then  
    StopServer;  
  //...  
end;  
  
procedure TFormMain.FormActivate(Sender: TObject);  
begin  
  if fActivated then Exit;  
  fActivated := True;  
  StopServer;  
end;  
  
{$REGION ' FORM CTRL EVENTS '}  
// ... тут сосредоточены обработки событий контролов формы ...   
{$ENDREGION}  
  
procedure TFormMain.SetServerStatus(aStatus: TServerStatus);  
begin  
  fServStatus := aStatus;  
  case fServStatus of  
    ssStarted:  
      begin  
        // ... какой-нить марафет ...  
        LogMngInfoEvent('+++ Сервер запущен +++'); // вывод лога на форму   
      end;  
    ssStoped:  
      begin  
        //...  
        LogMngInfoEvent('--- Сервер остановлен ---');  
      end;  
  end;  
end;  
  
procedure TFormMain.StartServer;  
var  
  s_addr  : TSockAddr;  
begin  
  if fServStatus = ssStarted then  
    Exit;  
  // 2. создание серверного сокета  
  fServSocket := socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);     
  if fServSocket = INVALID_SOCKET then  
  begin // ошибка создания  
    LogMngErrorEvent('Error: socket = INVALID_SOCKET!');  
    Exit;  
  end;  
  // 3. формирование адреса сервера  
  FillChar(s_addr.sin_zero, SizeOf(s_addr.sin_zero), 0); // обнуляем байты  
  s_addr.sin_family := AF_INET; // или можно PF_INET - без разницы  
  s_addr.sin_addr.S_addr := INADDR_ANY; // IP-адрес может выбрать система  
  // порт назначаем сами, преобразовав из десятичного в сетевой  
  s_addr.sin_port := htons(Settings.ServerPort);  
  // Привязка сокета к адресу  
  if bind(fServSocket, s_addr, SizeOf(s_addr)) = SOCKET_ERROR then  
  begin // привязка не удалась  
    LogMngErrorEvent('Error: bind = SOCKET_ERROR!');  
    closesocket(fServSocket);  
    Exit;  
  end;  
  TimerCreate(f_id_timer); // создание таймера  
  // Перевод элементов управления в состояние "Сервер работает"  
  SetServerStatus(ssStarted);  
end;  
  
procedure TFormMain.StopServer;  
begin  
  // уничтожам таймер  
  timeKillEvent(f_id_timer);  
  ClearClients; // чистим записи клиентов  
  if fServStatus = ssStarted then  
  begin  
    closesocket(fServSocket); // 5. для UDP можно сразу closesocket()  
    SetServerStatus(ssStoped);  
  end;  
end;  
  
procedure TFormMain.TimerCreate(var a_id_timer: cardinal);  
begin  
  fTimerEnabled := True;  
  QueryPerformanceCounter(t1);  
  a_id_timer := timeSetEvent(Settings.CadencerInterval, 1, @TimerCallBack, 1, TIME_PERIODIC);  
end;  
  
procedure TFormMain.ClearClients;  
var  
  i : integer;  
begin  
  for i := fClients.Count - 1 downto 0 do  
    Dispose(fClients.items[i]);  
  fClients.Clear;  
end;  
  
procedure TFormMain.ServerSocketProgress(aDTime: double);  
const  
  c_DGBS = 65507; // макс. размер датаграммы  
var  
  i : integer;  
  sockSet : TFDSet; // множество для select, заполняется сокетами  
  timeout : TTimeVal; // переменная для select  
  buf     : array[0..c_DGBS - 1] of byte; // буфер для получения сообщения  
  recvLen   : integer; // длина полученных данных  
  recvBuf   : TArrOfByte; // массив уже чисто для пакета  
  recvAddr  : TSockAddr; // адрес, с которого пришло сообщение  
  addrLen   : integer; // длина сетевого адреса  
  bol : boolean;  
  pcli  : PClientConnection;  
begin  
   // 4. обработка сообщений от клиентов 
  FD_ZERO(sockSet); // обнуляем множество  
  FD_SET(fServSocket, sockSet); // добавляем наш сокет  
  timeout.tv_sec := 0; // выставляем 0 чтобы select возвращала результат   
  timeout.tv_usec := 0; // сразу на момент вызова  
  if select(0, @sockSet, nil, nil, @timeout) = SOCKET_ERROR then  
  begin // ошибка выполнения select  
    LogMngErrorEvent('Error: select = SOCKET_ERROR');  
    Exit;  
  end;  
  if FD_ISSET(fServSocket, sockSet) then  
  begin // если наш сокет остался во множестве, значит пришли данные 
    addrLen := SizeOf(recvAddr);  
      // читаем из буфера сокета по максимуму
    recvLen := recvfrom(fServSocket, buf[0], c_DGBS, 0, recvAddr, addrLen);  
    if recvLen <= 0 then // если что-то не так с длиной, то выходим 
      Exit;  
    // проверяем клиента  
    bol := False;  
    for i := fClients.Count - 1 downto 0 do  
      with PClientConnection(fClients.items[i])^ do  
        if (s_addr = recvAddr.sin_addr.S_addr) and  
         (s_port = recvAddr.sin_port) then  
    begin  
      timer := c_CLI_TIMER;  
      bol := True;  
      Break;  
    end;  
    // фиксируем нового клиента  
    if not bol then  
    begin  
      new(pcli);  
      pcli^.s_addr := recvAddr.sin_addr.S_addr;  
      pcli^.s_port := recvAddr.sin_port;  
      pcli^.timer := c_CLI_TIMER;  
      fClients.Add(pcli);  
    end;  
    // формируем принятый пакет в массив байт  
    SetLength(recvBuf, recvLen);  
    move(buf[0], recvBuf[0], recvLen);  
    LogMngInfoEvent('сообщение от клиента ' + inet_ntoa(recvAddr.sin_addr) + ':' +  
      inttostr(ntohs(recvAddr.sin_port)));  
    // посылаем эхо на тот же адрес, с которого пришло сообщение  
    sendto(fServSocket, recvBuf[0], recvLen, 0, recvAddr, addrLen);  
    recvBuf := nil;  
  end;  
end;  
  
procedure TFormMain.ClientsSocketProgress(aDTime: double);  
var  
  i : integer;  
begin  
  for i := fClients.Count - 1 downto 0 do  
    with PClientConnection(fClients.items[i])^ do  
  begin  
    if timer <= 0 then  
    begin // если таймер клиента вышел, то значит он отключился  
      Dispose(fClients.items[i]);  
      fClients.Delete(i);  
    end;  
    timer := timer - aDTime;  
  end;  
end;  
  
procedure TFormMain.TimerProgress(aDTime: double);  
begin // aDTime в секундах  
  if not fTimerEnabled then  
    Exit;  
  fTimerEnabled := False;  
  try  
    ServerSocketProgress(aDTime);  
    ClientsSocketProgress(aDTime);  
  finally  
    fTimerEnabled := True;  
  end;  
end;  
  
end.

Тут чутка есть лишнего для простой демки, т.к. даже маленький проект у меня уже не обходится без некоторых личных модулей утилит и т.п. Поясню некоторые из них:

uSockUtils. В данном модуле содержатся некоторые однообразные функции для сокетов(в основном создание), а в данной программе из него используется только suWSAInit, которая проводит попытку инициации библиотеки сокетов для данного приложения;
uArrayUtils. Имеет ряд типов и утилит для работы с массивами, в данном случае в нём заключон тип TArrOfByte = array of byte;
uSimpleUtils. Содержит всякие мини удобства, чаще всего использую из неё функции its и sti, что есть аббревиатуры функций inttostr и strtoint.

Вот вроде бы и всё, остальные интуитивно понятны или их использование не влияет на суть демки.
Ах да, чуть не забыл показать функцию suWSAInit:

function suWSAInit: boolean;  
var  
  WSAData : TWSAData;  
begin  
  Result := WSAStartup($101, WSAData) = 0;  
end;

Теперь по порядку.

При создании формы инициируется библа сокетов, выставляются флаги, создаются объекты и запрашивается частота генератора импульсов, вобщем как обычно.
Далее идёт активация формы, фиксируем это флагом, чтобы второй такой активации не произошло уже никогда. Тут выставляем всякие статусы и всё что связано с интерфейсом.
Наконец, запускаем сервак по кнопке(или как у вас будет) и выполняется проца StartServer, в которой создаётся серверный сокет, формируется серверный адрес, затем привязывается сокетов к адресу с помощью bind. Это всё вдобавок вроде боле-менее прокомментировано. Далее создаётся высокоточный системный таймер и выставляется статус рабочего сервера.
Выполняется тик таймера. Первым делом начинаем транзакцию(чтоб очередь не нарастала, а то сервак при многочисленных подключениях рано или поздно может крякнуть). Затем обрабатываем серверный сокет, который принимает сообщения и фиксирует новых клиентов. А вторым делом обрабатываем всех клиентов.
Далее можно поставить обработку игрового мира, если такой имеется и т.п.

Стоит упомянуть(а то в реализации этого нет), что если по сети посылается переменная или record, то сначало эти данные можно конвертировать в массив байт, например функцией move(), потом переслать по сети, а на стороне приёмника проделать обратную операцию.
Например (пример передачи переменных):

// посылка  
type  
  TPack = packed record  
    info1: integer;  
    info2: string[200]; { для передачи по сети в рекордах  
      нельзя использовать динамические данные типа string или дин. массивов}  
  end;  
var  
  pack: TPack;  
  arr : array of byte;  
begin  
  setlength(arr, sizeof(pack));  
  move(pack, arr[0], sizeof(pack));  
  sendto(sock, arr[0], sizeof(pack), 0, addr, addrLen);  
end;  
...  
// приём  
var  
  buf: array[0..65507 - 1] of byte;  
begin  
  recvLen := recvfrom(fServSocket, buf[0], c_DGBS, 0, recvAddr, addrLen);    
  setlength(arr, recvLen);  
  move(buf[0], arr[0], recvLen);  
  { потом как-то идентифицируем пакет, чтобы знать какие данные пришли 
    переменная или рекорд например. и читаем соответственно. 
    я сейчас проверю тип пакета просто по размеру }  
  if recvLen = sizeof(pack) then  
    move(arr[0], pack, sizeof(pack));  
  // вуаля, в pack у нас теперь переданная переменная  
end;

В общем случае можно передать любую структуру данных, если выполняются следующие условия:

имеется указатель на данную структуру;
известна длина данных;
данные распологаются в памяти последовательно.

Что можно в первую очередь добавить в целях оптимизации в эту реализацию, дак это дополнительный сокет для отправки сообщений, чтобы уменьшить загруженность буферов главного сокета. Это пойдёт как домашнее задание)

Теперь займёмся клиентом

Весь сетевой код клиента состоит из следующих частей:

инициация использования процессом библиотеки WinSock;
создание сокета;
обработка пакетов от клиентов;
закрытие сокета.

А вот и сам листинг основного модуля клиента:

unit uFormMain;  
  
interface  
  
uses  
  Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ComCtrls,  
  ExtCtrls, MMSystem, WinSock,  
  uSockUtils, uArrayUtils, uSimpleUtils;  
  
type  
  TFormMain = class(TForm)  
    btnCreate: TButton;  
    btnStop: TButton;  
    edIP: TEdit;  
    StatusBar1: TStatusBar;  
    PingTimer: TTimer;  
    edPS: TEdit;  
    edTimerPack: TEdit;  
    PackTimer: TTimer;  
    procedure FormCreate(Sender: TObject);  
    procedure btnStartClick(Sender: TObject);  
    procedure btnStopClick(Sender: TObject);  
    procedure PingTimerTimer(Sender: TObject);  
    procedure PackTimerTimer(Sender: TObject);  
  private  
    fSock : TSocket; // клиентский сокет  
    fServAddr : TSockAddr; // адрес сервера, куда слать пакеты  
    fStopSignal : boolean; //  
    fPing : double;  
    ftq, ft1, ft2 : int64; // для засечки пинга  
    fSentPackCount, fRecvPackCount  : integer;  
    procedure StartTest;  
  end;  
  
var  
  FormMain: TFormMain;  
  
implementation  
  
{$R *.DFM}  
  
procedure TFormMain.FormCreate(Sender: TObject);  
begin  
  if not suWSAInit then  
  begin  
    MessageDlg('Ошибка инициализации библиотеки WinSock', mtError, [mbOK], 0);  
    Application.Terminate;  
  end;  
  QueryPerformanceFrequency(ftq);  
end;  
  
procedure TFormMain.btnStartClick(Sender: TObject);  
begin  
  StartTest;  
end;  
  
procedure TFormMain.btnStopClick(Sender: TObject);  
begin  
  fStopSignal := True;  
end;  
  
procedure TFormMain.PingTimerTimer(Sender: TObject);  
var  
  ps  : integer;  
  pack  : TArrOfByte;  
begin  
  if fStopSignal then  
  begin  
    PingTimer.Enabled := False;  
    Exit;  
  end;  
  QueryPerformanceCounter(ft1);  
  // посылам запрос пинга  
  setlength(pack, 1);  
  try  
    pack[0] := 0;  
    sendto(fSock, pack[0], 1, 0, fServAddr, sizeof(fServAddr));  
    inc(fSentPackCount);  
  finally  
    pack := nil;  
  end;  
end;  
  
procedure TFormMain.PackTimerTimer(Sender: TObject);  
var  
  pl  : integer;  
  pack  : TArrOfByte;  
begin  
  if fStopSignal then  
  begin  
    PackTimer.Enabled := False;  
    Exit;  
  end;  
  // посылам пакет  
  pl := sti(edPS.Text);  
  setlength(pack, pl);  
  try  
    pack[0] := 1;  
    sendto(fSock, pack[0], pl, 0, fServAddr, sizeof(fServAddr));  
    inc(fSentPackCount);  
  finally  
    pack := nil;  
  end;  
end;  
  
procedure TFormMain.StartTest;  
const  
  c_DGBS = 65507;  
var  
  i : integer;  
  t1, t2  : int64;  
var  
  sockSet : TFDSet;  
  timeout : TTimeVal;  
  buf     : array[0..c_DGBS - 1] of byte;  
  recvLen   : integer;  
  recvBuf   : TArrOfByte;  
  recvAddr  : TSockAddr; // Адрес, с которого пришло сообщение  
  addrLen   : integer;  
begin  
  btnCreate.Enabled := False;  
  with fServAddr do  
  begin  
    FillChar(sin_zero, SizeOf(sin_zero), 0);  
    sin_family := AF_INET;  
    sin_addr.S_addr := inet_addr(PAnsiChar(edIP.Text));  
    sin_port := htons(12345);  
  end;  
  fSock := socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);  
  fSentPackCount := 0;  
  fRecvPackCount := 0;  
  fStopSignal := False;  
  PingTimer.Enabled := True;  
  PackTimer.Interval := sti(edTimerPack.Text);  
  PackTimer.Enabled := True;  
  repeat  
    if fStopSignal then  
      Break;  
    FD_ZERO(sockSet);  
    FD_SET(fSock, sockSet);  
    timeout.tv_sec := 0;  
    timeout.tv_usec := 0;  
    if select(0, @sockSet, nil, nil, @timeout) = SOCKET_ERROR then  
    begin  
      //DoError('select = SOCKET_ERROR');  
      Exit;  
    end;  
    if FD_ISSET(fSock, sockSet) then  
    begin  
      addrLen := SizeOf(recvAddr);  
      recvLen := recvfrom(fSock, buf[0], c_DGBS, 0, recvAddr, addrLen);  
      if recvLen <= 0 then  
        Exit;  
      SetLength(recvBuf, recvLen);  
      try  
        move(buf[0], recvBuf[0], recvLen);  
        if recvBuf[0] = 0 then  
        begin  
          // пришёл ответ на пинг  
          QueryPerformanceCounter(ft2);  
          fPing := (ft2 - ft1) / ftq;  
          StatusBar1.Panels[0].Text := Format('ping: %.5f sec', [fPing]);  
        end;  
      finally  
        recvBuf := nil;  
      end;  
      // ссумируем пришедшие пакеты  
      inc(fRecvPackCount);  
    end;  
    // выводим статистику  
    StatusBar1.Panels[1].Text := Format('sent: %d; recv: %d;', [fSentPackCount, fRecvPackCount]);  
    Application.ProcessMessages;  
  until fStopSignal;  
  closesocket(fSock);  
  btnCreate.Enabled := True;  
end;  
  
end.

Здесь уже, в принципе, знакомый код, ничего иного не наблюдается. На форме 2 таймера и 2-е кнопки. По таймеру PingTimer раз в минуту посылается однобайтовый пакет пинга, байт которого = 0. А по таймеру PackTimer посылаются пакеты указанной на форме длины и с указанным интервалом времени, первый байт которых = 1. Различное значение первых байт нам позволяет различать пакет пинга, по возвращению которого мы замеряем задержку отклика сервера, а т.е. lag. Так же при отправке любого пакета идёт инкремент переменной fSentPackCount, а при приёме любого пакета inc(fRecvPackCount), таким образом я прикрутил статистику потерь пакетов.

Вот как всё это хозяйство выглядит в действии:

Не стоит обращать внимание, что во время начала теста до удалённого сервака был большой пинг — это просто торрент по полной качал)

По результатам некоторых тестов с сервером, лаг с которым был равен в среднем 0.09 секунды, были получены следующие данные:

размер = 5000 б, интервал = 100 мс, sent = 9639, recv = 9322, потери = 317;
размер = 40000 б, интервал = 900 мс, sent = 348, recv = 268, потери = 80;
размер = 10 б, интервал = 50 мс, sent = 3174, recv = 3017, потери = 157.

Стоит отметить, что потери зависят от размера пакета и частоты посылки. Т.е. пакет размером в 40000 байт и интервалом посылки в 50 мс вообще почти не доходит обратно. Обратим внимание на тест с пакетом в 40Кб (рекомендуемый максимум): стоит учесть, что раз в секунду идёт пакеты пинга размеров всего лишь в 1 байт, которые в 99% вернутся, поэтому почти половина из посланных пакетов — это пинг пакеты. А т.е. среди жирных пакетов потерялось примерно 60%!

И так, подводя итоги, можно сказать, что получился вполне юзабильный UDP клиент-сервер на блокирующих сокетах.

Всем, кому понравилось сие творение, предлагаю создать новый проект и аккуратно, шаг за шагом, своими руками написать по образу и подобию вышеизложенные элементы кода, но уже в свои программы) Таким образом и тупого скачивания исходников не будет и через руки знания впитаются)

Cyber Code

Программирование, GameDev

Delphi: UDP эхо-сервер и клиент на блокирующих сокетах

Начнём с сервера

Теперь займёмся клиентом

Published by Monax