标签:utils 多个 leaks oca datetime isp 注意 output att
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.
标签:utils 多个 leaks oca datetime isp 注意 output att
原文地址:http://www.cnblogs.com/yangxuming/p/7053805.html