Re: ScheduledFuture in Delphi?
Verwende den Windows Thread Pool: CreateTimerQueueTimer
|
Re: ScheduledFuture in Delphi?
Zitat:
Delphi-Quellcode:
Aufruf:
unit Scheduler;
interface uses Windows; type TSchedule = reference to procedure; TScheduler = class private FQueue: THandle; public constructor Create; destructor Destroy; override; procedure AddSchedule(Milliseconds: Cardinal; Proc: TSchedule); end; implementation { TScheduler } constructor TScheduler.Create; begin FQueue := CreateTimerQueue; end; destructor TScheduler.Destroy; begin DeleteTimerQueue(FQueue); inherited; end; procedure OnTimer(Context: Pointer; Success: Boolean); stdcall; var Proc: TSchedule; begin Proc := TSchedule(Context); Proc; end; procedure TScheduler.AddSchedule(Milliseconds: Cardinal; Proc: TSchedule); var Timer: THandle; begin CreateTimerQueueTimer(Timer, FQueue, OnTimer, @Proc, Milliseconds, 0, WT_EXECUTEONLYONCE); end; end.
Delphi-Quellcode:
Weiß jemand was falsch ist?
var
S: TScheduler; begin S := TScheduler.Create; S.AddSchedule(5000, procedure begin ShowMessage('test') end); end; Edit: Es liegt am reference to proceudre, mache ich das ShowMessage direkt in OnTimer geht es. |
Re: ScheduledFuture in Delphi?
Die Übergabe des Kontext-Parameter wird mit dem Pointer nicht funktionieren, da Proc auf dem Stack liegt. Ich kenne mich leider mit den Interna von den neuen Routinenreferenzen nicht aus, meine mich jedoch zu erinnern, dass es sich um Interfaces handelt. In diesem Fall müsstest du Pointer(Proc) übergeben und zusätzlich noch auf die Referenzzählung achten. In jedem Fall auf der sicheren Seite bist du, wenn du mit New einen PSchedule allozierst, ihn mit Proc befüllst und dem Thread übergibst, welcher ihn am Ende freigibt.
|
Re: ScheduledFuture in Delphi?
Zitat:
Hab es jetzt so:
Delphi-Quellcode:
Die Funktion des Schedulers an sich funktioniert jetzt, die Message erscheint. Allerdings wollte ich danach gerne auch aufräumen und DeleteTimerQueueTimer aufrufen, dafür brauche ich aber ein paar Parameter die ich irgendwie noch da rein kriegen musste :angel2:
unit Scheduler;
interface uses Windows, SysUtils; type TSchedule = procedure of object; TDescriptor = record Proc: TSchedule; Queue: THandle; Timer: PHandle; end; PDescriptor = ^TDescriptor; TScheduler = class private FQueue: THandle; public constructor Create; destructor Destroy; override; procedure AddSchedule(Milliseconds: Cardinal; Proc: TSchedule); end; implementation { TScheduler } constructor TScheduler.Create; begin FQueue := CreateTimerQueue; end; destructor TScheduler.Destroy; begin DeleteTimerQueue(FQueue); inherited; end; procedure OnTimer(Context: Pointer; Success: Boolean); stdcall; begin PDescriptor(Context)^.Proc; DeleteTimerQueueTimer(PDescriptor(Context)^.Queue, Cardinal(PDescriptor(Context)^.Timer^), INVALID_HANDLE_VALUE); Dispose(Context); end; procedure TScheduler.AddSchedule(Milliseconds: Cardinal; Proc: TSchedule); var Timer: THandle; PDesc: PDescriptor; begin New(PDesc); PDesc^.Proc := Proc; PDesc^.Queue := FQueue; PDesc^.Timer := @Timer; if not CreateTimerQueueTimer(Timer, FQueue, OnTimer, PDesc, Milliseconds, 0, WT_EXECUTEONLYONCE) then raise Exception.Create('Creating a timer failed!'); end; end. Und da geht wohl was schief, ich hab's mit Pointern nicht so besonders :| |
Re: ScheduledFuture in Delphi?
Es gibt keinen Grund, einen Zeiger auf das Timer-Handle in TDescriptor zu speichern. Nimm das Handle selbst.
Der letzte Parameter von DeleteTimerQueueTimer sollte wahrscheinlich 0 sein, INVALID_HANDLE_VALUE blockiert. Auf der anderen Seite weiß ich nicht, ob man aus dem Callback überhaupt seinen eigenen Timer löschen kann. |
Re: ScheduledFuture in Delphi?
Zitat:
Delphi-Quellcode:
"Deleting a timer failed!" tritt auf.
procedure OnTimer(Context: Pointer; Success: Boolean); stdcall;
begin PDescriptor(Context)^.Proc; try if not DeleteTimerQueueTimer(PDescriptor(Context)^.Queue, PDescriptor(Context)^.Timer, 0) then raise Exception.Create('Deleting a timer failed!'); finally Dispose(Context); end; end; procedure TScheduler.AddSchedule(Milliseconds: Cardinal; Proc: TSchedule); var Timer: THandle; PDesc: PDescriptor; begin New(PDesc); PDesc^.Proc := Proc; PDesc^.Queue := FQueue; if not CreateTimerQueueTimer(Timer, FQueue, OnTimer, PDesc, Milliseconds, 0, WT_EXECUTEONLYONCE) then raise Exception.Create('Creating a timer failed!'); PDesc^.Timer := Timer; end; |
Re: ScheduledFuture in Delphi?
Igitt, diese Race Condition mit Timer = 0 habe ich glatt übersehen. Sie sollte sich allerdings durch Pollen in OnTimer beheben lassen. Was sagt eigentlich GetLastError?
|
Re: ScheduledFuture in Delphi?
Hab es letztendlich so gelöst:
Delphi-Quellcode:
Ich denke, den Timer während OnTimer ausgeführt wird zu terminieren wird einfach nicht möglich sein. So ist es nicht soo toll, beendet aber zumindestens die meisten der fertigen Timer-Threads.
unit Scheduler;
interface uses Windows, SysUtils, Generics.Collections; type TSchedule = procedure of object; TScheduler = class; TDescriptor = record Proc: TSchedule; Timer: THandle; Sched: TScheduler; end; PDescriptor = ^TDescriptor; TScheduler = class private FQueue: THandle; FRems: TList<THandle>; procedure RemoveInactiveTimers; public constructor Create; destructor Destroy; override; procedure AddSchedule(Milliseconds: Cardinal; Proc: TSchedule); procedure SetTimerRemovable(Timer: THandle); end; implementation { TScheduler } constructor TScheduler.Create; begin FQueue := CreateTimerQueue; FRems := TList<THandle>.Create; end; destructor TScheduler.Destroy; begin RemoveInactiveTimers; DeleteTimerQueue(FQueue); FRems.Free; inherited; end; procedure OnTimer(Context: Pointer; Success: Boolean); stdcall; begin try PDescriptor(Context)^.Proc; PDescriptor(Context)^.Sched.SetTimerRemovable(PDescriptor(Context)^.Timer); finally Dispose(Context); end; end; procedure TScheduler.SetTimerRemovable(Timer: THandle); begin FRems.Add(Timer); end; procedure TScheduler.AddSchedule(Milliseconds: Cardinal; Proc: TSchedule); var Timer: THandle; PDesc: PDescriptor; begin RemoveInactiveTimers; New(PDesc); PDesc^.Proc := Proc; PDesc^.Sched := Self; if not CreateTimerQueueTimer(Timer, FQueue, OnTimer, PDesc, Milliseconds, 0, WT_EXECUTEONLYONCE) then raise Exception.Create('Creating a timer failed!'); PDesc^.Timer := Timer; end; procedure TScheduler.RemoveInactiveTimers; var i: Integer; begin for i := 0 to FRems.Count - 1 do if not DeleteTimerQueueTimer(FQueue, FRems[i], 0) then raise Exception.Create('Deleting a timer failed!'); FRems.Clear; end; end. Vielleicht muss ich noch irgendwo eine CriticalSection wegen dem RemoveInactive einführen (weil auf die Liste theoretisch ja gleichzeitig zugegriffen werden kann), aber ansonsten ist das Teil ziemlich fertig :) Danke für die Hilfe! :dp: |
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:41 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz