// функция 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('Зафиксировано подключение с адреса ' +
NewConnection.ClientAddr);
end;
end;
Для каждого подключившегося клиента создается запись типа TConnection, указатель на которую добавляется в список FConnections — здесь полная аналогия с сервером на неблокирующих сокетах. Отличие заключается в том, что в типе TConnection по сравнению с тем сервером (см. листинг 2.31) добавилось поле SendRead логического типа. Оно равно True, если возникло событие FD_READ в то время, как сервер находится на этапе отправки данных.
Каждый сокет, созданный функцией accept, связывается с сообщением WM_SOCKETMESSAGE. Обработчик этого сообщения приведен в листинге 2.54.
Листинг 2.54. Обработчик сообщения WM_SOCKETMESSAGE
// Метод 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
// Ищем соединение по сокету
Connection := GetConnectionBySocket(Msg.Socket);
if Connection = nil then
begin
AddMessageToLog(
'Внутренняя ошибка сервера — не найдено соединение для сокета');
Exit;
end;
// Проверяем, были ли ошибки при взаимодействии
if Msg.SockError <> 0 then
begin
AddMessageToLog('Ошибка при взаимодействии с клиентом ' +
Connection.ClientAddr + ': ' + GetErrorString(Msg.SockError));
RemoveConnection;
Exit;
end;
// Анализируем, какое событие произошло
case Msg.SockEvent of
FD_READ: begin
// Проверяем, на каком этапе находится взаимодействие с клиентом.
if Connection.Phase = tpReceiveLength then
begin
// Этап получения от клиента длины строки. При выполнении этого
// этапа сервер получает от клиента длину строки и размещает ее
// в поле Connection.MsgSize. Здесь приходится учитывать, что
// теоретически даже такая маленькая (4 байта) посылка может
// быть разбита на несколько пакетов, поэтому за один раз этот
// этап не будет завершен, и второй раз его придется
// продолжать, загружая оставшиеся байты. Connection.Offset -
// количество уже прочитанных на данном этапе байтов -
// одновременно является смещением, начиная с которого
// заполняется буфер.
Res := recv(Connection.ClientSocket,
(PChar((PConnection.MsgSize + Connection.Offset)^, Connection.BytesLeft, 0);
if Res > 0 then
begin
// Если Res > 0, это означает, что получено Res байтов.
// Соответственно, увеличиваем на Res количество прочитанных
// на данном этапе байтов и на такую же величину уменьшаем
// количество оставшихся.
Inc(Connection.Offset, Res);
Dec(Connection.BytesLeft, Res);
// Если количество оставшихся байтов равно нулю, нужно
// переходить к следующему этапу.
if Connection.BytesLeft = 0 then
begin
// Проверяем корректность принятой длины строки
if Connection.MsgSize <= 0 then
begin
AddMessageToLog('Неверная длина строки, от клиента ' +
Connection.ClientAddr + ': ' + IntToStr(Connection.MsgSize));
RemoveConnection;
Exit;
end;
// Следующий этап - это чтение самой строки
Connection.Phase := tpReceiveString;
// Пока на этом этапе не прочитано ни одного байта
Connection.Offset := 0;
// Осталось прочитать Connection.MsgSize байтов
Connection.BytesLeft := Connection.MsgSize;
// Сразу выделяем память под строку
SetLength(Connection.Msg, Connection.MsgSize);
end;
end
elsе if Res = 0 then
begin
AddMessageToLog('Клиент ' + Connection.ClientAddr +
' закрыл соединение');
RemoveConnection;
Exit;
end
else
// Ошибку WSAEWOULDBLOCK игнорируем, т.к. она говорит
// только о том, что входной буфер сокета пуст, но в целом
