Cuidados ao Suspender uma Thread

Cuidado ao suspender uma Thread!

Em especial se houver seções críticas entre as threads. Ao suspender uma thread que esteja dentro de uma seção crítica, essa seção crítica não será liberada!

Bolei um exemplo sobre o assunto, segue abaixo o pas e o dfm.

unit Unt_Principal;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SyncObjs, Buttons, StdCtrls;

type
TMinhaThread = class(TThread)
private
FNome : string;
FLog  : string;
protected
procedure QuandoTerminar(Sender: TObject);
public
constructor Create(psNome: string); reintroduce;
procedure Execute; override;
procedure GerarLog(psLog: string);
procedure GerarLogSincronizado;
end;

TfPrincipal = class(TForm)
btnA: TButton;
btnB: TBitBtn;
btnSuspendA: TButton;
btnSuspendB: TBitBtn;
mmo1: TMemo;
btnTerminateA: TButton;
btnTerminateB: TBitBtn;
btnLiberarSC: TBitBtn;
procedure btnAClick(Sender: TObject);
procedure btnBClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnSuspendAClick(Sender: TObject);
procedure btnSuspendBClick(Sender: TObject);
procedure btnTerminateAClick(Sender: TObject);
procedure btnTerminateBClick(Sender: TObject);
procedure btnLiberarSCClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fPrincipal   : TfPrincipal;
ThreadA      : TMinhaThread;
ThreadB      : TMinhaThread;
SecaoCritica : TCriticalSection;

implementation

{$R *.dfm}

{ TMinhaThread }

constructor TMinhaThread.Create(psNome: string);
begin
inherited Create(True);
Self.FNome := psNome;
Self.OnTerminate := Self.QuandoTerminar;
end;

procedure TMinhaThread.Execute;
begin
inherited;
try
while not (Self.Terminated) do
begin
Sleep(10);
Self.GerarLog(Format('%s vai entrar na seção critica',[Self.FNome]));
SecaoCritica.Enter;
Self.GerarLog(Format('%s entrou na seção critica',[Self.FNome]));
while not (Self.Terminated) do
begin
Sleep(10);
Application.ProcessMessages;
end;
end;
finally
Self.GerarLog(Format('%s vai sair da seção critica',[Self.FNome]));
SecaoCritica.Release;
Self.GerarLog(Format('%s saiu da seção critica',[Self.FNome]));
end;
end;

procedure TMinhaThread.GerarLog(psLog: string);
begin
Self.FLog := psLog;
Self.Synchronize(Self.GerarLogSincronizado);
end;

procedure TMinhaThread.GerarLogSincronizado;
begin
fPrincipal.mmo1.Lines.Add(Self.FLog);
end;

procedure TMinhaThread.QuandoTerminar(Sender: TObject);
begin
Self.GerarLog(Format('%s terminando',[Self.FNome]));
end;

procedure TfPrincipal.btnAClick(Sender: TObject);
begin
ThreadA.Start;
end;

procedure TfPrincipal.btnBClick(Sender: TObject);
begin
ThreadB.Start;
end;

procedure TfPrincipal.btnLiberarSCClick(Sender: TObject);
begin
SecaoCritica.Release;
end;

procedure TfPrincipal.btnSuspendAClick(Sender: TObject);
begin
ThreadA.Suspend;
end;

procedure TfPrincipal.btnSuspendBClick(Sender: TObject);
begin
ThreadB.Suspend;
end;

procedure TfPrincipal.btnTerminateAClick(Sender: TObject);
begin
ThreadA.Terminate;
if not (ThreadA.Suspended) then
ThreadA.WaitFor;
end;

procedure TfPrincipal.btnTerminateBClick(Sender: TObject);
begin
ThreadB.Terminate;
if not (ThreadB.Suspended) then
ThreadB.WaitFor;
end;

procedure TfPrincipal.FormCreate(Sender: TObject);
begin
ThreadA := TMinhaThread.Create('A');
ThreadB := TMinhaThread.Create('B');
SecaoCritica := TCriticalSection.Create;
end;

end.

object fPrincipal: TfPrincipal
Left = 0
Top = 0
Caption = 'Prova de Conceito'
ClientHeight = 217
ClientWidth = 589
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object btnA: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Thread A'
TabOrder = 0
OnClick = btnAClick
end
object btnB: TBitBtn
Left = 8
Top = 55
Width = 75
Height = 25
Caption = 'Thread B'
DoubleBuffered = True
ParentDoubleBuffered = False
TabOrder = 1
OnClick = btnBClick
end
object btnSuspendA: TButton
Left = 89
Top = 8
Width = 75
Height = 25
Caption = 'Suspend'
TabOrder = 2
OnClick = btnSuspendAClick
end
object btnSuspendB: TBitBtn
Left = 89
Top = 55
Width = 75
Height = 25
Caption = 'Suspend'
DoubleBuffered = True
ParentDoubleBuffered = False
TabOrder = 3
OnClick = btnSuspendBClick
end
object mmo1: TMemo
Left = 260
Top = 8
Width = 321
Height = 185
Lines.Strings = (
'mmo1')
TabOrder = 4
end
object btnTerminateA: TButton
Left = 170
Top = 8
Width = 75
Height = 25
Caption = 'Terminate'
TabOrder = 5
OnClick = btnTerminateAClick
end
object btnTerminateB: TBitBtn
Left = 170
Top = 55
Width = 75
Height = 25
Caption = 'Terminate'
DoubleBuffered = True
ParentDoubleBuffered = False
TabOrder = 6
OnClick = btnTerminateBClick
end
object btnLiberarSC: TBitBtn
Left = 8
Top = 104
Width = 237
Height = 25
Caption = 'Liberar SC'
DoubleBuffered = True
ParentDoubleBuffered = False
TabOrder = 7
OnClick = btnLiberarSCClick
end
end