Wie beendet man einen Thread?

Question

Mein üblicher Aufbau für einen Thread ist eine while-Schleife und innerhalb der while-Schleife werden zwei Dinge getan:

• etwas arbeiten

• Unterbrechen, bis sie von außen wieder aufgenommen wird

  procedure TMIDI_Container_Publisher.Execute; begin Suspend; while not Terminated do begin FContainer.Publish; if not Terminated then Suspend; end; // if end; // Execute //

Das funktioniert gut. Um den Code zu beenden, verwende ich:

destructor TMIDI_Container_Publisher.Destroy;
begin
   Terminate;
   if Suspended then Resume;
   Application.ProcessMessages;
   Self.WaitFor;

   inherited Destroy;
end; // Destroy //

Dieses Destroy funktioniert problemlos unter Windows 7, bleibt aber unter XP hängen. Das Problem scheint das WaitFor zu sein, aber wenn ich es entferne, bleibt der Code in der inherited Destroy .

Hat irgendjemand eine Idee, was los ist?

---

Aktualisierung 2011/11/02 Vielen Dank an Sie alle für Ihre Hilfe. Remy Labeau kam mit einem Codebeispiel, um Resume/Suspend überhaupt zu vermeiden. Ich werde seinen Vorschlag von nun an in meinen Programmen implementieren. Für diesen speziellen Fall habe ich mich von der Anregung von CodeInChaos inspirieren lassen. Erstellen Sie einfach einen Thread, lassen Sie ihn die Veröffentlichung im Execute durchführen und vergessen Sie ihn. Ich habe das Beispiel von Remy benutzt, um einen meiner Timer umzuschreiben. Ich poste diese Implementierung unten.

unit Timer_Threaded;

interface

uses Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms,
     Dialogs, SyncObjs,
     Timer_Base;

Type
   TTask = class (TThread)
   private
      FTimeEvent: TEvent;
      FStopEvent: TEvent;
      FOnTimer: TNotifyEvent;

   public
      constructor Create;
      destructor Destroy; override;
      procedure Execute; override;
      procedure Stop;
      procedure ProcessTimedEvent;

      property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
   end; // Class: TWork //

   TThreadedTimer = class (TBaseTimer)
   private
      nID: cardinal;
      FTask: TTask;

   protected
      procedure SetOnTimer (Task: TNotifyEvent); override;

      procedure StartTimer; override;
      procedure StopTimer; override;

   public
      constructor Create; override;
      destructor Destroy; override;
   end; // Class: TThreadedTimer //

implementation

var SelfRef: TTask; // Reference to the instantiation of this timer

procedure TimerUpdate (uTimerID, uMessage: cardinal; dwUser, dw1, dw2: cardinal); stdcall;
begin
   SelfRef.ProcessTimedEvent;
end; // TimerUpdate //

{*******************************************************************
*                                                                  *
* Class TTask                                                      *
*                                                                  *
********************************************************************}

constructor TTask.Create;
begin
   FTimeEvent := TEvent.Create (nil, False, False, '');
   FStopEvent := TEvent.Create (nil, True,  False, '');

   inherited Create (False);

   Self.Priority := tpTimeCritical;
end; // Create //

destructor TTask.Destroy;
begin
   Stop;
   FTimeEvent.Free;
   FStopEvent.Free;

   inherited Destroy;
end; // Destroy //

procedure TTask.Execute;
var two: TWOHandleArray;
    h:   PWOHandleArray;
    ret: DWORD;
begin
   h := @two;
   h [0] := FTimeEvent.Handle;
   h [1] := FStopEvent.Handle;

   while not Terminated do
   begin
      ret := WaitForMultipleObjects (2, h, FALSE, INFINITE);
      if ret = WAIT_FAILED then Break;
      case ret of
         WAIT_OBJECT_0 + 0: if Assigned (OnTimer) then OnTimer (Self);
         WAIT_OBJECT_0 + 1: Terminate;
      end; // case
   end; // while
end; // Execute //

procedure TTask.ProcessTimedEvent;
begin
   FTimeEvent.SetEvent;
end; // ProcessTimedEvent //

procedure TTask.Stop;
begin
   Terminate;
   FStopEvent.SetEvent;
   WaitFor;
end; // Stop //

{*******************************************************************
*                                                                  *
* Class TThreaded_Timer                                            *
*                                                                  *
********************************************************************}

constructor TThreadedTimer.Create;
begin
   inherited Create;

   FTask := TTask.Create;
   SelfRef := FTask;
   FTimerName := 'Threaded';
   Resolution := 2;
end; // Create //

// Stop the timer and exit the Execute loop
Destructor TThreadedTimer.Destroy;
begin
   Enabled := False;  // stop timer (when running)
   FTask.Free;

   inherited Destroy;
end; // Destroy //

procedure TThreadedTimer.SetOnTimer (Task: TNotifyEvent);
begin
   inherited SetOnTimer (Task);

   FTask.OnTimer := Task;
end; // SetOnTimer //

// Start timer, set resolution of timesetevent as high as possible (=0)
// Relocates as many resources to run as precisely as possible
procedure TThreadedTimer.StartTimer;
begin
   nID := TimeSetEvent (FInterval, FResolution, TimerUpdate, cardinal (Self), TIME_PERIODIC);
   if nID = 0 then
   begin
      FEnabled := False;
      raise ETimer.Create ('Cannot start TThreaded_Timer');
   end; // if
end; // StartTimer //

// Kill the system timer
procedure TThreadedTimer.StopTimer;
var return: integer;
begin
   if nID <> 0 then
   begin
      return := TimeKillEvent (nID);
      if return <> TIMERR_NOERROR
         then raise ETimer.CreateFmt ('Cannot stop TThreaded_Timer: %d', [return]);
   end; // if
end; // StopTimer //

end. // Unit: MSC_Threaded_Timer //

unit Timer_Base;

interface

uses
  Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs;

type
   TCallBack = procedure (uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD);

   ETimer = class (Exception);

{$M+}
   TBaseTimer = class (TObject)
   protected
      FTimerName: string;     // Name of the timer
      FEnabled: boolean;      // True= timer is running, False = not
      FInterval: Cardinal;    // Interval of timer in ms
      FResolution: Cardinal;  // Resolution of timer in ms
      FOnTimer: TNotifyEvent; // What to do when the hour (ms) strikes

      procedure SetEnabled (value: boolean); virtual;
      procedure SetInterval (value: Cardinal); virtual;
      procedure SetResolution (value: Cardinal); virtual;
      procedure SetOnTimer (Task: TNotifyEvent); virtual;

   protected
      procedure StartTimer; virtual; abstract;
      procedure StopTimer; virtual; abstract;

   public
      constructor Create; virtual;
      destructor Destroy; override;

   published
      property TimerName: string read FTimerName;
      property Enabled: boolean read FEnabled write SetEnabled;
      property Interval: Cardinal read FInterval write SetInterval;
      property Resolution: Cardinal read FResolution write SetResolution;
      property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
   end; // Class: HiResTimer //

implementation

constructor TBaseTimer.Create;
begin
   inherited Create;

   FEnabled    := False;
   FInterval   := 500;
   Fresolution := 10;
end; // Create //

destructor TBaseTimer.Destroy;
begin
   inherited Destroy;
end; // Destroy //

// SetEnabled calls StartTimer when value = true, else StopTimer
// It only does so when value is not equal to the current value of FEnabled
// Some Timers require a matching StartTimer and StopTimer sequence
procedure TBaseTimer.SetEnabled (value: boolean);
begin
   if value <> FEnabled then
   begin
      FEnabled := value;
      if value
         then StartTimer
         else StopTimer;
   end; // if
end; // SetEnabled //

procedure TBaseTimer.SetInterval (value: Cardinal);
begin
   FInterval := value;
end; // SetInterval //

procedure TBaseTimer.SetResolution (value: Cardinal);
begin
   FResolution := value;
end; // SetResolution //

procedure TBaseTimer.SetOnTimer (Task: TNotifyEvent);
begin
   FOnTimer := Task;
end; // SetOnTimer //

end. // Unit: MSC_Timer_Custom //

Answer 1

Sie sollten wirklich nicht verwenden Suspend() y Resume() wie diese. Sie sind nicht nur gefährlich, wenn sie missbraucht werden (wie bei Ihnen), sondern sie sind in D2010+ ohnehin veraltet. Eine sicherere Alternative ist die Verwendung der TEvent Klasse stattdessen, z.B.:

contructor TMIDI_Container_Publisher.Create;
begin
  fPublishEvent := TEvent.Create(nil, False, False, '');
  fTerminateEvent := TEvent.Create(nil, True, False, '');
  inherited Create(False);
end;

destructor TMIDI_Container_Publisher.Destroy;
begin
  Stop
  fPublishEvent.Free;
  fTerminateEvent.Free;
  inherited Destroy;
end;

procedure TMIDI_Container_Publisher.Execute;
var
  h: array[0..1] of THandle;
  ret: DWORD;
begin
  h[0] := fPublishEvent.Handle;
  h[1] := fTerminateEvent.Handle;

  while not Terminated do
  begin
    ret := WaitForMultipleObjects(2, h, FALSE, INFINITE);
    if ret = WAIT_FAILED then Break;
    case ret of
      WAIT_OBJECT_0 + 0: FContainer.Publish;
      WAIT_OBJECT_0 + 1: Terminate;
    end;
  end;
end;

procedure TMIDI_Container_Publisher.Publish;
begin
  fPublishEvent.SetEvent;
end;

procedure TMIDI_Container_Publisher.Stop;
begin
  Terminate;
  fTerminateEvent.SetEvent;
  WaitFor;
end;

Answer 2

Ich kenne die Antwort auf Ihre Frage nicht, aber ich glaube, Ihr Code hat mindestens einen weiteren Fehler:

Ich vermute, Sie haben eine Methode wie die folgende:

procedure DoWork()
begin
  AddWork();
  Resume();
end;

Dies führt zu einer Rassenbedingung:

procedure TMIDI_Container_Publisher.Execute;
begin
   Suspend;
   while not Terminated do
   begin
      FContainer.Publish;
      // <= Assume code is here (1)
      if not Terminated then { Or even worse: here (2) } Suspend;
   end; // if
end; // Execute //

Wenn Sie anrufen DoWork und den Faden wieder aufnehmen, während er sich irgendwo bei (1) oder (2) befindet, wird er sofort wieder in den Schwebezustand versetzt.

Wenn Sie anrufen Destroy während der Ausführung (2) wird sie sofort unterbrochen und höchstwahrscheinlich nie beendet.

Answer 3

Dieser Code birgt sicherlich das Potenzial für eine Blockade. Angenommen, Execute y Destroy gleichzeitig ausgeführt werden, und es gibt einen Kontextwechsel weg von der Execute Thread unmittelbar nach der Auswertung von not Terminated etwa so:

// Thread 1                      // Thread 2
if not Terminated then
                // context switch
                                 Terminate;
                                 if Suspended then Resume;
                                 Application.ProcessMessages;
                                 WaitFor;
                // context switch
  Suspend;

Jetzt warten Sie auf die Beendigung eines ausgesetzten Threads. Das wird niemals Fortschritte machen. Der geerbte Destruktor ruft auch Terminate y WaitFor Es ist also keine Überraschung, dass das Entfernen von Code aus dem eigenen Destruktor keine großen Auswirkungen auf das Verhalten des Programms hat.

Setzen Sie den Thread nicht aus. Lassen Sie ihn stattdessen auf ein Ereignis warten, das signalisiert, dass es mehr Daten zu verarbeiten gibt. Gleichzeitig lassen Sie ihn auf ein anderes Ereignis warten, das signalisiert, dass der Thread beendet werden soll. (Als Erweiterung zu diesem Ratschlag sollten Sie sich nicht die Mühe machen, den Befehl Terminate Da es nicht virtuell ist, ist es einfach keine nützliche Methode, um einen Thread zu beenden, der etwas nicht-triviales tut).

Answer 4

Verwenden Sie suspended := false anstelle von resume.