gpt4 book ai didi

multithreading - 如何终止一个线程?

转载 作者:行者123 更新时间:2023-12-03 15:22:37 25 4
gpt4 key购买 nike

我通常的线程设置是一个 while 循环,在 while 循环内做两件事:

  • 做一些工作
  • 暂停,直到从外部恢复
procedure TMIDI_Container_Publisher.Execute;
begin
Suspend;
while not Terminated do
begin
FContainer.Publish;
if not Terminated then Suspend;
end; // if
end; // Execute //

这很好用。要终止我使用的代码:

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

inherited Destroy;
end; // Destroy //

此破坏在 Windows 7 中工作正常,但在 XP 中挂起。问题似乎是 WaitFor,但是当我删除它时,代码卡在 inherited Destroy 中。

有人知道哪里出了问题吗?

<小时/>

更新2011/11/02感谢大家的帮助。 Remy Labeau 提供了一个代码示例来完全避免恢复/挂起。从现在开始我将在我的节目中实现他的建议。对于这个具体案例,我受到了 CodeInChaos 的建议的启发。只需创建一个线程,让它在执行中进行发布,然后就不用管它了。我用雷米的例子重写了我的一个计时器。我在下面发布了这个实现。

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 //

最佳答案

你真的不应该像这样使用Suspend()Resume()。它们不仅在误用时很危险(就像您一样),而且无论如何它们在 D2010+ 中也已被弃用。更安全的替代方法是使用 TEvent 类,例如:

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;

关于multithreading - 如何终止一个线程?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/7960354/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com