О чём не пишут в книгах по Delphi

const
 WM_ACCEPTMESSAGE = WM_USER + 1;
 WM_SOCKETMESSAGE = WM_USER + 2;
type
 TWMSocketMessage = packed record
 Msg: Cardinal;
 Socket: TSocket;
 SockEvent: Word;
 SockError: Word;
 end;

Прежде чем реализовывать реакцию на эти сообщения, нужно позаботиться об обработке ошибок. Функция GetErrorString (см. листинг 2.6), столько времени служившая нам верой и правдой, нуждается в некоторых изменениях. Это связано с тем, что теперь код ошибки может быть получен не только в результате вызова функции WSAGetLastError, но и через параметр SockError сообщения. Новый вариант функции GetErrorString иллюстрирует листинг 2.52.

Листинг 2.52. Новый вариант функции GetErrorString

// функция GetErrorString возвращает сообщение об ошибке,
// сформированное системой на основе значения, которое
// передано в качестве параметра. Если это значение
// равно нулю (по умолчанию), функция сама определяет
// код ошибки, используя функцию WSAGetLastError.
// Для получения сообщения используется системная функция
// FormatMessage.
function GetErrorString(Error: Integer = 0): string;
var
 Buffer: array[0..2047] of Char;
begin
 if Error = 0 then Error := WSAGetLastError;
 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, Error, $400,
 @Buffer, SizeOf(Buffer), nil);
 Result := Buffer;
end;

Сам обработчик сообщения WM_ACCEPTMESSAGE приведен в листинге 2.53.

Листинг 2.53. Обработчик сообщения WM_ACCEPTMESSAGE

procedure TServerForm.WMAcceptMessage(var Msg: TWMSocketMessage);
var
 NewConnection: PConnection;
 // Сокет, который создаётся для вновь подключившегося клиента
 ClientSocket: TSocket;
 // Адрес подключившегося клиента
 ClientAddr: TSockAddr;
 // Длина адреса
 AddrLen: Integer;
begin
 // Страхуемся от "тупой" ошибки
 if Msg.Socket <> FServerSocket then
 raise ESocketError.Create(
 'Внутренняя ошибка сервера - неверный серверный сокeт');
 // Обрабатываем ошибку на сокете, если она есть.
 if Msg.SockError <> 0 then
 begin
 MessageDlg('Ошибка при подключении клиента:'#13#10 +
 GetErrorString(Msg.SockError) +
 #13#10'Сервер будет остановлен', mtError, [mbOK], 0);
 ClearConnections;
 closesocket(FServerSocket);
 OnStopServer;
 Exit;
 end;
// Страхуемся от еще одной "тупой" ошибки
 if Msg.SockEvent <> FD_ACCEPT then
 raise ESocketError.Create(
 'Внутренняя ошибка сервера — неверное событие на сокете');
 AddrLen := SizeOf(TSockAddr);
 ClientSocket := accept(FServerSocket, @ClientAddr, @AddrLen);
 if ClientSocket = INVALID_SOCKET then
 begin
 // Если произошедшая ошибка - WSAEWOULDBLOCK, это просто означает,
 // что на данный момент подключений нет, а вообще все в порядке,
 // поэтому ошибку WSAEWOULDBLOCK мы просто игнорируем. Прочие же
 // ошибки могут произойти только в случае серьезных проблем,
 // которые требуют остановки сервера.
 if WSAGetLastError <> WSAEWOULDBLOCK then
 begin
 MessageDlg('Ошибка при подключении клиента:'#13#10 + GetErrorString +
 #13#10'Сервер будет остановлен', mtError, [mbOK], 0);
 ClearConnections;
 closesocket(FServerSocket);
 OnStopServer;
 end;
 end
 else
 begin
 // связываем сообщение с новым сокетом
 if WSAAsyncSelect(ClientSocket, Handle, WM_SOCKETMESSAGE,
 FD_READ or FD_WRITE or FD_CLOSE) = SOCKET_ERROR then
 begin
 MessageDlg('Ошибка при установке асинхронного режима ' +
 'подключившегося сокета:'#13#10 +
 GetErrorString, mtError, [mbOK], 0);
 closesocket(ClientSocket);
 Exit;
 end;
 // Создаем запись для нового подключения и заполняем ее
 New(NewConnection);
 NewConnection.ClientSocket := ClientSocket;
 NewConnection.ClientAddr := Format('%u.%u.%u.%u.%u', [
 Ord(ClientAddr.sin_addr.S_un_b.s_b1),
 Ord(ClientAddr.sin_addr.S_un_b.s_b2),
 Ord(ClientAddr.sin_addr.S_un_b.s_b3),
 Ord(ClientAddr.sin_addr.S_un_b.s_b4),
 ntohs(ClientAddr.sin_port)]);
 NewConnection.Phase := tpReceiveLength;
 NewConnection.Offset := 0;
 NewConnection.BytesLeft := SizeOf(Integer);
 NewConnection.SendRead := False;
 // Добавляем запись нового соединения в список
 FConnections.Add(NewConnection);
 AddMessageToLog('Зафиксировано подключение с адреса ' +