2

Имеется прога которая подрубается к серваку, и в потоке читает всё что ей пришлет сервак. Если сервер закрывает соединение, то потоку отправляется сообщение по которому он выходит из бесконечного цикла, отправляет сообщение главному окну о своём завершении, закрывается, главное окно вызывает Destroy класса, который и создаёт поток. Проблема возникает когда инициатором закрытия выступает главное окно, оно вызывает Destroy класса который и создаёт поток, в коде Destroy потоку также отправляется сообщение о том что пора закрываться, но ответа не приходит, а сам поток иногда завершается, иногда нет. В чем проблема?

Код потока

procedure TClientTCP.TTestThread.Execute;
var
    ARecvText: string;
    ARecvChar: Char;
     msg: TMsg;
begin
  while (true) do begin{основной бесконечный цикл}
  ARecvText:='';
    while (true) do{пока есть что считывать читаем}
        begin
          If Recv(SockStream, ARecvChar, 1, 0)>0 then //читаем по 1-му
            begin
            ARecvText := ARecvText + ARecvChar; {добавляем в строку}
            if ARecvChar =#0 then break ;
          end
          else  break;
        end;

    if length(ARecvText)>0 then{выделяем память на пакет, пропуская случайные разрывы}
        begin
          SetLength(TempBufRead.SBufRead, Length(ARecvText));
          TempBufRead.SBufRead:= ARecvText;
          New(TempBufRead.PointTo);
          TempBufRead:= TempBufRead.PointTo;
          TempBufRead.PointTo:=nil;
          inc(FCheckerPackage);
          PostMessage(FHandle, WM_TCPCLASSMESSAGE,2,0);{отправим сообщение что пришел пакет}
        end;

   if PeekMessage(msg, 0, 0, 0, PM_REMOVE) then{вот здесь читаем есть ли команда на выход}
      case msg.message of
         WM_TESTTHREAD: begin
          if msg.wParam=1 then shutdown(SockStream, SD_BOTH);{если есть флаг, что это сервак инициатор шатдауним сокет}
          break;{и если есть выскакиваем из цикла}
         end;
      end;
    Self.suspend;{прочитали сообщение, засыпаем}
  end;
  PostMessage( FHandle, WM_TCPCLASSMESSAGE,1,0);{отправляем главному окну сообщение о завершении}
end; 

Код при котором инициатор закрытия сервак

procedure TClientTCP.WMSocketMessage(var Msg: TSockMessage);
begin
  if Msg.Socket <> FSocket then
  begin
    MessageDlg('Внутренняя ошибка программы - неверный сокет', mtError, [mbOK], 0);
    Exit;
  end;

  if Msg.SockError <> 0 then
  begin
    MessageDlg('Ошибка при взаимодействии с сервером'#13#10 + GetError(Msg.SockError), mtError, [mbOK], 0);
    Exit;
  end;

  case Msg.SockEvent of
    FD_READ:{Получено сообщение от сервера}
        if FRead.Suspended then FRead.Resume;{будим поток для чтения}

    FD_CLOSE:{сервер закрыл соединение}
      begin
        PostThreadMessage(FRead.ThreadID, WM_TESTTHREAD,1,0);{посылаем сообщение потоку что надо закрываться}
        FRead.Resume;{выводим поток с паузы}
      end;
    else
      begin
        MessageDlg('Внутренняя ошибка программы - неизвестное событие ' + IntToStr(Msg.SockEvent), mtError, [mbOK], 0);
      end;
  end;
end;

Главное окно по клику просто вызывает Destroy класса, который и создает поток

procedure TForm1.ConnectBtnClick(Sender: TObject);{клик по кнопке закрытия соединения}
 begin
 if Connected then begin
    Connected:=false;
    TcpCon.Disconnect;
 end

procedure TClientTCP.Disconnect;{процедура дисконнекта}
begin
    closesocket(FSocket);
    FSocket := 0;
    Destroy;
end;

destructor TClientTCP.Destroy;
begin
  PostThreadMessage(FRead.ThreadID, WM_TESTTHREAD,0,0);{отправляем в поток что пора закрываться}
  FRead.Resume;{будим поток}
  FRead.Free;
      //отдадим обратно прием сообщений
      FWinOwner.WindowProc := FOldProc;
      FWinOwner.Refresh;
      inherited Destroy;
    end;

код реакции формы на сообщения

procedure TForm1.WMTcpClassMessage(var Msg: TMessage);
begin
   case Msg.WParam of
   0: begin
      Connected:=true;
      ConnectBtn.Caption:='l';
      StatusEdit.Text:='Подключено к '+SettingForm.AdressEdit.Text;
      ConnectBtn.Enabled:=true;
      SentBtn.Enabled:=true;
      end;
   1: begin{вот это реакция на сообщение о том что поток вышел с цикла и сейчас закроется}
      ConnectBtn.Enabled:=true;
      SentBtn.Enabled:=false;
      ConnectBtn.Caption:='k';
      if Connected then TcpCon.Destroy;{если событие вызвано сервером, то флаг Connect будет в true, если с кнопки то уже Flase, а значит там был Disconnect который уже вызывал Destroy}
      Connected:=false;
      StatusEdit.Text:='Сервер разорвал соединение';
      end;
   2: StatusEdit.Text:='Получено сообщение';
   3: begin StatusEdit.Text:='Подключение не удалось';
      ConnectBtn.Enabled:=true;
      SentBtn.Enabled:=false;
      end;
   4: StatusEdit.Text:='Буфер входящих сообщений пуст';
   5: StatusEdit.Text:='Отключаемся';
   end;

end;

Так вот когда сервак вызывает цепь событий уничтожения потока, всё проходит прекрасно, но когда с кнопки то главное окно сообщения о том, что поток вылетел из цикла и закрывается, не получает... по крайней мере уж точно на него никак не реагирует, а поток закрывается "раз через раз", смотрел по отладчику и в мониторе ресурсов количество потоков.

2 ответа 2

2
  1. Для уничтожения объектов нужно вызывать метод Free, а не Destroy. Обязательно.
  2. FreeOnTerminate должен быть False.
  3. Для корректного уничтожения потока нужно дождаться пока он корректно завершит свое выполнение. Для этого, в вашем случае, достаточно будет в месте, где уничтожается поток, добавить между FRead.Resume и FRead.Free приведенный ниже код.

Как-то так:

FRead.Resume;{будим поток}
FRead.WaitFor; // ждем завершения потока
FRead.Free;
2
  • У потока нет Destroy, вызывается Destroy класса создавшего поток. А WaitFor во время разработки не ставлю чтоб как раз получать зависающую программу и искать причину неправильного завершения потока, правильный поток всегда самостоятельно должен нормально завершиться.
    – Sergey
    10 сен 2018 в 23:44
  • @Сергей, у потока обязательно есть Destroy, он есть у любого объекта, просто вы его не переопределяете. Довольно странный у вас подход к отладке. Уничтожение потока с if not Suspended then WaitFor самый правильный способ. Загляните в деструктор TThread. Правильный поток завершиться должен самостоятельно, но не уничтожиться. 11 сен 2018 в 6:04
0

Проблема решена. У потока было FreeOnTerminate:=True; таким образом, поток успевал разрушиться раньше чем дойдет до Free. Убрал FreeOnTerminate:=True;, Free перенес в Destroy, а сообщение о том что пора заканчивать в Disconnect. Таким образом когда сервак инициирует разрыв, это же событие отправляет сообщение потоку о том чтоб тот закончил свои дела, затем вызывается Destroy в котором Free не вызывает проблем так как потоку уже было отправлено сообщение о закрытии. Когда же мы сами инициируем закрытие то вызывается Disconnect, которой отправляет сообщение потоку о закрытии, затем вызывается Destroy в котором мы освобождаем поток Free.

3
  • 2
    Самоуничтожение объекта - не очень красивое решение (мягко говоря). Можете легко напороться на AV при неаккуратном обращении с объектом. У TThread возможность самоуничтожения добавлена для случая "запустил и забыл", т.е. когда на созданный поток у вас нигде не хранится ссылок и всё общение с ним происходит опосредственно, через сообщения/события. Как только вы начинаете хранить ссылку на объект (потока или вашего TClientTCP) самоуничтожение объекта недопустимо.
    – zed
    9 сен 2018 в 19:37
  • @zed при неаккуратном обращении с объектом - так обращаться с ним надо аккуратно и проблем не будет)
    – Sergey
    23 апр 2019 в 7:55
  • Звучит как "Ходить по граблям надо аккуратно и проблем не будет". Оно конечно можно, чтобы жизнь мёдом не казалась, но не нужно.
    – zed
    23 апр 2019 в 18:10

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.