qworker 实例

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, qrbtree, qworker, SyncObjs, ExtCtrls, dateutils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button4: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    Button3: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Label3: TLabel;
    Button16: TButton;
    Button17: TButton;
    Label4: TLabel;
    Button18: TButton;
    Button19: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button18Click(Sender: TObject);
    procedure Button19Click(Sender: TObject);
  private
    { Private declarations }
    FSignalId: Integer;
    procedure DoJobProc(AJob: PQJob);
    procedure DoPostJobDone(AJob: PQJob);
    procedure DoMainThreadWork(AJob: PQJob);
    procedure DoPostJobMsg(var AMsg: TMessage); message WM_APP;
    procedure SignalWaitProc(AJob: PQJob);
    procedure DoSignalJobMsg(var AMsg: TMessage); message WM_APP + 1;
    procedure DoTimerProc(AJob: PQJob);
    procedure DoTimerJobMsg(var AMsg: TMessage); message WM_APP + 2;
    procedure DoLongtimeWork(AJob: PQJob);
    procedure DoLongworkDone(AJob: PQJob);
    procedure DoAtTimeJob1(AJob: PQJob);
    procedure DoAtTimeJob2(AJob: PQJob);
    procedure DoDelayJob(AJob: PQJob);
    procedure DoCancelJob(AJob: PQJob);
    procedure DoNullJob(AJob: PQJob);
    procedure DoCOMJob(AJob: PQJob);
    procedure DoRandDelay(AJob: PQJob);
    procedure SelfTerminateJob(AJob: PQJob);
  public
    { Public declarations }
  end;

  TAutoFreeTestObject = class
  public
    constructor Create; overload;
    destructor Destroy; override;
  end;

  PAutoFreeRecord = ^TAutoFreeRecord;

  TAutoFreeRecord = record
    Id: Integer;
  end;

var
  Form1: TForm1;

implementation

uses
  qstring, comobj;
{$R *.dfm}

procedure TForm1.SelfTerminateJob(AJob: PQJob);
begin
  Label4.Caption := '自结束作业已运行 ' + IntToStr(AJob.Runs) + '次';
  if AJob.Runs = 3 then
  begin
    AJob.IsTerminated := True;
    Label4.Caption := '自结束作业已结束.';
  end;
end;

procedure TForm1.SignalWaitProc(AJob: PQJob);
begin
  PostMessage(Handle, WM_APP + 1, AJob.Runs, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Workers.Signal(FSignalId);
end;

procedure TForm1.Button10Click(Sender: TObject);
var
  ATime: TDateTime;
begin
  ATime := Now;
  ATime := IncSecond(ATime, 10);
  Workers.at(DoAtTimeJob2, ATime, QWorker.Q1Hour, nil, True);
  ShowMessage('这个任务将在' + FormatDateTime('hh:nn:ss.zzz', ATime) + '时第一次启动，以后每隔1小时定时启动一次。');
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
  Workers.Post(DoCancelJob, Pointer(1));
//直接取消简单作业队列中的作业，正常情况下是没来的及执行
  Workers.Clear(DoCancelJob, Pointer(1));
  Workers.Post(DoCancelJob, Pointer(2));
//作业已经进行了，取消操作会等待作业完成
  Sleep(100);
  Workers.Clear(DoCancelJob, Pointer(2));
//重复作业
  Workers.Post(DoCancelJob, 1000, Pointer(3));
//直接取消重复作业队列中的作业
  Workers.Clear(DoCancelJob, Pointer(3));
//重复作业
  Workers.Post(DoCancelJob, 1000, Pointer(4));
  Sleep(200);
//直接取消重复作业队列中的作业
  Workers.Clear(DoCancelJob, Pointer(4));
//信号作业队列
  Workers.Wait(DoCancelJob, FSignalId, Pointer(5));
  Workers.Clear(DoCancelJob, Pointer(5));
end;

procedure TForm1.Button12Click(Sender: TObject);
var
  AData: PAutoFreeRecord;
begin
  Workers.Post(DoNullJob, TAutoFreeTestObject.Create, false, jdfFreeAsObject);
  New(AData);
  Workers.Delay(DoNullJob, 1000, AData, false, jdfFreeAsRecord);
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
  Workers.Post(DoCOMJob, nil);
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
  Workers.Signal('MySignal.Start');
  Workers.Signal('MySignal.Start');
  Workers.Post(DoNullJob, nil);
  Workers.Clear('MySignal.Start');
end;

procedure TForm1.Button15Click(Sender: TObject);
begin
  Workers.Delay(DoRandDelay, Q1Second, nil);
end;

procedure DoGlobalJob(AJob: PQJob);
begin
  ShowMessage('全局函数作业已调用。');
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
  Workers.Post(MakeJobProc(DoGlobalJob), nil, True);
end;

procedure TForm1.Button17Click(Sender: TObject);
begin
  Workers.Post(SelfTerminateJob, 10000, nil, true);
end;

procedure TForm1.Button18Click(Sender: TObject);
var
  AId: Integer;
  T: Cardinal;
begin
  AId := Workers.RegisterSignal('Signal.SelfKill');
  Workers.Wait(SelfTerminateJob, AId, nil, True);
  Workers.Signal(AId);
  T := GetTickCount;
  while GetTickCount - T < 500 do
    Application.ProcessMessages;
  Workers.Signal(AId);
  T := GetTickCount;
  while GetTickCount - T < 500 do
    Application.ProcessMessages;
  Workers.Signal(AId);
  T := GetTickCount;
  while GetTickCount - T < 500 do
    Application.ProcessMessages;
  Workers.Signal(AId);
end;

procedure TForm1.Button19Click(Sender: TObject);
var
  AGroup: TQJobGroup;
  AMsg: string;
begin
  AGroup := TQJobGroup.Create(True);
  if AGroup.WaitFor() <> wrSignaled then
    AMsg := 'WaitFor空作业列表失败';
  AGroup.Prepare;
  AGroup.Add(DoNullJob, nil, false);
  AGroup.Add(DoNullJob, nil, false);
  AGroup.Add(DoNullJob, nil, false);
  AGroup.Run;
  if AGroup.WaitFor() <> wrSignaled then
    AMsg := 'WaitFor多个作业失败';
  FreeObject(AGroup);
  if Length(AMsg) > 0 then
    ShowMessage(AMsg)
  else
    ShowMessage('分组作业执行成功完成。');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1Timer(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Workers.Post(DoPostJobDone, nil);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ShowMessage(IntToStr(GetTimeStamp));
end;

procedure TForm1.Button4Click(Sender: TObject);
const
  ACount: Integer = 10000000;
var
  I, ARuns: Integer;
  T1: Int64;
  ANeedRuns: Int64;
begin
  ARuns := 0;
//Workers.MaxWorkers:=500;
  ANeedRuns := ACount;
  T1 := GetTimeStamp;
  for I := 0 to ACount - 1 do
  begin
    assert(Workers.Post(DoJobProc, @ARuns), 'Post failure');
  end;
  while (ARuns < ANeedRuns) do
  {$IFDEF UNICODE}
    TThread.Yield;
  {$ELSE}
  SwitchToThread;
  {$ENDIF}
  T1 := GetTimeStamp - T1;
  ShowMessage('Time Used=' + IntToStr(T1) + ',Runs=' + IntToStr(ARuns) + ',Speed=' + IntToStr(Int64(ARuns) * 10000 div T1));
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Workers.Post(DoMainThreadWork, nil, True);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Workers.Signal('MySignal.Start');
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  if not Workers.LongtimeJob(DoLongtimeWork, nil) then
    ShowMessage('长时间作业投寄失败');
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  ShowMessage('这个任务将在5秒后第一次启动，以后每隔1小时定时启动一次。');
  Workers.at(DoAtTimeJob1, 5 * QWorker.Q1Second, QWorker.Q1Hour, nil, True)
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  Workers.Delay(DoDelayJob, 5 * QWorker.Q1Second, nil, True)
end;

procedure TForm1.DoAtTimeJob1(AJob: PQJob);
begin
  ShowMessage('定时5秒后执行的任务已经执行了' + IntToStr(AJob.Runs + 1) + '次，1小时后执行下一次');
end;

procedure TForm1.DoAtTimeJob2(AJob: PQJob);
begin
  ShowMessage('定时任务已在' + FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Now) + '开始第' + IntToStr(AJob.Runs + 1) + '次执行，1小时后执行下一次'#13#10 + '入队时间:' + IntToStr(AJob.PushTime) + #13#10 + '出队时间:' + IntToStr(AJob.PopTime));
end;

procedure TForm1.DoCancelJob(AJob: PQJob);
begin
  OutputDebugString(PWideChar('DoCancelJob(' + IntToHex(IntPtr(AJob), 8) + ')-' + IntToStr(Integer(AJob.Data)) + ' Started'));
  Sleep(5000);
  OutputDebugString(PWideChar('DoCancelJob(' + IntToHex(IntPtr(AJob), 8) + ')-' + IntToStr(Integer(AJob.Data)) + ' Finished'));
end;

procedure TForm1.DoCOMJob(AJob: PQJob);
var
  ADispatch: IDispatch;
begin
  AJob.Worker.ComNeeded();
  try
    ADispatch := CreateOleObject('ADODB.Recordset');
  except
  end;
end;

procedure TForm1.DoDelayJob(AJob: PQJob);
begin
  ShowMessage('延迟的任务已经执行完成了。'#13#10 + '入队时间:' + IntToStr(AJob.PushTime) + #13#10 + '出队时间:' + IntToStr(AJob.PopTime));
end;

procedure TForm1.DoJobProc(AJob: PQJob);
begin
  AtomicIncrement(PInteger(AJob.Data)^);
end;

procedure TForm1.DoLongtimeWork(AJob: PQJob);
begin
  while not AJob.IsTerminated do
  begin
    Sleep(1000);
    if AJob.EscapedTime > 50000 then//5s后结束任务，注意计时单位为0.1ms
      AJob.IsTerminated := True;
  end;
  if not Workers.Terminating then//如果未结束，则触发一个通知能前台，这样方便前台做一些进一步处理
    Workers.Signal('Longwork.Done');
end;

procedure TForm1.DoLongworkDone(AJob: PQJob);
begin
  ShowMessage('长时间作业已经完成');
end;

procedure TForm1.DoMainThreadWork(AJob: PQJob);
begin
  ShowMessage('这是在主线程中触发的异步作业。');
end;

procedure TForm1.DoNullJob(AJob: PQJob);
begin
  OutputDebugString('Null Job Executed');
end;

procedure TForm1.DoPostJobDone(AJob: PQJob);
begin
  PostMessage(Handle, WM_APP, AJob.PopTime - AJob.PushTime, 0);
end;

procedure TForm1.DoPostJobMsg(var AMsg: TMessage);
begin
  ShowMessage(Format('作业投寄到执行用时 %g ms', [AMsg.WParam / 10]));
end;

procedure TForm1.DoRandDelay(AJob: PQJob);
begin
  Label3.Caption := '随机作业末次延迟 ' + IntToStr((AJob.PopTime - AJob.PushTime) div 10) + 'ms';
  Workers.Delay(AJob.WorkerProc, qworker.Q1Second + random(qworker.Q1Second), AJob.Data, True);
end;

procedure TForm1.DoSignalJobMsg(var AMsg: TMessage);
begin
  Label2.Caption := Format('信号MySignal.Start已触发 %d次', [AMsg.WParam]);
end;

procedure TForm1.DoTimerJobMsg(var AMsg: TMessage);
begin
  Label1.Caption := '定时任务已执行' + IntToStr(AMsg.WParam) + '次';
end;

procedure TForm1.DoTimerProc(AJob: PQJob);
begin
  PostMessage(Handle, WM_APP + 2, AJob.Runs, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutDown := True;
//注册一个信号触发函数，以便在触发时执行
  FSignalId := Workers.RegisterSignal('MySignal.Start');
  Workers.Wait(SignalWaitProc, FSignalId, nil);
//使用名称来触发的信号
  Workers.Wait(DoLongworkDone, Workers.RegisterSignal('Longwork.Done'), nil, true);
//注册一个定时执行任务信号，每0.1秒触发一次
  Workers.Post(DoTimerProc, 1000, nil);
  Caption := 'QWorker Demo (CPU:' + IntToStr(GetCpuCount) + ')';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Workers.Clear(Self);
end;

{ TAutoFreeTestObject }

constructor TAutoFreeTestObject.Create;
begin
  OutputDebugString('TAutoFreeTestObject.Create');
end;

destructor TAutoFreeTestObject.Destroy;
begin
  OutputDebugString('TAutoFreeTestObject.Free');
  inherited;
end;

end.

【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/yangxuming/p/7053805.html