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

В листинге 2.63 приведен код нити, взаимодействующей с клиентом (код методов LogMessageи DoLogMessageопущен, т.к. он идентичен приведенному в листингах 2.20 и 2.7 соответственно).

unit ClientThread;

{

Нить, обслуживающая одного клиента.

Выполняет цикл, выход из которого возможен по внешнему сигналу или при возникновении ошибки на сокете. Умеет отправлять клиенту сообщения по внешнему сигналу.

}

interface

uses

Windows, Classes, WinSock, Winsock2_Events, ShutdownConst, SysUtils, SyncObjs;

type

TClientThread = class(TThread)

private

// Сообщение, которое нужно добавить в лог,

// хранится в отдельном поле, т.к. метод, вызывающийся через

// Synchronize, не может иметь параметров.

FMessage: string;

// Префикс для всех сообщений лога, связанных с данным клиентом

FHeader: string;

// Сокет для взаимодействия с клиентом

FSocket: TSocket;

// События нити

// FEvents[0] используется для остановки нити

// FEvents[1] используется для отправки сообщения

// FEvents[2] связывается с событиями FD_READ, FD_WRITE и FD_CLOSE

FEvents; array[0..2] of TWSAEvent;

// Критическая секция для доступа к буферу исходящих

FSendBufSection: TCriticalSection;

// Буфер исходящих

FSendBuf: string;

// Вспомогательный метод для вызова через Synchronize

procedure DoLogMessage;

// Функция, проверяющая, завершила ли нить работу

function GetFinished: Boolean;

protected

procedure Execute; override;

// Вывод сообщения в лог главной формы

procedure LogMessage(сonst Msg: string);

// Отправка клиенту данных из буфера исходящих

function DoSendBuf: Boolean;

public

constructor Create(ClientSocket: TSocket; const ClientAddr: TSockAddr);

destructor Destroy; override;

// Добавление строки в буфер исходящих

procedure SendString(const S: string);

// Остановка нити извне

procedure StopThread;

property Finished: Boolean read GetFinished;

end;

ESocketError = class(Exception);

implementation

uses

MainServerUnit;

{ TClientThread }

// Сокет для взаимодействия с клиентом создается в главной нити,

// а сюда передается через параметр конструктора. Для формирования

// заголовка сюда же передается адрес подключившегося клиента

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