• 15 апреля стартует «Курс «SQL-injection Master» ©» от команды The Codeby

    За 3 месяца вы пройдете путь от начальных навыков работы с SQL-запросами к базам данных до продвинутых техник. Научитесь находить уязвимости связанные с базами данных, и внедрять произвольный SQL-код в уязвимые приложения.

    На последнюю неделю приходится экзамен, где нужно будет показать свои навыки, взломав ряд уязвимых учебных сайтов, и добыть флаги. Успешно сдавшие экзамен получат сертификат.

    Запись на курс до 25 апреля. Получить промодоступ ...

Получение Данных В Потоке

  • Автор темы Shouldercannon
  • Дата начала
S

Shouldercannon

Задача:
Подключиться к серверу и слушать, что он пришлёт до завершения работы приложения. Прослушка должна быть обязательно в отдельном потоке, иначе форма повиснет.
Код:
procedure TFormMain.BConnectClick(Sender: TObject);
var
My_Thread: TMy_Thread;
begin
IdTCPClient1.Host := '77.108.194.247';
IdTCPClient1.Port := 80;
IdTCPClient1.Connect(1000);

My_Thread := TMy_Thread.Create(True);
My_Thread.FreeOnTerminate := False;
My_Thread.GoMemo := Memo1;
My_Thread.Resume;
end;

procedure TMy_Thread.Execute;
begin
while not Terminated do
begin
if FormMain.IdTCPClient1.Connected then
begin
s := FormMain.IdTCPClient1.ReadLn(); // Показывает сюда
Synchronize(SyncProc);
end;
end;
end;

procedure TMy_Thread.SyncProc;
begin
GoMemo.Lines.Add('[' + TimeToStr(Now) + '] - IdTCPClient1: ' + s);
end;
При закрытии формы появляется ошибка на строке
Код:
s := FormMain.IdTCPClient1.ReadLn();
 

Вложения

  • error.jpg
    error.jpg
    17,5 КБ · Просмотры: 538
M

-master-

Ну а чего вы хотите? у вас поток продолжает работать, а формы уже нет, тут все что хотите может быть.
 
S

Shouldercannon

Прошу помощи разобраться с этой проблемой.
 
M

-master-

Так я уже все объяснил.
Поток должен быть сам по себе, а у вас он активно работает с vcl. Это и есть мина, она рванет в любом случае, ранно или поздно, и не зависит от нашего желания.

Отделяйте мух от котлет. Форма сама по себе, поток сам по себе.
Либо надо делать полностью управляемый поток, и все руками контролировать.
 
S

Shouldercannon

Другой подход. Ошибка осталась тажа плюс появилась новая.
Имеющаяся - Not connected
Новая - THread Error: отказано в доступе (5)
Код:
...
TMyThread = class(TThread)
private
{ Private declarations }
s: string;
protected
procedure Execute; override;
procedure ReadFromSocket;
procedure SyncProc;
public
GoMemo: TMemo;
end;
...
var
FormMain: TFormMain;
MyThread: TMyThread;
...
procedure TFormMain.FormCreate(Sender: TObject);
begin
MyThread := TMyThread.Create(True);
MyThread.GoMemo := Memo1;
end;

procedure TFormMain.BConnectClick(Sender: TObject);
begin
IdTCPClient1.Host := '77.108.194.247';
IdTCPClient1.Port := 80;
IdTCPClient1.Connect(1000);
end;

procedure TFormMain.BDisconnectClick(Sender: TObject);
begin
IdTCPClient1.Disconnect;
end;

procedure TMyThread.Execute;
begin 
while not Terminated do ReadFromSocket;
end;

procedure TMyThread.ReadFromSocket;
begin 
s := FormMain.IdTCPClient1.ReadLn; // ==> Not connected
Synchronize(SyncProc);
end;

procedure TMyThread.SyncProc;
begin
GoMemo.Lines.Add('[' + TimeToStr(Now) + '] - IdTCPClientMSG: ' + s);
end;

procedure TFormMain.IdTCPClient1Connected(Sender: TObject);
begin
Memo1.Lines.Add('[' + TimeToStr(Now) + ']: IdTCPClient1 подключен');

MyThread.Resume;
end;

procedure TFormMain.IdTCPClient1Disconnected(Sender: TObject);
begin
Memo1.Lines.Add('[' + TimeToStr(Now) + ']: IdTCPClient1 отключен');

MyThread.Suspend; // ==> THread Error: отказано в доступе (5) 
end;

end.
 

Вложения

  • EIdNotConnected.gif
    EIdNotConnected.gif
    14 КБ · Просмотры: 626
  • EThread.gif
    EThread.gif
    15 КБ · Просмотры: 620
M

-master-

Все правильно, вы ничего не исправили, все осталось как было, а то что добавили, привело к другой ошибки.

Смотрите у вас при закрытии формы поток продолжает работать, его ж никто не рубит, а он стучится к форме, поскольку формы уже нет, то что остается? только ошибка.
И вообще все формы компоненты и т.п. vcl, потоко-зависимы, т.е. просто так обращаться к ним из доп потока чревато, ошибки практически не избежать.

Все чтонадо потоку, как правило создаютвконтексте доп потока, а с основным потоком, делают межпотоковое взаимодействие, т.е. применяют некий механизм, например сообщения.
 
S

Shouldercannon

Тупик. От ошибки с потоком избавился, а ошибка коннекта осталась, может, эта ошибка так и должна быть. Ткните пальцем в коде, где нужно внести поправки :(.
Код:
...
TMyThread = class(TThread)
private
{ Private declarations }
s: string;
protected
procedure Execute; override;
procedure SyncProc;
public
GoIdTCPClient: TIdTCPClient;
GoMemo: TMemo;
end;
...
var
MyThread: TMyThread;
...
procedure TFormMain.BConnectClick(Sender: TObject);
begin
IdTCPClient1.Host := '77.108.194.247';
IdTCPClient1.Port := 80;
IdTCPClient1.Connect(1000);
end;

procedure TFormMain.BDisconnectClick(Sender: TObject);
begin
IdTCPClient1.Disconnect;
end;

procedure TMyThread.Execute;
begin
while not Terminated do
begin
if GoIdTCPClient.Connected then
begin
s := GoIdTCPClient.ReadLn;
Synchronize(SyncProc);
end;
end;
end;

procedure TMyThread.SyncProc;
begin
GoMemo.Lines.Add('[' + TimeToStr(Now) + '] - IdTCPClientMSG: ' + s);
end;

procedure TFormMain.IdTCPClient1Connected(Sender: TObject);
begin
Memo1.Lines.Add('[' + TimeToStr(Now) + ']: IdTCPClient1 подключен');

MyThread := TMyThread.Create(True); // Останавливаем поток
MyThread.GoIdTCPClient := IdTCPClient1;
MyThread.GoMemo := Memo1;
MyThread.Resume; // Запуск потока
end;

procedure TFormMain.IdTCPClient1Disconnected(Sender: TObject);
begin
Memo1.Lines.Add('[' + TimeToStr(Now) + ']: IdTCPClient1 отключен');

MyThread.FreeOnTerminate := False; // По завершению кода поток не завершится
MyThread.Terminate;
end;
По идее, после нажатия на кнопку BDisconnect произойдёт Disconnect и поток уничтожиться. если даже уничтожить поток перед
Код:
IdTCPClient1.Disconnect;
, то всёравно возникает ошибка подключения.
 
S

sinkopa

Код:
procedure TFormMain.IdTCPClient1Disconnected(Sender: TObject);
begin
Memo1.Lines.Add('[' + TimeToStr(Now) + ']: IdTCPClient1 отключен');

MyThread.FreeOnTerminate := False; // По завершению кода поток не завершится
MyThread.Terminate; 
end;
Так нельзя. GoIdTCPClient.Connected станет false только по завершении процедуры IdTCPClient1Disconnected(Sender: TObject);
Получается, что Вы пытаетесь в "своем потоке" управлять "чужим" потоком из обработчика события (который вообще то сам должен через синхонайз быть) рожденного кодом исполняющимся в "чужом" потоке...

По идее, после нажатия на кнопку BDisconnect произойдёт Disconnect и поток уничтожиться. если даже уничтожить поток перед
Код:
IdTCPClient1.Disconnect;
, то всёравно возникает ошибка подключения.

Сначала "отпустить" поток, а потом уже дисконектиться... только так.
Код:
procedure TFormMain.BDisconnectClick(Sender: TObject);
begin

MyThread.Terminate;
Sleep(200); // Какое то время требуется для завершения итерации внутреннего цикла потока (в это время IdTCPClient может получать данные с сервера)
while not MyThread.Terminated do
begin
Sleep(20);
Application.ProcessMessages;
end;

IdTCPClient1.Disconnect;
end;
 
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!