Question

My usual setup for a thread is a while loop and inside the while loop do two things:

• do some work
• Suspend, until resumed from outside

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

This works fine. To terminate the code I use:

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

   inherited Destroy;
end; // Destroy //

This Destroy works fine in Windows 7 but hangs in XP. The problem seems to be the WaitFor but when I remove this the code hangs in the inherited Destroy.

Anybody ideas what is wrong?

---

Update 2011/11/02
Thanks to you all for your help. Remy Labeau came with a code example to avoid Resume/Suspend at all. I’ll implement his suggestion in my programs from now on. For this specific case I was inspired by the suggestion of CodeInChaos. Just create a thread, let it do the publish in the Execute and forget about it. I used Remy’s example to rewrite one of my timers. I post this implementation below.

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

You really should not use Suspend() and Resume() like this. Not only are they dangerous when misused (like you are), but they are also deprecated in D2010+ anyway. A safer alternative is to use the TEvent class instead, eg:

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;