А. Григорьев - О чём не пишут в книгах по Delphi
constructor TClientThread.Create(ClientSocket: TSocket; const ClientAddr: TSockAddr);
begin
FSocket := ClientSocket;
// заголовок содержит адрес и номер порта клиента.
// Этот заголовок будет добавляться ко всем сообщениям в лог
// от данного клиента.
FHeader :=
'Сообщение от клиента ' + inet_ntoa(ClientAddr.sin_addr) +
': ' + IntToStr(ntohs(ClientAddr.sin_port)) + ': ';
// Создаем события и привязываем первое из них к сокету
FEvents[0] := WSACreateEvent;
if FEvents[0] = WSA_INVALID_EVENT then
raise ESocketError.Create(
FHeader + 'Ошибка при создании события: ' + GetErrorString);
FEvents[1] := WSACreateEvent;
if FEvents[1] = WSA_INVALID_EVENT then
raise ESocketError.Create(
FHeader + 'Ошибка при создании события: ' + GetErrorString);
FEvents[2] := WSACreateEvent;
if FEvents[2] = WSA_INVALID_EVENT then raise
ESocketError.Create(
FHeader + 'Ошибка при создании события: ' + GetErrorString);
if WSAEventSelect(FSocket, FEvents[2], FD_READ or FD_WRITE or FD_CLOSE) =
SOCKET_ERROR then
raise ESocketError.Create(
FHeader + 'Ошибка при привязывании сокета к событию: ' + GetErrorString);
FSendBufSection := TCriticalSection.Create;
// Объект этой нити не должен удаляться сам
FreeOnTerminate := False;
inherited Create(False);
end;
destructor TClientThread.Destroy;
begin
FSendBufSection.Free;
WSACloseEvent(FEvents[0]);
WSACloseEvent(FEvents[1]);
WSACloseEvent(FEvents[2]);
inherited;
end;
// Функция добавляет строку в буфер для отправки
procedure TClientThread.SendString(const S: string);
begin
FSendBufSection.Enter;
try
FSendBuf := FSendBuf + S + #0;
finally
FSendBufSection.Leave;
end;
LogMessage('Сообщение "' + S + '" поставлено в очередь для отправки');
// Взводим событие, которое говорит, что нужно отправлять данные
WSASetEvent(FEvents[1]);
end;
// Отправка всех данных, накопленных в буфере
// Функция возвращает False, если произошла ошибка,
// и True, если все в порядке
function TClientThread.DoSendBuf: Boolean;
var
SendRes: Integer;
begin
FSendBufSection.Enter;
try
// Если отправлять нечего, выходим
if FSendBuf = '' then
begin
Result := True;
Exit;
end;
// Пытаемся отправить все, что есть в буфере
SendRes := send(FSocket, FSendBuf[1], Length(FSendBuf), 0);
if SendRes > 0 then
begin
// Удаляем из буфера ту часть, которая отправилась клиенту
Delete(FSendBuf, 1, SendRes);
Result := True;
end
else
begin
Result := WSAGetLastError = WSAEWOULDBLOCK;
if not Result then
LogMessage('Ошибка при отправке данных: ' + GetErrorString);
end;
finally
FSendBufSection.Leave;
end;
end;
procedure TClientThread.Execute;
const
// размер буфера для приема сообщении
RecvBufSize = 4096;
var
// Буфер для приема сообщений
RecvBuf: array[0..RecvBufSize - 1] of Byte;
RecvRes: Integer;
NetEvents: TWSANetworkEvents;
// Полученная строка
Str: string;
// Длина полученной строки
StrLen: Integer;
// Если ReadLength = True, идет чтение длины строки,
// если False - самой строки
ReadLength: Boolean;
// Смещение от начала приемника
Offset: Integer;
// Число байтов, оставшихся при получении длины строки или самой строки
BytesLeft: Integer;
Р: Integer;
I: Integer;
LoopExit: Boolean;
WaitRes: Cardinal;
begin
LogMessage('Соединение установлено');
ReadLength := True;
Offset := 0;
BytesLeft := SizeOf(Integer);
repeat
WaitRes := WSAWaitForMultipleEvents(3, @FEvents, False, WSA_INFINITE, False);
case WaitRes of
WSA_WAIT_EVENT_0: begin
// Закрываем соединение с клиентом и останавливаем нить
LogMessage('Получен сигнал об остановке нити');
shutdown(FSocket, SD_BOTH);
Break;
end;
WSA_WAIT_EVENT_0 + 1:
begin
// Сбрасываем событие и отправляем данные
WSAResetEvent(FEvents[1]);
if not DoSendBuf then Break;
end;
WSA_WAIT_EVENT_0 + 2: begin
// Произошло событие, связанное с сокетом.
// Проверяем, какое именно, и заодно сбрасываем его
if WSAEnumNetworkEvents(FSocket, FEvents[2], NetEvents) = SOCKET_ERROR then
begin
LogMessage('Ошибка при получении списка событий: ' + GetErrorString);
Break;
end;
if NetEvents.lNetworkEvents and FD_READ <> 0 then
begin
if NetEvents.iErrorCode[FD_READ_BIT] <> 0 then
begin
LogMessage('Ошибка в событии FD_READ: ' +
GetErrorString(NetEvents.iErrorCode[FD_READ_BIT]));
Break;
end;
// В буфере сокета есть данные.
// Копируем данные из буфера сокета в свой буфер RecvBuf
RecvRes := recv(FSocket, RecvBuf, SizeOf(RecvBuf), 0);
if RecvRes > 0 then
begin
P := 0;
// Эта переменная нужна потому, что здесь появляется
// вложенный цикл, при возникновении ошибки в котором нужно
// выйти и из внешнего цикла тоже. Так как в Delphi нет
// конструкции типа Break(2) в Аде, приходится прибегать
// к таким способам: если нужен выход из внешнего цикла,
// во внутреннем цикле выполняется LoopExit := True,
// а после выполнения внутреннего цикла проверяется
// значение этой переменной и при необходимости выполняется
// выход и из главного цикла.
LoopExit := False;
// В этом цикле мы извлекаем данные из буфера
// и раскидываем их по приёмникам - Str и StrLen.
while Р < RecvRes do
begin
// Определяем, сколько байтов нам хотелось бы скопировать
L := BytesLeft;
// Если в буфере нет такого количества,
// довольствуемся тем, что есть
if Р + L > RecvRes then L := RecvRes - P;
// Копируем в соответствующий приемник
if ReadLength then
Move(RecvBuf[P], (PChar(@StrLen) + Offset)^, L)
else Move(RecvBuf[P], Str(Offset + 1), L);
Dec(BytesLeft, L);
// Если прочитали все, что хотели,
// переходим к следующему
if BytesLeft = 0 then
begin
ReadLength := not ReadLength;
Offset := 0;
// Если закончено чтение строки, нужно вывести ее
if ReadLength then
begin
LogMessage('Получена строка: ' + Str);
BytesLeft := SizeOf(Integer);
// Формируем ответ и записываем его в буфер
Str :=
AnsiUpperCase(StringReplace(Str, #0, '#0',
[rfReplaceAll])) + '(AsyncEvent server)';
SendString(Str);
Str := '';
end
else
begin
if StrLen <= 0 then
begin
LogMessage('Неверная длина строки от клиента: ' +
IntToStr(StrLen));
LoopExit := True;
Break;
end;
BytesLeft := StrLen;
SetLength(Str, StrLen);
end;
end
else Inc(Offset, L);
Inc(P, L);
end;
// Проверяем, был ли аварийный выход из внутреннего цикла,
// и если был, выходим и из внешнего, завершая работу
// с клиентом
if LoopExit then Break;
end
else if RecvRes = 0 then
begin
LogMessage('Клиент закрыл соединение ');
Break;
end
else
begin
if WSAGetLastError <> WSAEWOULDBLOCK then
begin
LogMessage('Ошибка при получении данных от клиента: ' +
GetErrorString);
end;
end;
end;
// Сокет готов к передаче данных
if NetEvents.lNetworkEvents and FD_WRITE <> 0 then
begin
if NetEvents.iErrorCode[FD_WRITE_BIT] <> 0 then
