定时器的使用 之 SetWaitableTimer

使用SetWaitableTimer做定时器，可以精确到100纳秒，关键是可以线程执行，简单的封装了个Delphi类，方便使用，源代码如下

{******************************************************************************}{ @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;interfaceuses 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;implementationtype 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;interfaceuses 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.