TThread старт финиш приостановить срубить

Jude
Дата: 23.05.2011 21:37:54
Уважаемые знатоки!

ниже приведен пример работы с потоками. Пример писал сам. Пока искал - наткнулся на несколько "учебников", содержащих в примерах нерабочий код. Смотрю ситуация это распространенная.

Пока пример вроде бы рабочий. Задача - поток с возможностью приостановить/срубить/стартануть заново. Цель - учу потоки, пока хочу силами только TThread реализовать.

Просьба:

Если будет такое желание - прокомментируйте.

Что интересует:
- в первую очередь дедлоки. аргументированные комментарии и конструктивная критика приветствуются.
- ошибки, которые возможны, которые я не учел. (пример маленький, но помучился над ним много, пока все заборол.)
- нечитабельность кода. если где "некрасиво" , "непонятно", "неправильно названо" и т.д. - пишите, учту.

Заранее благодарен.

п.с. грамотные книжки по теме - тоже заранее спасибо. Т.к. нашел много не рабочего/кривого. (Рихтер уже есть - читаю.)

Главный модуль:

+
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, testthreads;

type
  TForm1 = class(TForm)
    Btstop: TButton;
    LaValue: TLabel;
    lalterNum: TLabel;
    BtStart: TButton;
    Memo1: TMemo;
    BtKill: TButton;
    procedure BtStartClick(Sender: TObject);
    procedure BtstopClick(Sender: TObject);
    procedure Calcked(Sender: TObject);
    procedure BtKillClick(Sender: TObject);

  private
    { Private declarations }

  public
    { Public declarations }

    ser:TtestThread;


  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

procedure Tform1.Calcked(Sender: TObject);
begin
  //Calck
  memo1.Lines.Add('Theard was calck at '+timetostr(time) + ' val = ' + inttostr(ser.x));
  Btstop.Enabled:=true;
  Btstart.Enabled:=true;
  ser:=nil;
end;

procedure TForm1.BtStartClick(Sender: TObject);
begin
  if ser = nil then
  begin
    btstart.Enabled := false;
    memo1.Lines.Add('Start Theard in '+ timetostr(time));
    ser := TtestThread.Create(true);
    ser.FreeOnTerminate := true;
    ser.OnTerminate := calcked;
    ser.Resume;
    btstop.Enabled := true;  
  end else
  if ser.Suspended then
  begin
    BtStart.Enabled:= false;
    btstop.Enabled := true;
    memo1.Lines.Add('Theard restart at ' + timetostr(time) + '! progress ' + inttostr(ser.x) + '/'+inttostr(max_val));
    ser.Resume;
  end;
end;

procedure TForm1.BtstopClick(Sender: TObject);
begin
  if ser=nil then exit;
  btstop.Enabled:=false;
  memo1.Lines.Add(' Theard was suspended at '+ timetostr(time));
  ser.Suspend;
  memo1.Lines.Add(' Theard progress ' + inttostr(ser.x) + '/'+ inttostr(max_val)+ ' at ' + timetostr(time));
  BtStart.Enabled:=true;
end;

procedure TForm1.BtKillClick(Sender: TObject);
begin
  if ser=nil then
    memo1.Lines.Add('Nothing to kill.')
  else
  if ser.Suspended then
  begin
    memo1.Lines.Add('Suspended '+ inttostr(ser.x) + '/' + inttostr(max_val) +'. try to kill at' + timetostr(time));
    if (application.MessageBox( 'kill it any way?', 'Theard is suspended!', MB_YESNO) = IDYES) then
    begin
      memo1.Lines.Add('try to kill Suspended Thread at '+ timetostr(time));
      ser.Terminate;
      ser.Resume;
    end;
  end else
  begin
    memo1.Lines.Add('try to kill Thread at '+ timetostr(time));
    ser.Terminate;
  end;
end;

end.

Юнит-поток:

unit testthreads;

interface

uses
  Classes,windows;

const
  max_val=1001;
type
  TtestThread = class(TThread)
  private
    { Private declarations }
    fx:dword;

  protected
    procedure Execute; override;
  public
    property x:dword read fx write fx default 0;
  end;

implementation

{ TtestThread }

procedure TtestThread.Execute;
var i:integer;
begin
  i:=0;
  while (i<max_val) and not terminated do
  begin
    sleep(10);
    inc(i);
    fx:=i;
  end;
  Returnvalue:=i;
end;

end.


Спасибо.
DmSer
Дата: 23.05.2011 22:04:09
автор
procedure TForm1.BtstopClick(Sender: TObject);
begin
if ser=nil then exit;
btstop.Enabled:=false;
memo1.Lines.Add(' Theard was suspended at '+ timetostr(time));
ser.Suspend;
memo1.Lines.Add(' Theard progress ' + inttostr(ser.x) + '/'+ inttostr(max_val)+ ' at ' + timetostr(time));
BtStart.Enabled:=true;
end;


НЕЛЬЗЯ вызывать Suspend потоку из кода, если этот код не выполняется в контексте этого потока! Причины уже пояснялись. Причем не раз. Если подобные примеры есть в литературе, то компетентность писателя вызывает некоторые сомнения. Более того, метод Suspend в новых версиях Delphi помечен как depricated (означает "не рекомендуется"). Правда разработчики поспешили и вынесли аналогичный вердикт и Resume, ну да бог с ними.

Собственно, больше здесь нечего обсуждать. Дополнительный поток ничего не делает, кроме надуманного инкремента. Предложите задачу более интересную, обсудим. Кстати, на королевстве (www.delphikingdom.ru) есть несколько неплохих статей, посвященных теме многопоточности. Изучайте их, экспериментируйте.
Jude
Дата: 23.05.2011 22:16:02
DmSer,

Огромное спасибо За Ваш ответ!

поток постарался по максимому упростить - т.к. не хотел добавлять багов)))

в предидущей задаче, где пытался применять подобное решение, поток искал файлы-дубликаты. начались ошибки, решил разобраться по "кирпичикам".
_Vasilisk_
Дата: 23.05.2011 23:32:37
Вызывать Suspend не очень хорошо, т.к. поток может остановиться в произвольный момент. Гораздо эффективней организовать цикл на основе Wait-функции. Тогда с помощью такой функции можно легко управлять жизнью потока. Например
TMyTread = class(TThread)
private
  FHandles: array[0..1] of THandle;
protected
  procedure Execute; override;
public
  constructor Create;
  destructor Destroy; override;
  procudure Pause;
  procudure UnPause;
  procudure Stop;
end;

constructor TMyThread.Create;
begin
  inherited Create(False);
  FHandles[0] := CreateEvent(nil, False, False, nil);  // Управление завершением потока
  FHandles[1] := CreateEvent(nil, True, True, nil);  // Управление паузой
  FreeOnTerminate := True;
end;

destructor TMyThread.Destroy;
begin
  CloseHandle(FHandles[1]);
  CloseHandle(FHandles[0]);
  inherited Destroy;
end;

procedure TMyThread.Execute;
begin
  while not Terminated do begin
    case WaitForMultipleObjects(2, @FHandles[0], False, INFINITE) do
      WAIT_FAILED: RaiseLastOsError;
      WAIT_OBJECT_0: Terminate;
      WAIT_OBJECT_0 + 1: begin
        // Тут выполняем полезную работу
      end;
  end;
end;

procedure TMyThread.Pause;
begin
  ResetEvent(FHandles[1]);
end;

procedure TMyThread.UnPause;
begin
  SetEvent(FHandles[1]);
end;

procedure TMyThread.Stop;
begin
  SetEvent(FHandles[0]);
end;
Гаджимурадов Рустам
Дата: 23.05.2011 23:50:14

_Vasilisk_, круто. Аж смотреть приятно, снимаю шляпу.

Posted via ActualForum NNTP Server 1.4

_Vasilisk_
Дата: 24.05.2011 00:00:33

У меня 99% кода на этом классе написано. Только у меня используется MsgWaitForMultipleObjects()
Гаджимурадов Рустам
Дата: 24.05.2011 00:04:06

_Vasilisk_> У меня 99% кода на этом классе написано.

99% кода многопоточные? :)

Posted via ActualForum NNTP Server 1.4

DmSer
Дата: 24.05.2011 00:05:39
Вызывать Suspend не очень хорошо, т.к. поток может остановиться в произвольный момент.


Можно перефразировать: не очень хорошо, если ваша программа каждые полчаса будет намертво виснуть :)

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

procedure TMyThread.Pause


На моей практике не приходилось ни разу усыплять потоки извне (они сами останавливаются при необходимости). А вот выводить из спячки - дело обычное. Пример кода - из реальной задачи?
_Vasilisk_
Дата: 24.05.2011 00:11:22
DmSer
Пример кода - из реальной задачи?
Выполнение приоритетной задачи. Приостановка мониторига.

А вообще автор попросил - автор получил
Barmaley57
Дата: 24.05.2011 00:41:48
Jude
property x:dword read fx write fx default 0;
про default почитай, ибо непонятно зачем он здесь.