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

 FEvents[1] := WSACreateEvent;

 if FEvents[1] = WSA_INVALID_EVENT then

  raise ESocketError.Create(

   'Ошибка при создании события для сервера: ' + GetErrorString);

 if WSAEventSelect(FServerSocket, FEvents[1], FD_ACCEPT) = SOCKET_ERROR then

  raise ESocketError.Create(

   'Ошибка при привязывании серверного сокета к событию: ' + GetErrorString);

 FClientThreads := TList.Create;

 inherited Create(False);

end;

destructor TListenThread.Destroy;

begin

 // Убираем за собой

 FClientThreads.Free;

 WSACloseEvent(FEvents[0]);

 WSACloseEvent(FEvents[1]);

 inherited;

end;

procedure TListenThread.Execute;

var

 // Сокет, созданный для общения с подключившимся клиентом

 ClientSocket: TSocket;

 // Адрес подключившегося клиента

 ClientAddr: TSockAddr;

 ClientAddrLen: Integer;

 NetEvents: TWSANetworkEvents;

 I: Integer;

 WaitRes: Cardinal;

begin

 LogMessage('Сервер начал работу');

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

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

Здесь следует пояснить, почему выбран такой способ управления временем жизни объектов клиентских нитей. Очевидно, что нужно иметь список всех нитей, чтобы обеспечить возможность останавливать их и ставить в очередь сообщения для отправки клиентам (этот список реализован переменной FClientThreads). Если бы объект TClientThread автоматически удалялся при завершении работы нити, в его деструкторе пришлось бы предусмотреть и удаление ссылки на объект из списка, а это значит, что к списку пришлось бы обращаться из разных нитей. Соответственно, потребовалось бы синхронизировать обращение к списку, и здесь мы бы столкнулись с одной неприятной проблемой. Когда нить TListenThread получает команду завершиться, она должна завершить все клиентские нити. Для этого она должна использовать их список для отправки сигнала и ожидания их завершения. И получилась бы взаимная блокировка, потому что нить TListenThread ждала бы завершения клиентских нитей, а они не могли бы завершиться, потому что им требовался бы список, захваченный нитью TListenThread. Избежать этого можно с помощью асинхронных сообщений, но в нашем случае реализация этого механизма затруднительна (хотя и возможна). Для простоты был выбран другой вариант: клиентские нити сами свои объекты не удаляют, а к списку имеет доступ только нить TListenThread, которая время от времени проходит по по списку и удаляет объекты всех завершившихся нитей. В этом случае клиентские нити не используют синхронизацию при завершении, и нить TListenThread может дожидаться их.

Нить TListenThread использует два события: FEvents[0] для получения сигнала о необходимости закрытия и FEvents[1] для получения уведомлений о возникновении события FD_ACCEPT на слушающем сокете (т.е. о подключении клиента). Порядок следования событий к массиве определяется теми же соображениями, что и в случае клиентской нити: сигнал остановки нити должен иметь более высокий приоритет. чтобы в случае DoS-атаки нить могла быть остановлена.

И поиск завершившихся нитей, и отправка сообщений с текущим временем клиентам осуществляется в том случае, если при ожидании события произошёл тайм-аут (который в нашем случае равен 15 c). Подключение клиента — событие достаточно редкое, поэтому такое решение выгладит вполне оправданным. Для тех экзотических случаев, когда клиенты часто подключаются и отключаются, можно предусмотреть еще одно событие у нити TListenThread, при наступлении которого она будет проверять список клиентов. Клиентская нить при своем завершении будет взводить это событие. Что же касается отправки сообщений клиентам, то в обработчик тайм-аута этот код помещён в демонстрационных целях. В реальной программе инициировать отправку сообщений клиентам будет, скорее всего, другой код, например, код главной нити по команде пользователя.