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

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);