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

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.

// Метод GetConnectionBySocket находит в списке FConnections

// запись, соответствующую данному сокету

function TServerForm.GetConnectionBySocket(S: TSocket): PConnection;

var

I: Integer;

begin

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

if PConnection(FConnections[I]).ClientSocket = S then

begin

Result := FConnections[I];

Exit;

end;

Result := nil;

end;

procedure TServerForm.WMSocketMessage(var Msg: TWMSocketMessage);

var

Connection: PConnection;

Res: Integer;

// Вспомогательная процедура, освобождающая ресурсы, связанные

// с клиентом и удаляющая запись подключения из списка

procedure RemoveConnection;

begin

closesocket(Connection.ClientSocket);

FConnections.Remove(Connection);

Dispose(Connection);

end;

begin

// Ищем соединение по сокету