使用 Thread 的 _TThreadTimer VCL 單元 |
|
Dalman
一般會員 發表:27 回覆:22 積分:24 註冊:2002-08-21 發送簡訊給我 |
【緣起】
‧之前小弟回答某位大大有關於 Thread 化的 Timer,今天就分享出來這個在客戶專案上實作並驗証無誤的 _TThreadTimer 單元。 【完整程式碼】
//【單元作用】使用Thread實做Timer計時器(仿Delphi TTimer物件)。 //【作者日期】Dalman, 1.0.0, 2002/10/05。 //【使用範例】 // uses _ThreadTimer, Dialogs; // //---- 寫好一個OnTimer事件處理函式 --------------------------------------- // procedure runTimeUpProcess(Sender: TObject) // begin // ShowMessage('I am here.'); // end; // //---- 建立並執行_TThreadTimer物件 --------------------------------------- // var // n: _TThreadTimer; // begin // n := _TThreadTimer.Create(); // n.Interval := 3 * 1000; //設定計時器時間間隔為3秒(預設值為1秒)。 // n.ThreadPriority := tpIdle; //設定Thread的執行優先順序(預設值為tpNormal,詳見Delphi TThread.Priority屬性線上說明)。 // n.OnTimer := runTimeUpProcess; //設定時間一到就執行的事件處理函式。 // n.Enabled := true; //立即啟用計時器。 // . // . // . // n.Free(); //若物件要被銷毀時,就釋放此物件。 // end; //---------------------------------------------------------------------------- unit _ThreadTimer; interface uses Windows, Messages, SysUtils, Classes; type //【自訂型別】使用Thread的計時器(仿Delphi TTimer物件)。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 _TThreadTimer = class(TObject) private gOnTimer : TNotifyEvent; //OnTimer事件變數。 gInterval: Integer; //觸發OnTimer事件的時間間隔,單位:千分之一秒。 gTimerThread: TThread; //_TTimerThread物件。 //----【內部函式群】------------------------------------------------------ procedure terminateThread(); procedure fireOnTimer(); //----【屬性存取函式群】-------------------------------------------------- function getEnabled(): Boolean; procedure setEnabled(vNewValue: Boolean); function getPriority(): TThreadPriority; procedure setPriority(vNewValue: TThreadPriority); public //----【公開屬性群】------------------------------------------------------ property Interval : Integer read gInterval write gInterval; //時間計時間隔,單位:千分之一秒。 property Enabled : Boolean read getEnabled write setEnabled; //啟用計時器狀態,{true→啟用|false→不啟用}。 property ThreadPriority: TThreadPriority read getPriority write setPriority; //Thread執行優先順序。 //----【公開事件群】------------------------------------------------------ property OnTimer: TNotifyEvent read gOnTimer write gOnTimer; //----【公開函式群】------------------------------------------------------ constructor Create(); virtual; destructor Destroy(); override; end; implementation const cstTimerInterval = 1000; //定義計時觸發時間間距,單位:千分之一秒。 type //【自訂型別】計時器Thread。 //【作者版本】Dalman, 2002/10/04, 1.0.0。 _TTimerThread_ = class(TThread) private gThreadTimer: _TThreadTimer; gEventObj: THandle; //聆聽事件的物件代碼。 protected procedure Execute(); override; public //----【公開函式群】------------------------------------------------------ constructor Create(vTimer: _TThreadTimer); overload; procedure SendSignaled(); end; //---------------------------------------------------------------------------- //【函式作用】設定讓Thread立即收到所等待的事件訊號。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/06, 1.0.1。 procedure _TTimerThread_.SendSignaled(); begin try if gEventObj <> 0 then SetEvent(gEventObj); except on e: Exception do; //ignore errors. end; end; //---------------------------------------------------------------------------- //【函式作用】TTimerThread執行內容。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 procedure _TTimerThread_.Execute(); begin gEventObj := CreateEvent(nil, false, false, nil); //建立一個聆聽事件的物件。 with gThreadTimer do begin while not Terminated do begin if WaitForSingleObject(gEventObj, Interval) = WAIT_TIMEOUT then begin Synchronize(fireOnTimer); end; end; end; CloseHandle(gEventObj); end; //---------------------------------------------------------------------------- //【函式作用】物件建構函式。 //【輸入引數】 // vTimer _TThreadTimer物件。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 constructor _TTimerThread_.Create(vTimer: _TThreadTimer); begin inherited Create(true); gEventObj := 0; gThreadTimer := vTimer; FreeOnTerminate := false; end; //---------------------------------------------------------------------------- //【屬性作用】設定是否啟動計時器。 //【屬性型別】Boolean,{true→啟動|false→停止}。 //【讀寫性質】Read/Write。 //【作者版本】Dalman, 2002/10/23, 1.0.1。 function _TThreadTimer.getEnabled(): Boolean; begin result := not gTimerThread.Suspended; end; procedure _TThreadTimer.setEnabled(vNewValue: Boolean); begin gTimerThread.Suspended := not vNewValue; end; //---------------------------------------------------------------------------- //【屬性作用】設定Thread執行優先次序。 //【屬性型別】TThreadPriority。 //【讀寫性質】Read/Write。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 function _TThreadTimer.getPriority(): TThreadPriority; begin result := gTimerThread.Priority; end; procedure _TThreadTimer.setPriority(vNewValue: TThreadPriority); begin gTimerThread.Priority := vNewValue; end; //---------------------------------------------------------------------------- //【函式作用】觸發OnTimer事件。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 procedure _TThreadTimer.fireOnTimer(); begin if Assigned(gOnTimer) then OnTimer(self); end; //---------------------------------------------------------------------------- //【函式作用】銷毀Thread物件。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/06, 1.0.2。 procedure _TThreadTimer.terminateThread(); begin if gTimerThread <> nil then begin with _TTimerThread_(gTimerThread) do begin Terminate(); if Suspended then Resume(); SendSignaled(); WaitFor(); end; FreeAndNil(_TTimerThread_(gTimerThread)); end; end; //---------------------------------------------------------------------------- //【函式作用】物件建構函式。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 constructor _TThreadTimer.Create(); begin inherited; gOnTimer := nil; gInterval := cstTimerInterval; gTimerThread := _TTimerThread_.Create(self); ThreadPriority := tpNormal; Enabled := false; end; //---------------------------------------------------------------------------- //【函式作用】物件卸構函式。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 destructor _TThreadTimer.Destroy(); begin terminateThread(); inherited; end; end. |
dw1112
一般會員 發表:8 回覆:9 積分:3 註冊:2009-06-16 發送簡訊給我 |
Hi,
How to add to my program ? code shown as follows: unit unit_Security; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, NoxTimerAppApis, ExtCtrls, Math; type Tfrm_Security = class(TForm) Button_Fail: TButton; Panel1: TPanel; ListBox: TListBox; Panel2: TPanel; display_message: TLabel; Button_OK: TButton; Timer1: TTimer; Label1: TLabel; Label2: TLabel; Label3: TLabel; procedure Button_FailClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure Button_OKClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } Rtn:Integer; //函數返回值 KeyHandle:array [0..7] of Integer; KeyNumber:Integer; procedure ListMSG(S:String); //LISTBOX INSERT procedure RtnMSG(sTrue,sFalse:String); procedure Check_USBKey(); function Generate_Random_number(): String; function StringToPAnsiChar(stringVar : string) : PAnsiChar; public { Public declarations } class function Execute : boolean; end; var frm_Security: Tfrm_Security; mem_RandomPassword: String; StorageBuffer:array [0..16] of AnsiChar; //掉電保持區資料 MemBuffer:array [0..7] of AnsiChar; //記憶體區資料 uPin:array [0..32] of AnsiChar; //用戶密碼 APPID:Integer; //應用程式標識 GUID:array [0..32] of AnsiChar; //硬體唯一ID year,month,day,hour,minute:Integer; TimeMode:Integer; //時鐘模式 CountMode:Integer; //次數模式 Remain,nMax:Integer; implementation var var_USBOK_item1, var_USBOK_item2, var_USBOK_item3, var_USBOK_item4, var_USBOK_item5, var_USBOK_item6, var_USBOK_item7, var_USBOK_item8, var_USBOK_item9 : Boolean; //Indicate any error for valiate USB Key {$R *.dfm} procedure Tfrm_Security.ListMSG(S: String); begin ListBox.Items.Add(FormatDateTime('tt',now) ': ' S); end; procedure Tfrm_Security.RtnMSG(sTrue, sFalse: String); begin if Rtn=0 then ListMSG(sTrue) else ListMSG(sFalse ' 錯誤碼: ' IntToStr(NoxTimerAppApis.NoxGetLastError())); end; procedure Tfrm_Security.Button_FailClick(Sender: TObject); begin ModalResult := mrAbort; end; class function Tfrm_Security.Execute: boolean; begin with Tfrm_Security.Create(nil) do try Result := ShowModal = mrOk; finally Free; end; end; procedure Tfrm_Security.FormShow(Sender: TObject); begin mem_RandomPassword := Generate_Random_number(); Check_USBKey(); Timer1.Interval := 10000; // 30 seconds Timer1.Enabled := True; end; procedure Tfrm_Security.Button_OKClick(Sender: TObject); begin ModalResult := mrOK; end; procedure Tfrm_Security.Check_USBKey(); { var StorageBuffer:array [0..16] of AnsiChar; //掉電保持區資料 MemBuffer:array [0..7] of AnsiChar; //記憶體區資料 uPin:array [0..32] of AnsiChar; //用戶密碼 APPID:Integer; //應用程式標識 GUID:array [0..32] of AnsiChar; //硬體唯一ID year,month,day,hour,minute:Integer; TimeMode:Integer; //時鐘模式 CountMode:Integer; //次數模式 Remain,nMax:Integer; } begin ListBox.Items.Clear; //查找加密鎖 APPID:=StrToInt('0xA008128C'); //應用程式標識,通過設號工具設置 Rtn:=NoxFind(APPID,@KeyHandle,@KeyNumber); if Rtn = 0 then var_USBOK_item1 := True else var_USBOK_item1 := False; RtnMSG('找到『' IntToStr(KeyNumber) '』只加密鎖! (成功!)','查找加密鎖失敗,請連接加密鎖! (失敗!)'); //獲取GUID Rtn:=NoxGetuid(keyHandle[0],@GUID); if Rtn = 0 then var_USBOK_item2 := True else var_USBOK_item2 := False; RtnMSG('GUID: ' GUID ' (成功!)','獲取失敗' ' (失敗!)'); //打開加密鎖 uPin:='1248f4a7e6ba3201'; // 用戶密碼,通過設號工具設置 Rtn:=NoxOpen(KeyHandle[0],uPin); if Rtn = 0 then var_USBOK_item3 := True else var_USBOK_item3 := False; RtnMSG('打開加密鎖成功!' ' (成功!)','打開加密鎖失敗!' ' (失敗!)' ); //讀取掉電保持區資料 Rtn:=NoxReadStorage(KeyHandle[0],StorageBuffer); if Rtn = 0 then var_USBOK_item4 := True else var_USBOK_item4 := False; RtnMSG('讀取掉電保持區資料:' StorageBuffer ' (成功!)','讀取掉電保持區資料失敗' ' (失敗!)' ); //寫入記憶體區資料 //Rtn:= NoxWriteMem(KeyHandle[0],PAnsiChar( @mem_RandomPassword )); Rtn:= NoxWriteMem(KeyHandle[0], StringToPAnsiChar(mem_RandomPassword) ); if Rtn = 0 then var_USBOK_item5 := True else var_USBOK_item5 := False; RtnMSG('寫入隨機密碼於暫存記憶體' ' (成功!)','寫入記憶體資料失敗' ' (失敗!)' ); //讀取記憶體區資料 Rtn:= NoxReadMem(KeyHandle[0],@MemBuffer); if Rtn = 0 then var_USBOK_item6 := True else var_USBOK_item6 := False; RtnMSG('讀取隨機密碼於暫存記憶體區資料:' MemBuffer ' (成功!)','讀取記憶體區資料失敗' ' (失敗!)' ); //如果設置了時鐘,可調用NoxGetExpiryDateTime獲取失效時間 //獲取失效時間 Rtn:=NoxGetExpiryDateTime(keyHandle[0],@TimeMode,@year,@month,@day,@hour,@minute); if Rtn = 0 then var_USBOK_item7 := True else var_USBOK_item7 := False; RtnMSG('時間模式:' IntToStr(TimeMode) '失效時間:' IntToStr(year) '年' IntToStr(month) '月' IntToStr(day) '日' IntToStr(hour) '時' IntToStr(minute) '分' ' (成功!)', '無法獲取失效時間' ' (失敗!)' ); //如果設置了次數,可調用NoxGetRemnantCount獲取失效次數 //獲取失效次數 Rtn:=NoxTimerAppApis.NoxGetRemnantCount(keyHandle[0],@Remain,@nMax,@CountMode); if Rtn = 0 then var_USBOK_item8 := True else var_USBOK_item8 := False; self.RtnMSG('次數模式:' IntToStr(CountMode) ' 剩餘運行次數:' IntToStr(Remain) ' 最大運行次數:' IntToStr(nMax) ' (成功!)','無法獲取使用次數' ' (失敗!)' ); //關閉加密鎖 Rtn:=NoxClose(KeyHandle[0]); if Rtn = 0 then var_USBOK_item9 := True else var_USBOK_item9 := False; RtnMSG('關閉加密鎖成功' ' (成功!)','關閉加密鎖失敗' ' (失敗!)' ); if var_USBOK_item1 and var_USBOK_item2 and var_USBOK_item3 and var_USBOK_item4 and var_USBOK_item5 and var_USBOK_item6 and var_USBOK_item7 and var_USBOK_item8 and var_USBOK_item9 then begin display_message.Caption := '驗証成功!'; display_message.Font.Color := clBlue; Button_OK.Visible := True; Button_Fail.Visible := False; Timer1.Enabled := True; // If check ok, Timer will enable in order to check Key exists or not per 30 seconds end else begin display_message.Caption := '驗証失敗! 請檢查"加密鎖"是否插上。'; display_message.Font.Color := clRed; Button_OK.Visible := False; Button_Fail.Visible := True; Timer1.Enabled := False; end; end; function Tfrm_Security.Generate_Random_number():String; begin Randomize; Result := IntToStr( Random(99999999)); end; function Tfrm_Security.StringToPAnsiChar(stringVar : string) : PAnsiChar; Var AnsString : AnsiString; InternalError : Boolean; begin InternalError := false; Result := ''; try if stringVar <> '' Then begin AnsString := AnsiString(StringVar); Result := PAnsiChar(PAnsiString(AnsString)); end; Except InternalError := true; end; if InternalError or (String(Result) <> stringVar) then begin Raise Exception.Create('Conversion from string to PAnsiChar failed!'); end; end; procedure Tfrm_Security.Timer1Timer(Sender: TObject); begin //查找加密鎖 APPID:=StrToInt('0xA008128C'); //應用程式標識,通過設號工具設置 Rtn:=NoxFind(APPID,@KeyHandle,@KeyNumber); //獲取GUID Rtn:=NoxGetuid(keyHandle[0],@GUID); //打開加密鎖 uPin:='1248f4a7e6ba3201'; // 用戶密碼,通過設號工具設置 Rtn:=NoxOpen(KeyHandle[0],uPin); //讀取記憶體區資料 Rtn:= NoxReadMem(KeyHandle[0],@MemBuffer); if Rtn = 0 then Label1.Caption := '讀取隨機密碼於暫存記憶體區資料 (成功!)' else Label1.Caption := '讀取記憶體區資料失敗 (失敗!)'; //關閉加密鎖 Rtn:=NoxClose(KeyHandle[0]); Label2.Caption := TimeToStr(time()) ' ------- ' IntToStr(Rtn); if MemBuffer = mem_RandomPassword then Label3.Caption := 'Equal' else begin Label3.Caption := 'NOT Equal'; MessageDLG('Error !', mtError, [mbOK], 0); end; end; end. ===================引 用 Dalman 文 章=================== 【緣起】 ‧之前小弟回答某位大大有關於 Thread 化的 Timer,今天就分享出來這個在客戶專案上實作並驗証無誤的 _TThreadTimer 單元。 【完整程式碼】 //【單元作用】使用Thread實做Timer計時器(仿Delphi TTimer物件)。 //【作者日期】Dalman, 1.0.0, 2002/10/05。 //【使用範例】 // uses _ThreadTimer, Dialogs; // //---- 寫好一個OnTimer事件處理函式 --------------------------------------- // procedure runTimeUpProcess(Sender: TObject) // begin // ShowMessage('I am here.'); // end; // //---- 建立並執行_TThreadTimer物件 --------------------------------------- // var // n: _TThreadTimer; // begin // n := _TThreadTimer.Create(); // n.Interval := 3 * 1000; //設定計時器時間間隔為3秒(預設值為1秒)。 // n.ThreadPriority := tpIdle; //設定Thread的執行優先順序(預設值為tpNormal,詳見Delphi TThread.Priority屬性線上說明)。 // n.OnTimer := runTimeUpProcess; //設定時間一到就執行的事件處理函式。 // n.Enabled := true; //立即啟用計時器。 // . // . // . // n.Free(); //若物件要被銷毀時,就釋放此物件。 // end; //---------------------------------------------------------------------------- unit _ThreadTimer; interface uses Windows, Messages, SysUtils, Classes; type //【自訂型別】使用Thread的計時器(仿Delphi TTimer物件)。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 _TThreadTimer = class(TObject) private gOnTimer : TNotifyEvent; //OnTimer事件變數。 gInterval: Integer; //觸發OnTimer事件的時間間隔,單位:千分之一秒。 gTimerThread: TThread; //_TTimerThread物件。 //----【內部函式群】------------------------------------------------------ procedure terminateThread(); procedure fireOnTimer(); //----【屬性存取函式群】-------------------------------------------------- function getEnabled(): Boolean; procedure setEnabled(vNewValue: Boolean); function getPriority(): TThreadPriority; procedure setPriority(vNewValue: TThreadPriority); public //----【公開屬性群】------------------------------------------------------ property Interval : Integer read gInterval write gInterval; //時間計時間隔,單位:千分之一秒。 property Enabled : Boolean read getEnabled write setEnabled; //啟用計時器狀態,{true→啟用|false→不啟用}。 property ThreadPriority: TThreadPriority read getPriority write setPriority; //Thread執行優先順序。 //----【公開事件群】------------------------------------------------------ property OnTimer: TNotifyEvent read gOnTimer write gOnTimer; //----【公開函式群】------------------------------------------------------ constructor Create(); virtual; destructor Destroy(); override; end; implementation const cstTimerInterval = 1000; //定義計時觸發時間間距,單位:千分之一秒。 type //【自訂型別】計時器Thread。 //【作者版本】Dalman, 2002/10/04, 1.0.0。 _TTimerThread_ = class(TThread) private gThreadTimer: _TThreadTimer; gEventObj: THandle; //聆聽事件的物件代碼。 protected procedure Execute(); override; public //----【公開函式群】------------------------------------------------------ constructor Create(vTimer: _TThreadTimer); overload; procedure SendSignaled(); end; //---------------------------------------------------------------------------- //【函式作用】設定讓Thread立即收到所等待的事件訊號。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/06, 1.0.1。 procedure _TTimerThread_.SendSignaled(); begin try if gEventObj <> 0 then SetEvent(gEventObj); except on e: Exception do; //ignore errors. end; end; //---------------------------------------------------------------------------- //【函式作用】TTimerThread執行內容。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 procedure _TTimerThread_.Execute(); begin gEventObj := CreateEvent(nil, false, false, nil); //建立一個聆聽事件的物件。 with gThreadTimer do begin while not Terminated do begin if WaitForSingleObject(gEventObj, Interval) = WAIT_TIMEOUT then begin Synchronize(fireOnTimer); end; end; end; CloseHandle(gEventObj); end; //---------------------------------------------------------------------------- //【函式作用】物件建構函式。 //【輸入引數】 // vTimer _TThreadTimer物件。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 constructor _TTimerThread_.Create(vTimer: _TThreadTimer); begin inherited Create(true); gEventObj := 0; gThreadTimer := vTimer; FreeOnTerminate := false; end; //---------------------------------------------------------------------------- //【屬性作用】設定是否啟動計時器。 //【屬性型別】Boolean,{true→啟動|false→停止}。 //【讀寫性質】Read/Write。 //【作者版本】Dalman, 2002/10/23, 1.0.1。 function _TThreadTimer.getEnabled(): Boolean; begin result := not gTimerThread.Suspended; end; procedure _TThreadTimer.setEnabled(vNewValue: Boolean); begin gTimerThread.Suspended := not vNewValue; end; //---------------------------------------------------------------------------- //【屬性作用】設定Thread執行優先次序。 //【屬性型別】TThreadPriority。 //【讀寫性質】Read/Write。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 function _TThreadTimer.getPriority(): TThreadPriority; begin result := gTimerThread.Priority; end; procedure _TThreadTimer.setPriority(vNewValue: TThreadPriority); begin gTimerThread.Priority := vNewValue; end; //---------------------------------------------------------------------------- //【函式作用】觸發OnTimer事件。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 procedure _TThreadTimer.fireOnTimer(); begin if Assigned(gOnTimer) then OnTimer(self); end; //---------------------------------------------------------------------------- //【函式作用】銷毀Thread物件。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/06, 1.0.2。 procedure _TThreadTimer.terminateThread(); begin if gTimerThread <> nil then begin with _TTimerThread_(gTimerThread) do begin Terminate(); if Suspended then Resume(); SendSignaled(); WaitFor(); end; FreeAndNil(_TTimerThread_(gTimerThread)); end; end; //---------------------------------------------------------------------------- //【函式作用】物件建構函式。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 constructor _TThreadTimer.Create(); begin inherited; gOnTimer := nil; gInterval := cstTimerInterval; gTimerThread := _TTimerThread_.Create(self); ThreadPriority := tpNormal; Enabled := false; end; //---------------------------------------------------------------------------- //【函式作用】物件卸構函式。 //【輸入引數】無。 //【函式傳回】無。 //【作者版本】Dalman, 2002/10/05, 1.0.0。 destructor _TThreadTimer.Destroy(); begin terminateThread(); inherited; end; end. |
GrandRURU
站務副站長 發表:240 回覆:1680 積分:1874 註冊:2005-06-21 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |