Die Klasse TSleepingThread ist ein besonders fauler Geselle.
Der Thread arbeitet nur, wenn man ihn von Aussen gezielt aufweckt.
Sobald er seine Arbeit getan hat (procedure DoWork; ) legt er sich wieder schlafen.
Ob der Thread gerade am arbeiten ist lässt sich über das Propery Busy abfragen.

zusammenfalten · markieren

Delphi-Quellcode:

TSleepingThread = class(TThread)
private
  FEvent : TSimpleEvent;
  FBusy : Boolean;
protected
  procedure Execute;override;
  procedure DoTerminate;override;
  procedure DoWork;virtual;abstract;
public
  constructor Create(CreateSuspended: Boolean);
  destructor Destroy; override;
  procedure WakeUp;
  property Busy:Boolean read FBusy;
end;

Um die Klasse zu benützen muss man von TSleepingThread ableiten und die Methode DoWork überschreiben.

Mit Hilfe der Klasse TSimpleEvent legt sich der Thread selbst schlafen um dann über die WakeUp Methode aufgeweckt zu werden.
Im Anhang befindet sich ein Demo, das die Arbeitsweise zeigt.

Hi

Ich habe zwei Anmerkungen?
1. Warum muss der Thread jede Sekunde arbeiten (er stellt ja bei wrTimeOut nur fest ob er terminiert wurde)

2. Machst du einen Fehler weswegen du auf 1. nicht verzichten kannst. Du überschreibst DoTerminate anstatt Terminate. Nimm mal letzteres, dann kannst du auch mit infinite auf dein SimpleEvent warten.


mfg

Zitat von sirius:

... Du überschreibst DoTerminate anstatt Terminate...

Ich hatte da schon so ein Bauchgefühl, dass das nicht so ganz passt.
Bei Delphi 5 ist Terminate nicht virtuell und kann daher nicht überschrieben, sondern nur verdeckt werden.
Deshalb lass ich den Thread jede Sekunde einmal aufwachen, damit er prüfen kann ob er terminiert wurde.

Falls Terminate in neueren Delphi Versionen virtuell ist, könnte man natürlich per bedingter Compilierung deinen Vorschlag umsetzen.

Zitat von shmia:

Falls Terminate in neueren Delphi Versionen virtuell ist, könnte man natürlich per bedingter Compilierung deinen Vorschlag umsetzen.

Terminate ist nicht virtuell (in D7 nicht und IMHO nicht in D2006 und sicherlich auch nicht später, außer man hat die ganze Klasse umgekrempelt) Terminate muss auch nicht virtuell sein. Weil Terminate wird von TThread selber ja nie aufgerufen, sondern nur von außen. Wenn ich oben "überschreiben" schrieb, meine ich bei Terminate natürlich verdecken. Und scheue dich nicht davor das zu tun:

zusammenfalten · markieren

Delphi-Quellcode:

TSleepingThread = class(TThread)
 private
   FEvent : TSimpleEvent;
   FBusy : Boolean;
 protected
   procedure Execute;override;
   //procedure DoTerminate;override; weg damit
   procedure DoWork;virtual;abstract;
 public
   constructor Create(CreateSuspended: Boolean);
   destructor Destroy; override;
   procedure WakeUp;
   property Busy:Boolean read FBusy;
   procedure Terminate; //neu
 end;

Und jetzt schieb den Code aus DoTerminate exakt so nach Terminate! Ersetze die 1000 mit inifinte und dann funktioniert es auch.
Teste es einfach mal! Und scheue Dich nicht davor auch mal Methoden zu verdecken.


DoTerminate ist übrigens völlig falsch, denn DoTerminate wird erst aufgerufen, wenn der Thread schon beendet ist. Du weißt bestimmt auch, dass in der VCL die DoXXXXX-Methode nur dafür da sind die "onXXXXX" -Events zu feuern. Also DoTerminate wird nur benutzt um onTerminate zu feuern. Und das ist ja bekanntlich erst nach Threadende dran. Deswegen: Nimm das weg, mach das weg

Methoden nur zu verdecken führt schnell mal zu Problemen.

Denn was mag wohl passieren, wenn ich den TSleepingThread in einer TThread-Variable verwalte?

Zitat von himitsu:

Methoden nur zu verdecken führt schnell mal zu Problemen.

Denn was mag wohl passieren, wenn ich den TSleepingThread in einer TThread-Variable verwalte?

Und was schlägst du vor? VCL umschreiben?

Ja?

Nee, aber man sollte schon aufpassen, daß man dort keinen wichtigen Code reinmacht.
Fehlernde/ungenügende Schnittstellen sind leider immer wieder ein schwerwiegendes Problem.

Zitat von sirius:

Weil Terminate wird von TThread selber ja nie aufgerufen, sondern nur von außen.

Leider doch:

zusammenfalten · markieren

Delphi-Quellcode:

destructor TThread.Destroy;
begin
  if not FFinished and not Suspended then
  begin
    Terminate; // <===
    WaitFor;
  end;
  if FHandle <> 0 then CloseHandle(FHandle);
  inherited Destroy;
  RemoveThread;
end;

Der Aufruf in DoTerminate ist sicher falsch, weil zu spät im Ablauf.
Aber da Terminate nicht virtuell ist, kann man sich nicht drauf verlassen dass die Methode aufgerufen wird.

markieren

Delphi-Quellcode:

var
  test : TThread;
begin
  test := TMyThread.Create(False);
  test.free; // Thread bleibt "hängen"

Ich habe jetzt die Vorschläge umgesetzt, den Destruktor angepasst und den Timeout auf 20s gesetzt.

Ui, das ist mir noch nie aufgefallen. Ich verwende das so ständig, rufe aber eben immer ordnungsgemäß terminate auf bevor ich das Objekt zerstöre.

Dann weiß ich auch nicht weiter. Außer dass man das dann sauber programmieren muss. Oder du nimmst halt weiter deine sekündliche Unterbrechung (was ich nie bevorzugen würde). Oder wir ändern dieses sch***** TErminate einfach in virtuell um. So.

Irgendwie gefällt mir das auch alles nicht, wieso z.b. das ResetEvent vor DoWork? Ausserdem wird as FEvent zu spaet erzeugt.

wie wärs mit:

zusammenfalten · markieren

Delphi-Quellcode:

type
  TSleepingThread = class(TThread)
  protected
    FEvent: TEvent;
    FBusy: Boolean;
    procedure Execute; override;
    procedure DoWork; virtual; abstract;
  public
    function WakeUp: Boolean;
    constructor Create(_Suspended: Boolean);
    destructor Destroy; override;
    property Busy: Boolean read FBusy;
  end;

  TTestThread = class(TSleepingThread)
  private
    FCountLoop: Integer;
  protected
    procedure DoWork; override;
    property CountLoop: Integer read FCountLoop;
  end;

{ TMyThread }

constructor TSleepingThread.Create(_Suspended: Boolean);
begin
  FEvent := TEvent.Create(nil, True, False, '');
  FBusy := False;
  inherited Create(_Suspended);
end;

destructor TSleepingThread.Destroy;
begin
  Terminate; // FTerminate setzen
  WakeUp; // Event setzen
  WaitFor; // warten bis der eigene Thered sich beendet hat
  FreeAndNil(FEvent);
  inherited;
end;

function TSleepingThread.WakeUp: Boolean;
begin
  Result := FBusy;
  if not Result then
    FEvent.SetEvent;
end;

procedure TSleepingThread.Execute;
begin
  while not Terminated do begin
    case FEvent.WaitFor(INFINITE) of
      wrSignaled: begin
          if not Terminated then begin
            FBusy := True;
            DoWork;
            FEvent.ResetEvent;
            FBusy := False;
          end;
        end;
      wrTimeout: ;

      wrError: begin
          ReturnValue := FEvent.LastError;
          Exit;
        end;

      wrAbandoned:
        Exit;
    end;
  end;
end;

{ TTestThread }

procedure TTestThread.DoWork;
var
  t: Cardinal;
begin
  t := GetTickCount;
  while GetTickCount - t < 2000 do
    Sleep(100);
  Inc(FCountLoop);
end;

procedure TForm28.OnTerminateThread(_Sender: Tobject);
begin
  caption := inttostr((_Sender as TTestThread).CountLoop);
end;

procedure TForm28.Button1Click(Sender: TObject);

var
  tt: TTestThread;
begin
// recht sinnloses beispiel da FreeAndNil immer auf Ende wartet aller arbeiten wartet
// und es somit "blockierend" aussieht
  tt := TTestThread.Create(False);
  try
    tt.OnTerminate := OnTerminateThread;
    if tt.WakeUp then begin
      // joa konnte ausgefuerht werden
    end;
    Sleep(10); // naja irgendwas im HauptThread zwischendurch
  finally
    FreeAndNil(tt);
  end;
end;

Edit: Ah Thread falsch aufgeweckt ;P
Edit2: Beispiel erweiter (u.a. busy usw.)