Как сделать чтобы поток не висел в Console Application

@Uefi220 · Регистрация: 20.06.2021

Студворк — интернет-сервис помощи студентам

Дело в том что в console application поток продолжает висеть и freeonterminate:=true не срабатывает вот что то не могу понять что нужно сделать чтобы нормально уничтожить и освободить поток

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
{$APPTYPE CONSOLE}
 
constructor th.create(createsuspended: boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate:= true; 
end;
 
procedure th.Execute;
var
begin
inherited;
while work do begin
cs.Enter;
Inc(tread);
if tread=Count then work:=false else cur:=tread;
cs.Leave;
if work then begin
Object.create;
....
end;
end;
FreeAndnil(Object);
cs.Enter;
if not FileExists (Extractfilepath(paramstr(0))+'result.txt') then begin
Assignfile(file, Extractfilepath(paramstr(0))+'result.txt');
Rewrite(file);
Closefile(file);
end;
Append(file);
Writeln(file,stroka);
Closefile(file);
cs.Leave;
Terminate; //=th.Terminate - ????????????????????????????????????
end;
end;

@northener · 08.01.2022, 02:31

Сообщение от Uefi220

Давай лучше по сути созданной темы что нибудь пожалуйста

А мой пост именно по сути проблемы.
Если Object это экземпляр класса th, то вызов

Delphi
1
Object.create;

создаст ещё один экземпляр этого класса. И вы не получите при этом никакого указателя на этот экземпляр.
И что он будет делать тоже не понятно из ваших обрывков кода.
Так что у вас там висит в Console Application?

@Constcat · 08.01.2022, 02:40

Сообщение от Uefi220

DoTerminate нужно или ещё что то сделать чтобы поток не висел

Чтобы поток не висел, нужно выйти из Execute.
Terminate всего лишь устанавливает его флаг в true.
Внутри Execute по этому флагу обычно делается выход.
Снаружи поток директивно убить нельзя. Даже если уничтожить объект, который указывает на поток, поток все равно останется работать.

@northener · 08.01.2022, 02:53

Constcat, а вы спросите ТС что он имеет в виду под словами "поток висит".
Точнее как он определяет, что что-то висит?

@Uefi220 · 08.01.2022, 08:47 **[ТС]**

Как сделать то в результате ?

Добавлено через 3 часа 46 минут
Возможно так потоки перестали висеть, но до конца не уверен и вроде по памяти всё нормально стало а то сильно ело

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
constructor th.create(createsuspended: boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate:= false;//#1
end;
 
procedure th.Execute;
var
begin
inherited;
while work do begin
cs.Enter;
Inc(tread);
if tread=Count then work:=false else cur:=tread;
cs.Leave;
if work then begin
chtoto.create;
....
end;
end;
FreeAndnil(chtoto);
cs.Enter;
if not FileExists (Extractfilepath(paramstr(0))+'result.txt') then begin
Assignfile(file, Extractfilepath(paramstr(0))+'result.txt');
Rewrite(file);
Closefile(file);
end;
Append(file);
Writeln(file,stroka);
Closefile(file);
cs.Leave;
Doterminate;//#2
WaitFor;//#3
end;
end;

Добавлено через 7 минут
UPD Всё же нет ((((

@krapotkin · 08.01.2022, 10:55

да епрст
сколько можно уже

MyThread.pas

Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
unit MyThread;
.....
.....
TMyThread = class(TThread)
public
  Result: string;
  N: integer;
  procedure Execute(); override;
  constructor Create(AN: integer; ATermProc: TNotifyEvent); 
end;
 
constructor TMyThread.Create(AN: integer; ATermProc: TNotifyEvent); 
begin
  inherited Create(true);
  freeOnTerminate := true;
  onTerminate := ATermProc;
end;
 
procedure TMyThread.Execute(); 
begin
//   делает что-то. результат кладет в поле Result
// например
  Result := IntToStr(AN);
end;

Main.pas

Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
...
uses ...,MyThread;
...
 
TTermObject = class
  F: TTextFile;
  ResultFilename: string;
  procedure TermProc(Sender: TObject);
  constructor Create();
  destructor Destroy(); override;
end;
 
implementation
 
procedure TTermObject.TermProc(Sender: TObject);
var
  th: TMyThread;
begin
  th := sender as TMyThread;
  writeln(F, th.Result);
  inc(FinishedCount);
end;
 
constructor TTermObject.Create();
begin
  ResultFilename := extractFilePath(paramstr(0)) + 'result.txt';
  Assignfile(F, ResultFilename);
  Rewrite(F);
  Closefile(F);
  Append(F);
end;
 
destructor TTermObject.Destroy();
begin
  Closefile(F);
  inherited;
end;
 
var 
  termObject :  TTermObject;
  finishedCount: integer;
const
  THREAD_COUNT = 10;
 
procedure StartThreads();
var
  th: TMyThread;
begin
  finishedCount := 0;
  for i := 0 to THREAD_COUNT - 1 do
  begin
    th := TMyThread.Create(i, termObject.TermProc);
    th.start;
  end;
end;  
 
function AllFinished(): boolean;
begin
  result := finishedCount >= THREAD_COUNT;
end;
 
begin
  termObject := TTermObject.Create(); 
    
  StartThreads();
 
  while true do
  begin
    sleep(10);
    if AllFinished() then 
      break;
  end;
 
  termObject.Free;
end;

ровно такой пример обсосан до костей уже в статье про потоки
100 раз ссылку кидали.
https://www.cyberforum.ru/blog... g4875.html

и никаких критических секций, самоприсваивания номера и других безумий

@Uefi220 · 08.01.2022, 20:07 **[ТС]**

И как это по твоему должно работать если freeonterminate:=true в console application не работает ?

Добавлено через 1 час 29 минут
Проверил код не работает

@Constcat · 08.01.2022, 20:51

Сообщение от Uefi220

И как это по твоему должно работать если freeonterminate:=true в console application не работает ?

По флагу FreeOnTerminate уничтожается объект, но не поток.
Ты убедился, что поток завершил процедуру Execute?

@Uefi220 · 08.01.2022, 21:07 **[ТС]**

Смотри вот так же там да имеется ввиду ? :

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
constructor th.create(createsuspended: boolean);
var
event: TNotifyEvent;
begin
inherited Create(CreateSuspended);
freeOnTerminate := true;
onTerminate := event;
end;
 
procedure th.Execute;
var
begin
inherited;
while work do begin
cs.Enter;
Inc(tread);
if tread=Count then work:=false else cur:=tread;
cs.Leave;
if work then begin
chtoto.create;
....
end;
end;
FreeAndnil(chtoto);
cs.Enter;
if not FileExists (Extractfilepath(paramstr(0))+'result.txt') then begin
Assignfile(file, Extractfilepath(paramstr(0))+'result.txt');
Rewrite(file);
Closefile(file);
end;
Append(file);
Writeln(file,stroka);
Closefile(file);
cs.Leave;
DoTerminate;
end;
end;

@AzAtom · 08.01.2022, 21:39

Uefi220, DoTerminate; и так автоматом выполняется при выходе из Execute, его не нужно вызывать вручную.

@Uefi220 · 08.01.2022, 22:18 **[ТС]**

Я понял это делает не то что нужно это убивает поток на совсем и таким образом потоков всё меньше пока не дойдёт до заданного количества и встанет )
например если 100 потоков программа дойдёт до 99-100 и встанет просто )
По сути не надо тут TNotifyEvent изобретать тут просто в конце Execute можно вызывать
TThread.Destroy;

Добавлено через 12 минут
Потоки конечно самовыпиливаются и не висят в таком случае, но тогда нужно создавать дополнительно новый поток после этого ?

Добавлено через 14 минут
Тогда наверное так чтоли и потокобезопасно ли это ?

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
constructor th.create(createsuspended: boolean);
var
event: TNotifyEvent;
begin
inherited Create(CreateSuspended);
freeOnTerminate := true; //Убили
onTerminate := event; //Убили
end;
 
procedure th.Execute;
var
begin
inherited;
while work do begin
cs.Enter;
Inc(tread);
if tread=Count then work:=false else cur:=tread;
cs.Leave;
if work then begin
chtoto.create;
....
end;
end;
FreeAndnil(chtoto);
cs.Enter;
if not FileExists (Extractfilepath(paramstr(0))+'result.txt') then begin
Assignfile(file, Extractfilepath(paramstr(0))+'result.txt');
Rewrite(file);
Closefile(file);
end;
Append(file);
Writeln(file,stroka);
Closefile(file);
cs.Leave;
DoTerminate; //Убили (может эта строка не нужна)
th.Create(false); //Создали новый вместо убитого
end;
end;

@Пытливый · 08.01.2022, 23:01

Этим th.Create(false); в конце вы породили бесконечный цикл. Один поток будет висеть всегда.

@Uefi220 · 08.01.2022, 23:09 **[ТС]**

Я уже это понял, ну а как сделать то ?

@Пытливый · 08.01.2022, 23:31

А есть где-то в этой теме нормальное описание задачи, словами? То, что я вижу в execute, иначе как каляки-маляки я назвать не могу

@Uefi220 · 08.01.2022, 23:35 **[ТС]**

Ясно всё с тобою ты хоть помог одному человеку на форуме хоть раз ?)

@Constcat · 08.01.2022, 23:38

Сообщение от Uefi220

Ясно всё с тобою ты хоть помог одному человеку на форуме хоть раз ?)

А ты пошурши по форуму, посмотри.
Слишком много хамства от тебя. Странно, что хоть кто-то пытается разобраться в твоей проблеме.

@Пытливый · 08.01.2022, 23:41

Сообщение от Uefi220

Ясно всё с тобою ты хоть помог одному человеку на форуме хоть раз

А вы циферки видите, под ником? Мышку наведите и узнаете статистику. У вас она как-бы пока никакая. Так вы ответите на вопрос? Что именно вы хотите сделать?

@AzAtom · 08.01.2022, 23:54

Сообщение от Uefi220

ты хоть помог одному человеку на форуме хоть раз ?)

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

Сообщение от Uefi220

но тогда нужно создавать дополнительно новый поток после этого ?

Если поток всё ещё нужен, то зачем его завершать?

@Uefi220 · 08.01.2022, 23:57 **[ТС]**

Я не хамлю людям если они по крайней мере пытаются помочь, а не пишут про космос когда их спрашивают о табуретке

Добавлено через 2 минуты
Дело в том что в программе что то явно просаживает оперативную память, а что именно не понимаю предположил что висят потоки из за этого, потому что в с формой VCL такого не наблюдалось только когда перевёл в Console Application

@AzAtom · 09.01.2022, 00:07

Сообщение от Uefi220

предположил что висят потоки

Так, можно посмотреть количество потоков у процесса в диспетчере задач windows.

@krapotkin · 09.01.2022, 00:22

Аж интересно стало.
Как и ожидалось, все работает.
Нужно только помнить о том, что цикл Run не крутится, и надо делать CheckSynchronize, как советовали выше.

Новые блоги и статьи Все статьи Все блоги /
20. Мат мед. Абсентеизм как отдельный тип простоя anaschu 29.05.2026 Апдейт модели: исправленные баги, абсентеизм и новые механизмы Продолжаю развивать ранее описанную модель рабочего коллектива на AnyLogic. За последние несколько дней был проведён серьёзный. . .	19. здоровье, усталость и психотип работника влияют на производительность предприятия, и наоборот, производительность на здоровье, усталось и психотип anaschu 28.05.2026 Дискретно-событийная модель рабочего коллектива на AnyLogic: здоровье, выгорание, психотипы и микростимуляция Привет, коллеги. Хочу поделиться итогами нескольких недель работы над симуляционной. . .	"Прокси" для последовательного порта Eddy_Em 28.05.2026 Эту штуку написал я достаточно давно. Но сейчас вот понадобилось настроить датчик грозы, но при этом не отключать его от "метеодемона". Соответственно, надо запустить этот "прокси": метеодемон будет. . .	Рефакторинг программы уравнивания. Massaraksh7 26.05.2026 Пример по предыдущей записи в блоге. Но, надо заметить, что, во-первых, там оптимизация не только математики, но и работы с базой данных, и с графами, а во-вторых, это ещё не всё.
Использование TThread в Lazarus для математических вычислений. Massaraksh7 25.05.2026 Производя рефакторинг своих программ на предмет ускорения их работы, обратил внимание на такой аспект, как сокращение времени матвычислений. Дело в том, что приходится работать с большими матрицами. . .	Модель здравосохранения 18. Чем здоровее работник, тем быстрее выгорает anaschu 24.05.2026 Имитационная модель корпоративного здравоохранения: что показывает математика Сегодня в модели рабочего коллектива на AnyLogic появились три новые механики — выгорание через накопленную усталость,. . .	Модель здравосохранения 17. Планы на выгорание anaschu 23.05.2026 Вот конкретная схема реализации: В классе Работник добавить: накопленнаяУсталость — растёт каждый час работы, снижается в перерывы и болезни коэффициентПрезентеизма — снижает продуктивность. . .	Изменение цветов в палитре gif файла aka фавикона russiannick 23.05.2026 Изменение цветов в палитре gif файла, юзаемого как фавиконка в составе html-файла, помещенная в base64, средствами нативного Java Script, навеянное сном в майский день. Для работы необходим браузер,. . .

@northener пофигист широкого профиля 4770 / 3206 / 862 Регистрация: 15.07.2013 Сообщений: 18,613
	08.01.2022, 02:53
	Constcat, а вы спросите ТС что он имеет в виду под словами "поток висит". Точнее как он определяет, что что-то висит? 0

@Uefi220 -11 / 9 / 1 Регистрация: 20.06.2021 Сообщений: 785
	08.01.2022, 20:07 [ТС]
	И как это по твоему должно работать если freeonterminate:=true в console application не работает ? Добавлено через 1 час 29 минут Проверил код не работает 0

@AzAtom Модератор 4150 / 2360 / 813 Регистрация: 15.11.2015 Сообщений: 9,489
	08.01.2022, 21:39
	Uefi220, DoTerminate; и так автоматом выполняется при выходе из Execute, его не нужно вызывать вручную. 0

@Пытливый 3764 / 2272 / 705 Регистрация: 29.05.2013 Сообщений: 9,622
	08.01.2022, 23:01
	Этим th.Create(false); в конце вы породили бесконечный цикл. Один поток будет висеть всегда. Миниатюры 0

@Uefi220 -11 / 9 / 1 Регистрация: 20.06.2021 Сообщений: 785
	08.01.2022, 23:09 [ТС]
	Я уже это понял, ну а как сделать то ? 0

@Пытливый 3764 / 2272 / 705 Регистрация: 29.05.2013 Сообщений: 9,622
	08.01.2022, 23:31
	А есть где-то в этой теме нормальное описание задачи, словами? То, что я вижу в execute, иначе как каляки-маляки я назвать не могу 0

@Uefi220 -11 / 9 / 1 Регистрация: 20.06.2021 Сообщений: 785
	08.01.2022, 23:35 [ТС]
	Ясно всё с тобою ты хоть помог одному человеку на форуме хоть раз ?) 0

@Uefi220 -11 / 9 / 1 Регистрация: 20.06.2021 Сообщений: 785
	08.01.2022, 23:57 [ТС]
	Я не хамлю людям если они по крайней мере пытаются помочь, а не пишут про космос когда их спрашивают о табуретке Добавлено через 2 минуты Дело в том что в программе что то явно просаживает оперативную память, а что именно не понимаю предположил что висят потоки из за этого, потому что в с формой VCL такого не наблюдалось только когда перевёл в Console Application 0