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