PDA

Просмотр полной версии : Thread прервать по TimeOut



UUU
26.10.2004, 23:00
Что-то никак не найду нужную ссылочку.
Задача решена - обращение к веб-ресурсам. Это в нитях все работает.
Но столкнулся с проблемкой. Как-то завис процесс и все.
При чем он мог завсинуть и при запросе (там таймаут есть), так и при обработке, т.е. в Thread

Поэтому возника такой вопрос: как задать время выполнения Thread

MyTHread:=TMyThread.Create(true);
MyTHread.FreeOnTerminate:=True;
MyTHread.Resume.

Вот как задать TaimOut, чтобы, скажем через 100 секунд процесс принудительно Execute ?

Eugie
27.10.2004, 17:46
К сожалению, класс TThread не предусматривает возможности задать интервал ожидания.

Проще всего это сделать так: создать таймер с нужным интервалом и в обработчике OnTimer()

- либо 1) вызывать MyTHread.Terminate() - это в случае, если потоковая функция представляет собой цикл - тогда следить за состоянием св-ва Terminated и завершать ее при Terminated = True;

- либо 2) просто убивать поток с помощью TerminateThread(MyTHread.Handle) - но при этом останутся неосвобожденные ресурсы.

UUU
27.10.2004, 23:01
Попробовал создать Timer прямо в потоке. Не срабатывает OnTime.
Не могли бы вы привести пример или ссылку на данный пример.

Eugie
28.10.2004, 16:38
Насчет таймеров посмотрите пока это http://www.developing.ru/forum/viewtopic.php?t=247

Использование waitable timer (пример из MSDN):



#include <windows.h>
#include <stdio.h>

int main()
{
HANDLE hTimer = NULL;
LARGE_INTEGER liDueTime;

liDueTime.QuadPart=-100000000;

// Create a waitable timer.
hTimer = CreateWaitableTimer(NULL, TRUE, "WaitableTimer");
if (!hTimer)
{
printf("CreateWaitableTimer failed (%d)\n", GetLastError());
return 1;
}

printf("Waiting for 10 seconds...\n");

// Set a timer to wait for 10 seconds.
if (!SetWaitableTimer(
hTimer, &liDueTime, 0, NULL, NULL, 0))
{
printf("SetWaitableTimer failed (%d)\n", GetLastError());
return 2;
}

// Wait for the timer.

if (WaitForSingleObject(hTimer, INFINITE) != WAIT_OBJECT_0)
printf("WaitForSingleObject failed (%d)\n", GetLastError());
else printf("Timer was signaled.\n");

return 0;
}

Eugie
29.10.2004, 10:07
Прошу прощения за телеграфный стиль предыдущего сообщения :) - не было времени вступать в диалог.



Попробовал создать Timer прямо в потоке. Не срабатывает OnTime.


Опишите подробнее, как создаете таймер, как настраиваете OnTime.
Заранее скажу, что TTimer не может использоваться в консольном приложении; пример с waitable timer как раз для этой ситуации. У Вас, скорее всего, главный поток приложения GUI-ный, т.е. поддерживает окооный интерфейс и очередь сообщений. Если так, то нужно просто при запуске очередного потока (thread) создавать новый объект типа TTimer, настраивать реакцию на событие OnTimer (при этом процедура для всех таймеров может быть одна - различать, от кого пришло сообщение можно по Sender) и запускать таймер.

Вот как это можно сделать (в примере на OnTimer повешен вывод из текущего потока на главную форму):


unit MyThread;

interface

uses
SysUtils, Classes, Dialogs, Graphics, Windows, ExtCtrls, StdCtrls;

type
TMyThread = class(TThread)
private
{ Private declarations }
fInfo: TLabel;
fTimer: TTimer;
procedure DoOnTimer(pSender: TObject);
procedure OutputOnTimer;
procedure ExecProc;
protected
procedure Execute; override;
public
constructor Create(pSuspended: Boolean);
destructor Destroy; override;
end;

implementation

uses Main, Math;

{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure TMyThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ TMyThread }

constructor TMyThread.Create(pSuspended: Boolean);
begin
inherited Create(pSuspended);
Priority := tpNormal;
FreeOnTerminate := True;
fTimer := TTimer.Create(nil);
fTimer.Interval := 1000;
fTimer.OnTimer := DoOnTimer;
fInfo := TLabel.Create(Form1);
fInfo.Parent := Form1;
fInfo.Left := 40;
fInfo.Top := Form1.btnStop.Top+30+20*Form1.ThdCount;
end;

destructor TMyThread.Destroy;
begin
Synchronize(fTimer.Free);
Synchronize(fInfo.Free);
inherited;
end;

procedure TMyThread.DoOnTimer(pSender: TObject);
begin
if not Suspended then begin
Synchronize(OutputOnTimer);
end;
end;

procedure TMyThread.Execute;
begin
{ Place thread code here }
repeat
Synchronize(ExecProc);
until Terminated;
end;

procedure TMyThread.ExecProc;
var v: Extended;
begin
v := NAN;
try
v := Cos(Random*Pi);
except
on E: Exception do MessageDlg(E.Message, mtError, [mbOk], E.HelpContext);
end;
fInfo.Caption := Format('Current value = %g', [v]);
end;

procedure TMyThread.OutputOnTimer;
begin
with Form1.sbThreadStatus do begin
Panels[0].Text := Format('ThreadID: %d OnTimer', [ThreadID]);
Panels[1].Text := Format('Threads running: %d', [Form1.ThdCount]);
end;
end;

end.

UUU
29.10.2004, 10:19
Спасибо. Я создавал таймер не в методе Create, а в Execute.
Правильно ли я понял, что для прерывания можно прописать:

procedure TMyThread.OutputOnTimer;
begin
Terminate();
end;


И все правильно завершится ?

Eugie
29.10.2004, 10:24
да, именно так

UUU
29.10.2004, 10:58
Еще раз огромное спасибо.
В этом случае по памяти все нормально будет? все освободится? Даже если в Execute создавались другие компоненты?
(если для ответа надо пробовать - то ладно, попозже сам эксперименты поставлю) :-)

Eugie
29.10.2004, 16:50
По-хорошему, все выделенные ресурсы (компоненты и пр.) нужно освобождать в обработчике события OnTerminate. Полезно еще установить св-во FreeOnTerminate = True, тогда сам thread-объект будет автоматически освобожден по завершении.

UUU
29.10.2004, 17:15
Ок, переписвываем:
procedure TMyThread.OutputOnTimer;
begin
FreeOnTerminate:= True
end;

Eugie
29.10.2004, 17:34
Нет, ни в коем случае!

FreeOnTerminate:= True надо добавить в TMyThread.Create(). Это просто приводит к автоматическому вызову TMyThread.Free() по завершении Execute().

UUU
29.10.2004, 18:54
Конечно, просто день рождения сегодня :-)

UUU
21.01.2005, 09:12
Вернемся к нашим баранам :-)
И так имеем:



WebThread:=TWebThread.Create(true);
WebThread.FreeOnTerminate:=true;
WebThread.result:=result;
WebThread.Resume;


procedure TWebThread.Execute;
begin
Thread:=1;
Synchronize(ShowStatus);

GrabHTML;

Thread:=-1;
Synchronize(ShowStatus);
end;


Воипрос в том, что надо ли в TWebThread.Execute прописать try except, для обработки левых ситуаций. Т.к. насколько я понимаю try except действует и на вложенные процедуры.

Лелик_1044
19.10.2006, 17:05
Как правильно разрушить поток в процедуре
Execute т.е. послевыполнения сам себя

destructor THMAThread.Destroy;
begin
suspend;
free;
Terminate;
// inherited;
end;

у меня по f7 он в destroy по циклу бегает

Лелик_1044
20.10.2006, 12:16
Что-то намудрил
Как проверить сколько потоков запустила программа и сколько потоков в данный момент работает, на паузе

UUU
23.10.2006, 16:02
я, когда решал такую задачу - не смог ее решить красиво. Сделал тупо.
например, у меня максимальное количество потоков 20.
Запуская поток, увеличиваю счетчик, при закрытии его - уменьшаю. Работает безотказно уже 2 года :-)
Ни разу не встречался с зацикливанием. Везде стоят трай экзепт :-)

Лелик_1044
23.10.2006, 18:33
Мне надо сделать
1)Запускаю Н потоков они делают работу потом сами себя разрушают
2)Если нажимаю кнопку стоп независимо сделали до конца потоки свою работу их надо разрушить
3)Если нажимаю нопку пауза все потоки которые не доделали работу поставить на паузу
4)если нажимаю кнопку пуск после паузы то не надо создавть новые потоки надо просто чтоб старые доделали свобработу

LAngel
24.10.2006, 09:10
{
Остановка всех нитей процесса.
Если останавливается текущий процесс, то вызывающая нить не останавливается.
}
Function StopProcess(ProcessId: dword): boolean;
var
Snap: dword;
CurrTh: dword;
ThrHandle: dword;
Thread:TThreadEntry32;
begin
Result := false;
CurrTh := GetCurrentThreadId;
Snap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if Snap <> INVALID_HANDLE_VALUE then
begin
Thread.dwSize := SizeOf(TThreadEntry32);
if Thread32First(Snap, Thread) then
repeat
if (Thread.th32ThreadID <> CurrTh) and (Thread.th32OwnerProcessID = ProcessId) then
begin
ThrHandle := OpenThread(THREAD_SUSPEND_RESUME, false, Thread.th32ThreadID);
if ThrHandle = 0 then Exit;
SuspendThread(ThrHandle);
CloseHandle(ThrHandle);
end;
until not Thread32Next(Snap, Thread);
CloseHandle(Snap);
Result := true;
end;
end;

{ Запуск процесса остановленного StopProcess }
Function RunProcess(ProcessId: dword): boolean;
var
Snap: dword;
CurrTh: dword;
ThrHandle: dword;
Thread:TThreadEntry32;
begin
Result := false;
CurrTh := GetCurrentThreadId;
Snap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if Snap <> INVALID_HANDLE_VALUE then
begin
Thread.dwSize := SizeOf(TThreadEntry32);
if Thread32First(Snap, Thread) then
repeat
if (Thread.th32ThreadID <> CurrTh) and (Thread.th32OwnerProcessID = ProcessId) then
begin
ThrHandle := OpenThread(THREAD_SUSPEND_RESUME, false, Thread.th32ThreadID);
if ThrHandle = 0 then Exit;
ResumeThread(ThrHandle);
CloseHandle(ThrHandle);
end;
until not Thread32Next(Snap, Thread);
CloseHandle(Snap);
Result := true;
end;
end;

(c) Advanced API Hook Libary.
Coded By Ms-Rem ( Ms-Rem@yandex.ru ) ICQ 286370715

Лелик_1044
24.10.2006, 11:04
LAngel,
Т.е мне надо будет бросить номер того процесса которыйц я хочу остановить?
Да и при остоновлении он разрушается или на паузу ставится

LAngel
24.10.2006, 16:19
Лелик, останавливается (на паузу)
если передавать GetCurrentProcessID тогда текущая нить (вызвавшая процедуру остановки) не замораживается.