Имеется прога которая подрубается к серваку, и в потоке читает всё что ей пришлет сервак. Если сервер закрывает соединение, то потоку отправляется сообщение по которому он выходит из бесконечного цикла, отправляет сообщение главному окну о своём завершении, закрывается, главное окно вызывает 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;
Так вот когда сервак вызывает цепь событий уничтожения потока, всё проходит прекрасно, но когда с кнопки то главное окно сообщения о том, что поток вылетел из цикла и закрывается, не получает... по крайней мере уж точно на него никак не реагирует, а поток закрывается "раз через раз", смотрел по отладчику и в мониторе ресурсов количество потоков.