Читаем О чём не пишут в книгах по Delphi полностью

   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

Перейти на страницу:
Нет соединения с сервером, попробуйте зайти чуть позже