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

if listen(FServerSocket, SOMAXCONN) = SOCKET_ERROR then

begin

MessageDlg('Ошибка при переводе сокета в режим прослушивания:'#13#10 +

GetErrorString, mtError, [mbOK], 0);

closesocket(FServerSocket);

Exit;

end;

// Связь слушающего сокета с событием FD_ACCEPT

if WSAAsyncSelect(FServerSocket, Handle,

WM_ACCEPTMESSAGE, FD_ACCEPT) = SOCKET_ERROR then

begin

MessageDlg('Ошибка при установке асинхронного режима ' +

'cлушающего сокета:'#13#10 + GetErrorString, mtError, [mbOK], 0);

closesocket(FServerSocket);

Exit;

end;

// Перевод элементов управления в состояние "Сервер работает"

LabelPortNumber.Enabled := False;

EditPortNumber.Enabled := False;

BtnStartServer.Enabled := False;

LabelServerState.Caption := 'Сервер работает';

except

on EConvertError do

// Это исключение может возникнуть только в одном месте -

// при вызове StrToInt(EditPortNumber.Text)

MessageDlg('"' + EditPortNumber.Text +

'" не является целый числом', mtError, [mbOK], 0);

on ERangeError do

// Это исключение может возникнуть только в одном месте -

// при присваивании значения номеру порта

MessageDlg('Номер порта должен находиться в диапазоне 1-65535',

mtError, [mbOK], 0);

end;

end;

Этот код мало чем отличается от того, что мы уже видели (сравните, например, с листингами 2.19 и 2.30). Единственное существенное отличие здесь — вызов функции WSAAsyncSelectпосле перевода сокета в режим прослушивания. Этот вызов связывает событие FD_ACCEPTс сообщением WM_ACCEPTMESSAGE.

Сообщение WM_ACCEPTMESSAGEнестандартное, мы должны сами определить его. Использовать это сообщение сервер будет только для определения момента подключения нового клиента, определять момент прихода данных мы будем с помощью другого сообщения — WM_SOCKETMESSAGE, которое тоже нужно определить. И, чтобы легче было писать обработчики для этих сообщений, объявим тип TWMSocketMessage, "совместимый" с типом TMessage(листинг 2.51).

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.

// функция 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.

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('Зафиксировано подключение с адреса ' +

NewConnection.ClientAddr);

end;

end;

Для каждого подключившегося клиента создается запись типа TConnection, указатель на которую добавляется в список FConnections— здесь полная аналогия с сервером на неблокирующих сокетах. Отличие заключается в том, что в типе TConnectionпо сравнению с тем сервером (см. листинг 2.31) добавилось поле SendReadлогического типа. Оно равно True, если возникло событие FD_READв то время, как сервер находится на этапе отправки данных.

Каждый сокет, созданный функцией accept, связывается с сообщением WM_SOCKETMESSAGE. Обработчик этого сообщения приведен в листинге 2.54.