LeR*_*kie 3 delphi winapi freepascal timer message-queue
对于Windows服务,我需要一个计时器来定期执行某项任务.当然,有许多选项似乎优于计时器(多线程,直接从服务的主线程调用方法),但它们在这种特定情况下都有它们的缺点.
但是,由于显而易见的原因,如果没有GUI的消息队列,SetTimer()将无法工作.我所做的(在Free Pascal中)是以下内容:
创建计时器:
MyTimerID := SetTimer(0, 0, 3333, @MyTimerProc);
Run Code Online (Sandbox Code Playgroud)
在服务的主循环中,运行计时器队列:
procedure TMyServiceThread.Execute;
var
AMessage: TMsg;
begin
repeat
// Some calls
if PeekMessage(AMessage, -1, WM_TIMER, WM_TIMER, PM_REMOVE) then begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
// Some more calls
TerminateEventObject.WaitFor(1000);
until Terminated;
end;
Run Code Online (Sandbox Code Playgroud)
最后,杀掉计时器:
KillTimer(0, MyTimerID)
Run Code Online (Sandbox Code Playgroud)
除了KillTimer总是返回False,这按预期工作.
我对你的反馈很感兴趣,但是,如果我的实现是正确的 - 我只是想避免弄乱其他应用程序的消息以及我不知道的其他副作用,因为我对消息处理经验不足.
谢谢!
我会选择一个等待计时器.不需要消息队列.
function WaitableTimerDelayFromMilliseconds(milliseconds: Integer): TLargeInteger;
begin
Result := 0 - (TLargeInteger(milliseconds) * 10000);
end;
procedure TMyServiceThread.Execute;
var
TimerInterval: Integer;
DueTime: TLargeInteger;
hTimer: THandle;
Handles: array[0..1] of THandle;
begin
TimerInterval := 10000; // use whatever interval you need
DueTime := WaitableTimerDelayFromMilliseconds(TimerInterval);
hTimer := CreateWaitableTimer(nil, FALSE, nil);
if hTimer = 0 then RaiseLastOSError;
try
if not SetWaitableTimer(hTimer, DueTime, TimerInterval, nil, nil, False) then RaiseLastOSError;
try
Handles[0] := TerminateEventObject.Handle;
Handles[1] := hTimer;
while not Terminated do
begin
case WaitForMultipleObjects(2, PWOHandleArray(@Handles), False, INFINITE) of
WAIT_FAILED:
RaiseLastOSError;
WAIT_OBJECT_0+0:
Terminate;
WAIT_OBJECT_0+1:
begin
// do your work
end;
end;
end;
finally
CancelWaitableTimer(hTimer);
end;
finally
CloseHandle(hTimer);
end;
end;
Run Code Online (Sandbox Code Playgroud)
更新:或者,正如David Heffernan建议的那样,你可以单独等待终止事件:
procedure TMyServiceThread.Execute;
var
TimerInterval: Integer;
begin
TimerInterval := 10000; // use whatever interval you need
while not Terminated do
begin
case TerminateEventObject.WaitFor(TimerInterval) of
wrSignaled:
Terminate;
wrTimeout:
begin
// do your work
end;
wrError:
RaiseLastOSError;
end;
end;
end;
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
1227 次 |
| 最近记录: |