О чём не пишут в книгах по Delphi

Григорьев Антон Борисович

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

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

 // размер буфера для приема сообщении