Читать онлайн «О чём не пишут в книгах по Delphi». Страница 81

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

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

      Inc(P, L);

     end;

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

     // и если был, выходим и из внешнего, завершая работу

     // с клиентом

     if LoopExit then Break;

    end

    else if RecvRes = 0 then

    begin

     LogMessage('Клиент закрыл соединение ');

     Break;

    end

    else

    begin

     if WSAGetLastError <> WSAEWOULDBLOCK then

     begin

      LogMessage('Ошибка при получении данных от клиента: ' +

       GetErrorString);

     end;

    end;

   end;

   // Сокет готов к передаче данных

   if NetEvents.lNetworkEvents and FD_WRITE <> 0 then

   begin

    if NetEvents.iErrorCode[FD_WRITE_BIT] <> 0 then