Timer in Thread führt OnTime nicht aus...

[Jens Schumann]

Hallo,
hatte ungefähr 10 Minuten das gleiche Problem. Auf der Suche nach einer Lösung bei ich folgendeSeite gefunden.
Da TTimer AllocateHWND verwendet habe ich nicht weiter gesucht und mich für eine Threadlösung entschieden.

Delphi-Quellcode:

unit hyps_ServerTimerThread_impl;

interface

uses
  Windows, Messages, Classes;

const

  PM_TIMERTHREAD_EVENT = WM_APP+10002;

type

  TTimerThread = class(TThread)
  private
    { Private-Deklarationen }
    FSinkThreadID : THandle;
    FInterval     : DWord;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    property Interval     : DWord read FInterval write FInterval;
    property SinkThreadID : THandle read FSinkThreadID write FSinkThreadID;
  end;

implementation


{ TimerThread }

constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
  FInterval:=5000;
  inherited Create(CreateSuspended);
  FreeOnTerminate:=True;
end;

procedure TTimerThread.Execute;
begin
  While Not Terminated do
    begin
    Sleep(FInterval);
    If (FSinkThreadID<>0) then
      PostThreadMessage(FSinkThreadID,PM_TIMERTHREAD_EVENT,0,0);
    end;
end;

end.

Die Genuigkeit bei der Einhaltung des Intervals ist für mich völlig uninteressant.
Hauptsache es wird mehr oder weniger periodisch aufgerufen.

Delphi-Quellcode:

  THypsClientThread = Class(TServerClientThread)
  private
    ...
    FUploadTimer        : TTimerThread;

constructor THypsClientThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
begin
  FClientStream:=TMemoryStreamExt.Create;
  FUploadTimer:=TTimerThread.Create(True);
  inherited Create(CreateSuspended, ASocket);
  FUploadTimer.SinkThreadID:=ThreadID;
end;

procedure THypsClientThread.ClientExecute;
var
  Msg               : tagMsg;
begin
  ...
        If PeekMessage(Msg, 0, PM_TIMERTHREAD_EVENT, PM_TIMERTHREAD_EVENT, PM_REMOVE) then
          begin
          If Msg.message=PM_TIMERTHREAD_EVENT then
            UploadTimerEvent;
          end;
  ...
end;

Funktionsweise:
THypsClientThread erzeugt im Create den TTimerThread. an TTimerThread wird die ThreadID von THypsClientThread übergeben.
Der TTimerThread wird über Resume und Suspend aktiviert. Wenn der TTimerThread aktiviert ist wird über PostThreadMessage
über die THypsClientThread.ThreadID eine Botschaft an THypsClientThread gesendet. In THypsClientThread wird beim Empfang
der Botschaft die Methode UploadTimerEvent aufgerufen. Funktioniert prima.

Jetzt Frage: Ist die Sache threadsafe?