А. Григорьев - О чём не пишут в книгах по Delphi

// Начинаем бесконечный цикл

repeat

// Ожидание события с 15-секундным тайм-аутом

WaitRes :=

WSAWaitForMultipleEvents(2, @FEvents, False, 15000, False);

case WaitRes of

WSA_WAIT_EVENT_0:

// Событие FEvents[0] взведено - это означает, что

// сервер должен остановиться.

begin

LogMessage('Сервер получил сигнал завершения работы');

// Просто выходим из цикла, остальное сделает код после цикла

Break;

end;

WSA_WAIT_EVENT_0 + 1:

// Событие FEvents[1] взведено.

// Это должно означать наступление события FD_ACCEPT.

begin

// Проверяем, почему событие взведено,

// и заодно сбрасываем его

if WSAEnumNetworkEvents(FServerSocket, FEvents[1], NetEvents) = SOCKET_ERROR then

begin

LogMessage('Ошибка при получении списка событий: ' +

GetErrorString);

Break;

end;

// Защита от "тупой" ошибки - проверка того,

// что наступило нужное событие

if NetEvents.lNetworkEvents and FD_ACCEPT = 0 then

begin

LogMessage(

'Внутренняя ошибка сервера - неизвестное событие');

Break;

end;

// Проверка, не было ли ошибок

if NetEvents.iErrorCode[FD_ACCEPT_BIT] <> 0 then

begin

LogMessage('Ошибка при подключении клиента: ' +

GetErrorString(NetEvents.iErrorCode[FD_ACCEPT_BIT]));

Break;

end;

ClientAddrLen := SizeOf(ClientAddr);

// Проверяем наличие подключения

ClientSocket :=

accept(FServerSocket, @ClientAddr, @ClientAddrLen);

if ClientSocket = INVALID_SOCKET then

begin

// Ошибка в функции accept возникает только тогда, когда

// происходит нечто экстраординарное. Продолжать работу

// в этом случае бессмысленно. Единственное возможное

// в нашем случае исключение - ошибка WSAEWOULDBLOCK,

// которая может возникнуть, если срабатывание события

// было ложным, и подключение от клиента отсутствует

if WSAGetLastError <> WSAEWOULDBLOCK then

begin

LogMessage('Ошибка при подключении клиента: ' +

GetErrorString);

Break;

end;

end;

// Создаем новую нить для обслуживания подключившегося клиента

// и передаем ей сокет, созданный для взаимодействия с ним.

// Указатель на нить сохраняем в списке

FClientThreads.Add(

TClientThread.Create(ClientSocket, ClientAddr));

end;

WSA_WAIT_TIMEOUT:

// Ожидание завершено по тайм-ауту

begin

// Проверяем, есть ли клиентские нити, завершившие работу.

// Если есть такие нити, удаляем их из списка

// и освобождаем объекты

for I := FClientThreads.Count -1 downto 0 do

if TClientThread(FClientThreads[I]).Finished then

begin

TClientThread(FClientThreads[I]).Free;

FClientThreads.Delete(I);

end;

// Если разрешены сообщения от сервера, отправляем

// всем клиентам сообщение с текущим временем

if FServerMsg then

for I := 0 to FClientThreads.Count - 1 do

TClientThread(FClientThreads[I]).SendString(

'Время на сервере ' + TimeToStr(Now));

end;

WSA_WAIT_FAILED:

// При ожидании возникла ошибка. Это может означать

// только какой-то серьезный сбой в библиотеке сокетов.

begin

LogMessage('Ошибка при ожидании события сервера: ' +

GetErrorString);

Break;

end;

else

// Неожиданный результат при ожидании

begin

LogMessage(

'Внутренняя ошибка сервера — неожиданный результат ожидания '

+ IntToStr(WaitRes));

Break;

end;

end;

until False;

// Останавливаем и уничтожаем все нити клиентов

for I := 0 to FClientThreads.Count - 1 do

begin

TClientThread(FClientThreads[I]).StopThread;

TClientThread(FClientThreads[I]).WaitFor;

TClientThread(FClientThreads[I]).Free;

end;

closesocket(FServerSocket);

LogMessage('Сервер завершил работу');

Synchronize(ServerForm.OnStopServer);

end;

// Завершение работы сервера. Просто взводим соответствующее

// событие, а остальное делает код в методе Execute.

procedure TListenThread.StopServer;

begin

WSASetEvent(FEvents[0));

end;

end.

Нить TListenThreadреализует сразу несколько функций. Во-первых, она обслуживает подключение клиентов и создает нити для их обслуживания. Во-вторых, уничтожает объекты завершившихся нитей. В-третьих, она с определённой периодичностью ставит в очередь на отправку всем клиентам сообщение с текущим временем сервера. И в-четвертых, управляет уничтожением клиентских нитей при завершении работы сервера.