定时器的使用 之 SetWaitableTimer

]{******************************************************************************}
{ @UnitName     : uWaitableTimer.pas                                           }
{ @Project      : Waitable Timer Objects                                       }
{ @Copyright    : Budded Software Studio                                       }
{ @Author       : Budded                                                       }
{ @Description  : Description                                                  }
{ @FileVersion  : 1.0.0.0                                                      }
{ @CreateDate   : 2009-04-22                                                   }
{ @Comment      : Waitable Timer Objects                                       }
{ @LastUpdate   : Budded, 2009-04-22                                           }
{ @History      : Created By Budded, 2009-04-22 13:00                          }
{******************************************************************************}
unit uWaitableTimer;
interface
uses
SysUtils, Classes, Windows;
type
TTimerAPCProc = procedure (const Param: Pointer; const TimerLowValue, TimerHighValue: DWord); stdcall;
TWaitableTimer = class
private
FHandle: THandle;
FList: TList;
procedure QueueUserAPCInner(const Data: Pointer);
procedure FreeListMem();
public
constructor Create(const AName: String = ''; const ManualReset: Boolean = True);
destructor Destroy(); override;
function SetTimer(var lpDueTime: TLargeInteger; const lPeriod: Cardinal;
pfnCompletionRoutine: TTimerAPCProc;
lpArgToCompletionRoutine: Pointer): Boolean; overload;
function SetTimer(var lpDueTime: TLargeInteger; const lPeriod: Cardinal;
pfnCompletionRoutine: TNotifyEvent;
lpArgToCompletionRoutine: TObject): Boolean; overload;
function CancelTimer(): Boolean;
property Handle: THandle read FHandle;
end;
implementation
type
TCallbackType = (ctFarProc, ctNotifyEvent);

TAccessType = (atGet, atFree);
TWorkThread = class(TThread)
protected
procedure Execute; override;
public
class function ThreadHandle(const AccType: TAccessType = atGet): THandle;
end;

PCallbackParam = ^TCallbackParam;
TCallbackParam = packed record
Timer: THandle;
AType: TCallbackType;
lpDueTime: TLargeInteger;
lPeriod: Cardinal;
case TCallbackType of
ctFarProc: (
pfnCompletionRoutine: TTimerAPCProc;
lpArgToCompletionRoutine: Pointer;
);
ctNotifyEvent: (
pfnNotifyEnevt: TNotifyEvent;
lpSender: TObject;
);
end;
procedure Debug(const Msg: String);
var
FData: String;
begin
FData := Format('Curr: %d; Main: %d; Msg: %s', [GetCurrentThreadID, MainThreadID, Msg]);
OutputDebugString(PChar(FData));
end;
procedure TimerAPCProc(const Param: Pointer; const TimerLowValue, TimerHighValue: DWord); stdcall;
var
FData: PCallbackParam;
begin
FData := Param;
if Assigned(FData) then
try
case FData.AType of
ctFarProc:
if Assigned(FData.pfnCompletionRoutine) then
FData.pfnCompletionRoutine(FData.lpArgToCompletionRoutine, TimerLowValue, TimerHighValue);
ctNotifyEvent:
if Assigned(FData.pfnNotifyEnevt)then
FData.pfnNotifyEnevt(FData.lpSender);
end;
finally
// do not dispose FData pointer
end;
end;
procedure TimerQueueAPCProc(const Param: Pointer); stdcall;
var
FData: PCallbackParam;
lpDueTime: TLargeInteger;
FRtn: Boolean;
begin
FData := Param;
if Assigned(FData) and (FData.Timer > 0) then
begin
lpDueTime := -10000 * FData.lpDueTime;  // 纳秒级
FRtn := SetWaitableTimer(FData.Timer, lpDueTime, FData.lPeriod, @TimerAPCProc,
FData, False);
if not FRtn then
Debug('SetWaitableTimer ' + IntToStr(GetLastError));
end;
end;
{ TWaitableTimer }
function TWaitableTimer.CancelTimer: Boolean;
begin
Result := CancelWaitableTimer(FHandle)
end;
constructor TWaitableTimer.Create(const AName: String;
const ManualReset: Boolean);
begin
inherited Create();
FList := TList.Create;
FHandle := CreateWaitableTimer(nil, ManualReset, PChar(AName));
end;
destructor TWaitableTimer.Destroy;
begin
CancelTimer;
CloseHandle(FHandle);
FreeListMem();
if Assigned(FList) then
FreeAndNil(FList);

inherited;
end;
procedure TWaitableTimer.FreeListMem;
var
I: Integer;
begin
if Assigned(FList) then
for I := 0 to FList.Count - 1 do
Dispose(FList[I]);
end;
procedure TWaitableTimer.QueueUserAPCInner(const Data: Pointer);
begin
QueueUserAPC(@TimerQueueAPCProc, TWorkThread.ThreadHandle(), Cardinal(Data));
end;
function TWaitableTimer.SetTimer(var lpDueTime: TLargeInteger;
const lPeriod: Cardinal; pfnCompletionRoutine: TTimerAPCProc;
lpArgToCompletionRoutine: Pointer): Boolean;
var
FData: PCallbackParam;
begin
New(FData);
ZeroMemory(FData, SizeOf(TCallbackParam));
FData.Timer := Handle;
FData.AType := ctFarProc;
FData.lpDueTime := lpDueTime;
FData.lPeriod := lPeriod;
FData.pfnCompletionRoutine := pfnCompletionRoutine;
FData.lpArgToCompletionRoutine := lpArgToCompletionRoutine;
QueueUserAPCInner(FData);
FList.Add(FData);
end;
function TWaitableTimer.SetTimer(var lpDueTime: TLargeInteger;
const lPeriod: Cardinal; pfnCompletionRoutine: TNotifyEvent;
lpArgToCompletionRoutine: TObject): Boolean;
var
FData: PCallbackParam;
begin
New(FData);
ZeroMemory(FData, SizeOf(TCallbackParam));
FData.Timer := Handle;
FData.AType := ctNotifyEvent;
FData.lpDueTime := lpDueTime;
FData.lPeriod := lPeriod;
FData.pfnNotifyEnevt := pfnCompletionRoutine;
FData.lpSender := lpArgToCompletionRoutine;
QueueUserAPCInner(FData);
FList.Add(FData);
end;
{ TWorkThread }
procedure TWorkThread.Execute;
begin
while not Terminated do
SleepEx(INFINITE, True);
end;
class function TWorkThread.ThreadHandle(
const AccType: TAccessType): THandle;
{$J+}
const FHandle: THandle = 0;
{$J-}
begin
Result := 0;
case AccType of
atGet:
begin
if FHandle = 0 then
FHandle := TWorkThread.Create(False).Handle;
Result := FHandle;
end;
atFree:
begin
TerminateThread(FHandle, 0);
FHandle := 0;
end;
end;
end;
initialization
//  TWorkThread.ThreadHandle();
finalization
TWorkThread.ThreadHandle(atFree);

end.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uWaitableTimer, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
FTimer: TWaitableTimer;
procedure SetTimerAPC(const Inner: Boolean = True);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TimerAPCProc(const Param: Pointer; const TimerLowValue, TimerHighValue: DWord); stdcall;
var
FData: String;
FTime: Int64;
begin
QueryPerformanceCounter(FTime);
FData := Format('Curr: %d; Main: %d; Low: %d; High: %d; Time: %d',
[GetCurrentThreadID, MainThreadID, TimerLowValue, TimerHighValue, FTime]);
if Assigned(Param) then
TListBox(Param).Items.Add(FData);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetTimerAPC(False);
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
FData: String;
begin
FData := Format('Curr: %d; Main: %d; Time: %d', [GetCurrentThreadID, MainThreadID, GetTickCount]);
if Assigned(Sender) then
TListBox(Sender).Items.Add(FData);
end;
procedure TForm1.SetTimerAPC(const Inner: Boolean);
var
FTime: TLargeInteger;
FPerid: Cardinal;
begin
FPerid := 1 * 10;
FTime := 1 * FPerid;
FTimer.SetTimer(FTime, FPerid, TimerAPCProc, ListBox1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FTimer.CancelTimer;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
FTimer := TWaitableTimer.Create();
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
FTimer.Free;
end;
end.