ScheduledFuture in Delphi?

[Apollonius]

Verwende den Windows Thread Pool: CreateTimerQueueTimer

[WorstNightmare]

Zitat von Apollonius:

Verwende den Windows Thread Pool: CreateTimerQueueTimer

Das sieht doch mal sauber aus. Ich habe mich mal dran versucht, allerdings wird OnTimer irgendwie nicht aufgerufen, stattdessen stürzt das Programm mit einem APPCRASH ab (keine Rückmeldung)

Delphi-Quellcode:

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.

Aufruf:

Delphi-Quellcode:

var
  S: TScheduler;
begin
  S := TScheduler.Create;
  S.AddSchedule(5000, procedure begin ShowMessage('test') end);
end;

Weiß jemand was falsch ist?

Edit: Es liegt am reference to proceudre, mache ich das ShowMessage direkt in OnTimer geht es.

[Apollonius]

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.

[WorstNightmare]

Zitat:

Ich kenne mich leider mit den Interna von den neuen Routinenreferenzen nicht aus

Hatte das eh nur aus Gemütlichkeit gemacht, wollte es dann in procedure of object umwandeln.

Hab es jetzt so:

Delphi-Quellcode:

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.

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
Und da geht wohl was schief, ich hab's mit Pointern nicht so besonders

[Apollonius]

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.

[WorstNightmare]

Zitat von Apollonius:

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.

Das hab ich mir auch schon gedacht, ich weiß nur nicht wann ich es sonst machen soll

Delphi-Quellcode:

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;

"Deleting a timer failed!" tritt auf.

[Apollonius]

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?

[WorstNightmare]

Hab es letztendlich so gelöst:

Delphi-Quellcode:

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.

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.
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!