二小姐的茶会吧 关注:40贴子:1,380
  • 61回复贴,共1

关于TTask的外部中断&等待结束,,,写了个例子。

只看楼主收藏回复

unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.SyncObjs,
System.Threading;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
tasks: array [0 .. 2] of Itask;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
tasks[0].Start;
tasks[1].Start;
tasks[2].Start;
end;
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
tasks[0].Cancel;
tasks[1].Cancel;
tasks[2].Cancel;
{try
TTask.WaitForAll(tasks) ; //这个不行,要exception
except
end;}
for I := 0 to 2 do begin
if tasks[i].Status<>TTaskStatus.Completed then begin //主线程有访问TTask的Status属性,线程内部也会访问它,但是不会引发冲突,因为查看源代码发现它有[Volatile]属性
application.ProcessMessages;
sleep(10);
continue;
end;
end;
Memo1.Lines.Add('All done.');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
tasks[0] := ttask.Create(
procedure()
begin
while ttask.CurrentTask.Status <> TTaskStatus.Canceled do
begin
sleep(10);
TThread.Synchronize(nil,
procedure()
begin
Form1.Memo1.Lines.Add('Task 1 ...');
end);
end;
TThread.Synchronize(nil,
procedure()
begin
Form1.Memo1.Lines.Add('Task 1 end');
end);
end);
tasks[1] := ttask.Create(
procedure()
begin
while ttask.CurrentTask.Status <> TTaskStatus.Canceled do
begin
sleep(15);
TThread.Synchronize(nil,
procedure()
begin
Form1.Memo1.Lines.Add('Task 2 ...');
end);
end;
TThread.Synchronize(nil,
procedure()
begin
Form1.Memo1.Lines.Add('Task 2 end');
end);
end);
tasks[2] := ttask.Create(
procedure()
begin
while ttask.CurrentTask.Status <> TTaskStatus.Canceled do
begin
sleep(12);
TThread.Synchronize(nil,
procedure()
begin
Form1.Memo1.Lines.Add('Task 3 ...');
end);
end;
TThread.Synchronize(nil,
procedure()
begin
Form1.Memo1.Lines.Add('Task 3 end');
end);
end);
end;
end.


IP属地:广东1楼2015-09-23 23:35回复
    补充说明:
    当Task里有需要长时间执行的任务时,例如:
    while ttask.CurrentTask.Status <> TTaskStatus.Canceled do
    begin
    sleep(10000); // 模拟尽量大点的时间
    TThread.Synchronize(nil,
    procedure()
    begin
    Form1.Memo1.Lines.Add('Task 1 ...');
    end);
    end;
    以下代码将无法正常等待结束
    for I := 0 to 2 do begin
    if tasks[i].Status<>TTaskStatus.Completed then begin
    application.ProcessMessages;
    sleep(10);
    continue;
    end;
    end;
    Memo1.Lines.Add('All done.');
    end;


    IP属地:广东2楼2015-09-24 00:06
    收起回复
      除了以上,另有:
      其一,使用cancel取消的任务,最终的状态将是TTaskStatus.Canceled,不是TTaskStatus.Completed
      其二,使用cancel取消的任务,调用Wait系列函数时会产生一个异常,这是TTask本身的一个正常设计,无须惧怕该异常,有需要时尽管大胆地去用Wait,ITask接口里的CheckCanceled本身就是配合Cancel而设计


      IP属地:广东3楼2015-09-24 02:15
      收起回复
        好玩的事情来了,改了一下代码,任务里面在while后面增加了一些延时..,改为
        unit Unit1;
        interface
        uses
        Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
        System.Classes, Vcl.Graphics,
        Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.SyncObjs,
        System.Threading;
        type
        TForm1 = class(TForm)
        Memo1: TMemo;
        Button1: TButton;
        Button2: TButton;
        procedure Button1Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        private
        tasks: array [0 .. 2] of Itask;
        { Private declarations }
        public
        { Public declarations }
        end;
        var
        Form1: TForm1;
        implementation
        {$R *.dfm}
        procedure TForm1.Button1Click(Sender: TObject);
        begin
        tasks[0].Start;
        tasks[1].Start;
        tasks[2].Start;
        end;
        procedure TForm1.Button2Click(Sender: TObject);
        var
        i: integer;
        w_alldone:boolean;
        begin
        tasks[0].Cancel;
        tasks[1].Cancel;
        tasks[2].Cancel;
        try
        TTask.WaitForAll(tasks) ; //这个不行,要exception
        except
        end;
        {for i := 0 to 2 do
        begin
        if tasks[i].Status <> TTaskStatus.Completed then
        begin // 主线程有访问TTask的Status属性,线程内部也会访问它,但是不会引发冲突,因为查看源代码发现它有[Volatile]属性
        application.ProcessMessages;
        sleep(10);
        continue;
        end;
        end;}
        {w_alldone:=false;
        while not w_alldone do begin
        w_alldone:=true;
        for i := 0 to 2 do begin
        w_alldone:=w_alldone and (tasks[i].Status = TTaskStatus.Canceled);
        if not w_alldone then break;
        end;
        application.ProcessMessages;
        sleep(10);
        end; }
        Memo1.Lines.Add('All done.');
        end;
        procedure TForm1.FormCreate(Sender: TObject);
        begin
        tasks[0] := ttask.Create(
        procedure()
        begin
        while ttask.CurrentTask.Status<>TTaskStatus.Canceled do
        begin
        sleep(10);
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 1 ...');
        end);
        end;
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 1 , exit while ...');
        end);
        sleep(1000);
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 1 end');
        end);
        end);
        tasks[1] := ttask.Create(
        procedure()
        begin
        while ttask.CurrentTask.Status<> TTaskStatus.Canceled do
        begin
        sleep(15);
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 2 ...');
        end);
        end;
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 2 , exit while ...');
        end);
        sleep(1000);
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 2 end');
        end);
        end);
        tasks[2] := ttask.Create(
        procedure()
        begin
        while ttask.CurrentTask.Status<> TTaskStatus.Canceled do
        begin
        sleep(12);
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 3 ...');
        end);
        end;
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 3 , exit while ...');
        end);
        sleep(1000);
        TThread.Synchronize(nil,
        procedure()
        begin
        Form1.Memo1.Lines.Add('Task 3 end');
        end);
        end);
        end;
        end.


        IP属地:广东4楼2015-09-24 08:56
        收起回复
          用原配的
          try
          TTask.WaitForAll(tasks) ; //这个不行,要exception
          except
          end;
          结果显示:
          Task 2 ...
          Task 1 ...
          Task 3 ...
          Task 1 ...
          All done.
          Task 2 ...
          Task 1 , exit while ...
          Task 2 , exit while ...
          Task 3 ...
          Task 3 , exit while ...
          Task 1 end
          Task 2 end
          Task 3 end
          All Done最先出来,,


          IP属地:广东5楼2015-09-24 08:58
          收起回复
            用第二种方法:
            for i := 0 to 2 do
            begin
            if tasks[i].Status <> TTaskStatus.Completed then
            begin // 主线程有访问TTask的Status属性,线程内部也会访问它,但是不会引发冲突,因为查看源代码发现它有[Volatile]属性
            application.ProcessMessages;
            sleep(10);
            continue;
            end;
            end;
            正如吧主所言,也是刹不住车的,看结果 ...
            Task 2 ...
            Task 1 ...
            Task 3 ...
            Task 2 ...
            Task 1 ...
            Task 1 , exit while ...
            Task 3 ...
            Task 2 ...
            Task 3 , exit while ...
            Task 2 , exit while ...
            All done.
            Task 1 end
            Task 3 end
            Task 2 end


            IP属地:广东6楼2015-09-24 09:00
            收起回复
              这个方法是吧主建议的,结果...
              w_alldone:=false;
              while not w_alldone do begin
              w_alldone:=true;
              for i := 0 to 2 do begin
              w_alldone:=w_alldone and (tasks[i].Status = TTaskStatus.Canceled);
              if not w_alldone then break;
              end;
              application.ProcessMessages;
              sleep(10);
              end;
              Task 1 ...
              Task 1 ...
              Task 3 ...
              Task 2 ...
              All done.
              Task 1 ...
              Task 3 ...
              Task 2 ...
              Task 1 , exit while ...
              Task 3 , exit while ...
              Task 2 , exit while ...
              Task 1 end
              Task 3 end
              Task 2 end


              IP属地:广东7楼2015-09-24 09:03
              收起回复
                FState是set of TOptionStateFlag类型,在最后FState已经有了[Completed,Cancled]状态,但是看源代码,,,
                Canceled的优先权比较大,这也解释了为什么上面的代码走不出循环了.
                so 也许我们用.cancel来作为通知任务结束的方法本身就不对....
                function TTask.GetStatus: TTaskStatus;
                var
                LFlags: TOptionStateFlags;
                begin
                LFlags := FState;
                if TOptionStateFlag.Faulted in LFlags then
                Result := TTaskStatus.Exception
                else if TOptionStateFlag.Canceled in LFlags then
                Result := TTaskStatus.Canceled
                else if TOptionStateFlag.Complete in LFlags then
                Result := TTaskStatus.Completed
                else if TOptionStateFlag.ChildWait in LFlags then
                Result := TTaskStatus.WaitingForChildren
                else if TOptionStateFlag.CallbackRun in LFlags then
                Result := TTaskStatus.Running
                else if TOptionStateFlag.Started in LFlags then
                Result := TTaskStatus.WaitingToRun
                else
                Result := TTaskStatus.Created;
                end;


                IP属地:广东9楼2015-09-24 09:43
                收起回复
                  而且Task这东西,在delphi10的bug fix list里就有修复其中几个bug,不知还有没其他:
                  1.Creating TTask instances inside running TTask leads to deadlock upon application close
                  2.ITask.Wait Freeze/Lockup
                  3.TTask.WaitForAny gives exception EMonitorLockException 'Object lock not owned'


                  IP属地:广东11楼2015-09-24 10:28
                  收起回复