"Henry" <henry@nomail.com> skrev i en meddelelse
news:405db3cc$0$515$edfadb0f@dread14.news.tele.dk...
> Hej Harald
>
> Her er et eksempel på hvad jeg mener.
>
>
{---------------------------------------------------------------------------
> --
> Unit Name: thScheduler
> Author: HEN
> Purpose:
> History:
> --------------------------------------------------------------------------
--
> -}
> unit thScheduler;
> interface
>
> uses
> Classes, sysutils, controls, dialogs, windows, uAlarmData,
> uLocalVariables,
> uLocalFunctions, uGlobalVariables, uPrinterstuff, messages, extctrls;
>
> type
> TScheduleThr = class(TThread)
> private
> { Private declarations }
> hCaller : Thandle;
> hTimer : THandle;
> hTerminateScheduleThread : Thandle;
> lpDueTime: Int64; // dummy variable
> protected
> procedure Execute; override;
> Procedure Schedule;
> public
> constructor create(AhCaller : THandle);
> destructor Destroy; override;
> procedure StartPeriodicTimer(IntervalInSecs : Int64);
> procedure StopPeriodicTimer;
> procedure Terminate;
> end;
>
> implementation
>
>
{---------------------------------------------------------------------------
> --
> Procedure: TScheduleThr.create
> Author: HEN
> Date: 21-mar-2004
> Arguments: AhCaller : THandle
> Result: None
> --------------------------------------------------------------------------
--
> -}
> constructor TScheduleThr.create(AhCaller : THandle);
> begin
> try
> inherited create(true); // create suspended
> hCaller := AhCaller;
> FreeOnTerminate := false;
> hTimer := CreateWaitableTimer(nil, false, 'ScheduleTimer');
> hTerminateScheduleThread := CreateEvent(nil, false, false,
> 'TerminateScheduleThread');
> resume;
> except
> on e:exception do LogError(lcErrorEvents,format('Fejl under create
> scheduler %s',[e.message]));
> end;
> end;
>
>
>
{---------------------------------------------------------------------------
> --
> Procedure: TScheduleThr.Terminate
> Author: HEN
> Date: 21-mar-2004
> Arguments: None
> Result: None
> --------------------------------------------------------------------------
--
> -}
> procedure TScheduleThr.Terminate;
> begin
> // cancel the INFINITE waiting
> SetEvent(hTerminateScheduleThread);
> inherited Terminate;
> end;
>
>
>
{---------------------------------------------------------------------------
> --
> Procedure: TScheduleThr.StartPeriodicTimer
> Author: HEN
> Date: 21-mar-2004
> Arguments: IntervalInSecs : Int64
> Result: None
> --------------------------------------------------------------------------
--
> -}
> procedure TScheduleThr.StartPeriodicTimer(IntervalInSecs : Int64);
> begin
> LogError(lcThreadEvents,format('TScheduleThr.StartPeriodicTimer %d
> secs',[IntervalInSecs]));
> if IntervalInSecs = 0 then IntervalInSecs := 60;
> lpDueTime := -IntervalInSecs * 10000000; // Run at once
> SetWaitableTimer(hTimer, // handle to a timer object
> lpDueTime, // when timer will become signaled
> IntervalInSecs*1000, // periodic timer interval
> nil, // pointer to the completion routine
> nil, // data passed to the completion routine
> false // flag for resume state
> );
> end;
>
>
{---------------------------------------------------------------------------
> --
> Procedure: TScheduleThr.StopPeriodicTimer
> Author: HEN
> Date: 21-mar-2004
> Arguments: None
> Result: None
> --------------------------------------------------------------------------
--
> -}
> procedure TScheduleThr.StopPeriodicTimer;
> begin
> LogError(lcThreadEvents, 'TScheduleThr.StopPeriodicTimer');
> CancelWaitableTimer(hTimer);
> end;
>
>
{---------------------------------------------------------------------------
> --
> Procedure: TScheduleThr.Destroy
> Author: HEN
> Date: 21-mar-2004
> Arguments: None
> Result: None
> --------------------------------------------------------------------------
--
> -}
> destructor TScheduleThr.Destroy;
> begin
> try
> LogError(lcThreadEvents, 'TScheduleThr.Destroy');
> CancelWaitableTimer(hTimer);
> CloseHandle(hTimer);
> closeHandle(hTerminateScheduleThread);
> except
> on e:exception do LogError(lcErrorEvents,'TScheduleThr.destroy ' +
> e.message);
> end;
> end;
>
>
>
{---------------------------------------------------------------------------
> --
> Procedure: TScheduleThr.Schedule
> Author: HEN
> Date: 21-mar-2004
> Arguments: None
> Result: None
> --------------------------------------------------------------------------
--
> -}
> Procedure TScheduleThr.Schedule;
> var
> OldPrinter : string;
> adp, ae : boolean;
> OldPeriodOfDay : TPeriodOfDay;
> hArray : array[0..1] of thandle;
>
> begin
> try
> hArray[0] := hMutex;
> hArray[1] := hTerminateScheduleThread;
> LogError(lcThreadEvents,'TScheduleThr.Schedule Waiting for hMutex');
> case WaitForMultipleObjects(2,@hArray[0], false, INFINITE) of
> WAIT_OBJECT_0 :
> try
> LogError(lcThreadEvents,'TScheduleThr.Schedule got hMutex');
> if terminated then exit;
> postmessage(hCaller, WM_SCHEDULER_STARTED, 0, 0);
>
> // her har jeg haft kald til de egentlige procedure (fjernet)
> finally
> LogError(lcThreadEvents,'TScheduleThr.Schedule releasing
> hMutex');
> ReleaseMutex(hMutex);
> postmessage(hCaller, WM_SCHEDULER_DONE, 0, 0);
> end; // try
>
> end; // case WaitForSingleObject(hMutex, ) of
> except
> on e:exception do LogError(lcErrorEvents,
format('TScheduleThr.Schedule
> %s',[e.message]));
> end;
> end;
>
>
{---------------------------------------------------------------------------
> --
> Procedure: TScheduleThr.Execute
> Author: HEN
> Date: 21-mar-2004
> Arguments: None
> Result: None
> --------------------------------------------------------------------------
--
> -}
> procedure TScheduleThr.Execute;
> var
> hArray : Array[0..2] of THandle;
> begin
> try
>
> hArray[0] := hTimer; // En timer kan starte ekseveringen
> hArray[1] := hScheduleEvent; // Et event et andet sted i appl. kan
> starte ekseveringen
> hArray[2] := hTerminateScheduleThread; // Et kald til terminate, giver
> et event som afsluter execute
> LogError(lcThreadEvents, 'TScheduleThr.Execute waiting for events');
> while not terminated do
> begin
> case WaitForMultipleObjects(3, @hArray[0], false, INFINITE) of //
> trigger objects
> WAIT_OBJECT_0 : begin
> LogError(lcThreadEvents,'TScheduleThr.Execute hTimer
> received');
> if terminated then break;
> Schedule;
> end;
> WAIT_OBJECT_0 + 1 : begin
> LogError(lcThreadEvents,'TScheduleThr.Execute hScheduleEvent
> received');
> if terminated then break;
> Schedule;
> end; // WAIT_OBJECT_0 timer
>
> WAIT_OBJECT_0 + 2 : begin
> LogError(lcThreadEvents,'TScheduleThr.Execute
> hTerminateScheduleThread received');
> break;
> end;
> end; // case wait timer
> end; // while not terminated
> except
> on e:exception do LogError(lcErrorEvents,
> format('TAlarmScannerThr.Execute %s',[e.message]));
> end;
> end;
>
> end.
Hvis jeg vil bruge noget ligende i min TCP tråd er jeg nok nød til at
benytte en TCP komponent der kan give en event når der ankommer data, Indy
komponenten som jeg bruger nu har ikke andre muligheder end at polle (så hut
jeg kan se).
I min SQL tråd som ikke laver andet end at vente på besked fra MainFormkan
jeg bruge metoden, i øjeblikket benytter jeg SendThreadMessage fra MainForm
og polling metoden i tråden.
Jeg takker for et godt eksempel som jeg vil gemme og læse igennem mange
gange endnu indtil metoden er inde på rygraden
Mvh
HK