В последнее время я получил уже несколько однотипных жалоб со стороны знакомых разработчиков, заключающиеся в том, что в инете нормальных примеров по сетям, реализованных на 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 клиент-сервер на блокирующих сокетах.
Всем, кому понравилось сие творение, предлагаю создать новый проект и аккуратно, шаг за шагом, своими руками написать по образу и подобию вышеизложенные элементы кода, но уже в свои программы) Таким образом и тупого скачивания исходников не будет и через руки знания впитаются)