Delphi. Потоки по книге Мартина Харви. Конспект

Запуск потока

Примеры анонимных запусков

// Если нужно настраивать какие-то параметры проекта после его запуска
 t := TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end).Start;
  t.FreeOnTerminate := true;
 ...
  // Если нужно настраивать какие-то параметры потока до его запуска...
  with TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
...
// From StackOverflow - пример анонимного запуска с параметрами запускаемой процедуры
procedure DoSomething(const aWebAddress: String);
begin
end;
 
procedure BuildThread;
var
  myThread: TThread;
  fetchURL: string;
begin
  fetchURL := 'http://stackoverflow.com';
  // Create an anonymous thread that calls a method and passes in
  // the fetchURL to that method.
  myThread := TThread.CreateAnonymousThread(
    procedure
    begin
      DoSomething(fetchURL);
    end);
  ...
end;

// Если нужно настраивать какие-то параметры проекта после его запуска

t := TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end).Start;

t.FreeOnTerminate := true;

...

// Если нужно настраивать какие-то параметры потока до его запуска...

with TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end) do

begin

FreeOnTerminate := true;

Start;

end;

...

// From StackOverflow - пример анонимного запуска с параметрами запускаемой процедуры

procedure DoSomething(const aWebAddress: String);

begin

end;

procedure BuildThread;

var

myThread: TThread;

fetchURL: string;

begin

fetchURL := 'http://stackoverflow.com';

// Create an anonymous thread that calls a method and passes in

// the fetchURL to that method.

myThread := TThread.CreateAnonymousThread(

procedure

begin

DoSomething(fetchURL);

end);

...

end;

Традиционный запуск

...
with TTestThread.Create(true) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
...

...

with TTestThread.Create(true) do

begin

FreeOnTerminate := true;

Start;

end;

...

Полный модуль традиционного запуска из Main

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, //
  SyncObjs //
;

const
  WM_DATA_IN_BUF = WM_APP + 1000;

type
  TMain = class(TForm)
    bStart: TButton;
    procedure bStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FBuffer: TStringList;
    FCS: TCriticalSection;
    procedure HandleBuffer(var aMessage: TMessage); message WM_DATA_IN_BUF;
    procedure SetBuffer(const Value: TStringList);
    procedure SetCS(const Value: TCriticalSection);
    { Private declarations }
  public
    { Public declarations }
    property Buffer: TStringList read FBuffer write SetBuffer;
    property CS: TCriticalSection read FCS write SetCS;
  end;

var
  Main: TMain;

implementation

{$R *.dfm}
uses
  uTestThread;

procedure TMain.bStartClick(Sender: TObject);
begin
  with TTestThread.Create(true) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
end;

procedure TMain.HandleBuffer(var aMessage: TMessage);
begin
  FCS.Enter;
  Caption := FBuffer.Text;
  FCS.Leave;
end;


procedure TMain.SetBuffer(const Value: TStringList);
begin
  FBuffer := Value;
end;

procedure TMain.SetCS(const Value: TCriticalSection);
begin
  FCS := Value;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := true;
  FCS := TCriticalSection.Create;
  FBuffer := TStringList.Create;
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
  FCS.Free();
  FBuffer.Free;
end;

end.

unit uMain;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, //

SyncObjs //

;

const

WM_DATA_IN_BUF = WM_APP + 1000;

type

TMain = class(TForm)

bStart: TButton;

procedure bStartClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

FBuffer: TStringList;

FCS: TCriticalSection;

procedure HandleBuffer(var aMessage: TMessage); message WM_DATA_IN_BUF;

procedure SetBuffer(const Value: TStringList);

procedure SetCS(const Value: TCriticalSection);

{ Private declarations }

public

{ Public declarations }

property Buffer: TStringList read FBuffer write SetBuffer;

property CS: TCriticalSection read FCS write SetCS;

end;

var

Main: TMain;

implementation

{$R *.dfm}

uses

uTestThread;

procedure TMain.bStartClick(Sender: TObject);

begin

with TTestThread.Create(true) do

begin

FreeOnTerminate := true;

Start;

end;

procedure TMain.HandleBuffer(var aMessage: TMessage);

begin

FCS.Enter;

Caption := FBuffer.Text;

FCS.Leave;

end;

procedure TMain.SetBuffer(const Value: TStringList);

begin

FBuffer := Value;

end;

procedure TMain.SetCS(const Value: TCriticalSection);

begin

FCS := Value;

end;

procedure TMain.FormCreate(Sender: TObject);

begin

ReportMemoryLeaksOnShutdown := true;

FCS := TCriticalSection.Create;

FBuffer := TStringList.Create;

end;

procedure TMain.FormDestroy(Sender: TObject);

begin

FCS.Free();

FBuffer.Free;

end;

end.

С объявлением класса потока, например так…

unit uTestThread;

interface

uses
  System.Classes, SyncObjs, SysUtils;

type
  TTestThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
  end;

implementation

{ TTestThread }

uses
  uMain, Winapi.Windows;

procedure TTestThread.Execute;
var
  i, j: Integer;
begin
  if Assigned(Main.CS) then
  begin
    for i := 0 to 5 do
    begin
      Main.CS.Enter;
      Main.Buffer.Add(intToStr(i));
      Main.CS.Leave;
      Sleep(1000);
      PostMessage(Main.Handle, WM_DATA_IN_BUF, 0, 0);
    end;
  end;
end;

end.

unit uTestThread;

interface

uses

System.Classes, SyncObjs, SysUtils;

type

TTestThread = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

public

end;

implementation

{ TTestThread }

uses

uMain, Winapi.Windows;

procedure TTestThread.Execute;

var

i, j: Integer;

begin

if Assigned(Main.CS) then

begin

for i := 0 to 5 do

begin

Main.CS.Enter;

Main.Buffer.Add(intToStr(i));

Main.CS.Leave;

Sleep(1000);

PostMessage(Main.Handle, WM_DATA_IN_BUF, 0, 0);

end;

end.

Флаг Terminated для потока

Досрочная остановка потока
В некоторых ситуациях одному потоку может потребоваться уведомить
другой поток о своем завершении. Это обычно происходит, когда поток
выполняет длительную операцию, и пользователь решает выйти из
приложения, или операция должна быть прервана. TThread обеспечивает
простой механизм для поддержки таких действий, а именно, метод
Terminate и свойство Terminated. Когда поток создается, свойство
Terminated установлено в False, а всякий раз, когда вызывается метод
Terminate, свойство Terminated для этого потока устанавливается в True.
Таким образом, на всех потоках лежит ответственность за периодическую
проверку, не были ли они остановлены, и если это случается, за
корректное завершение своей работы. Заметьте, что никакой
крупномасштабной синхронизации при этом не происходит: когда один
поток устанавливает свойство Terminated другого, нельзя предполагать,
что другой поток тут же прочитает значение своего свойства Terminated и
начнет процесс завершения. Свойство Terminated является просто флагом,
говорящим “пожалуйста, завершайся как можно скорее”.

В коде потока мы пишем что-то такое…

...
if(not terminated) do
begin
// do smth...
end;
...

...

if(not terminated) do

begin

// do smth...

end;

...

Событие OnTerminate

Событие OnTerminate происходит, когда поток в самом деле завершается.
Оно не случается, когда вызывается метод потока Terminate. Это событие
может быть весьма полезным, поскольку оно выполняется в контексте
основного потока VCL, подобно методам, вызываемым с помощью
Synchronize. Таким образом, если есть желание выполнять какие-то
действия VCL с потоком, который автоматически освобождается по
окончании, то обработчик этого события – прекрасное место для таких
действий. Для большинства программистов, начинающих работать с
потоками, это наиболее удобный путь получения данных из не-VCL потока
без особых усилий, не требующий явных вызовов синхронизации.

Как можно видеть на диаграмме, OnTerminate работает в основном так же,
как и Synchronize, и семантически это почти идентично вызову Synchronize
в конце потока. Основная польза от такой ситуации заключается в том, что
используя флаг, например, “AppCanQuit” или счетчик работающих потоков
в главном потоке VCL, можно обеспечить простые механизмы проверки
того, что основной поток VCL завершается только тогда, когда все другие
потоки остановлены.

Остановка основного потока после остановки дополнительных потоков. Пример

procedure TMain.bStartClick(Sender: TObject);
begin
  with TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 5 do
        Sleep(1000);
    end) do
  begin
    OnTerminate := HandleTerminate;
    FreeOnTerminate := true;
    Inc(FCountThreads);
    Start;
  end;
end;

procedure TMain.HandleTerminate(Sender: TObject);
begin
  Dec(FCountThreads);
end;

procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  if (FCountThreads > 0) then
  begin
    Action := caNone;
    ShowMessage('Дополнительные потоки ещё работают');
  end;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := true;
end;

procedure TMain.bStartClick(Sender: TObject);

begin

with TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 5 do

Sleep(1000);

end) do

begin

OnTerminate := HandleTerminate;

FreeOnTerminate := true;

Inc(FCountThreads);

Start;

end;

procedure TMain.HandleTerminate(Sender: TObject);

begin

Dec(FCountThreads);

end;

procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action := caFree;

if (FCountThreads > 0) then

begin

Action := caNone;

ShowMessage('Дополнительные потоки ещё работают');

end;

procedure TMain.FormCreate(Sender: TObject);

begin

ReportMemoryLeaksOnShutdown := true;

end;

Syncronize из рабочего потока и WaitFor из основного потенциально может привести к DeadLock

Зацикливание может произойти для двух
потоков, если вычислительный поток вызывает Synchronize прямо перед
тем,как основной поток вызывает WaitFor. Тогда вычислительный поток
будет ждать, пока основной поток не вернется в цикл обработки
сообщений, а основной будет ждать завершения вычислительного.
Произойдет зацикливание. Возможно также, что основной поток VCL
вызовет WaitFor незадолго до вызова Synchronize рабочим потоком. Это
тоже может привести к зацикливанию. К счастью, разработчики VCL
предусмотрели перехват такой ошибки: в рабочем потоке возбуждается
исключение, таким образом цикл прерывается, и поток завершается.

Наилучший метод не допускать этой формы зацикливания – не
использовать WaitFor и Synchronize в одном приложении. От WaitFor можно
избавиться, применяя событие OnTerminate либо WaitFor + PostMessage.

Ниже пример получения результатов потока через WaitFor и PostMessage…

// В рабочем потоке...
Type
 TPrimeThrd = class(TThread)
Private
 FTestNumber: integer;
 FResultString: string;
Protected
 function IsPrime: boolean;
 procedure Execute; override;
public
 property TestNumber: integer write FTestNumber;
 property ResultString: string read FResultString;
end;
procedure TPrimeThrd.Execute;
begin
// do smth...
 FResultString := IntToStr(FTestNumber) + ' is not prime.' ;
 if not Terminated then {Line B}
 PostMessage(PrimeFrm.Handle, WM_THREAD_COMPLETE, 0, 0);
end;

// В главном потоке обрабатываем OnMessage
{ Unit PrimeForm }
...
Const
WM_THREAD_COMPLETE = WM_APP + 5437; { Just a magic number }
...
procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE;
...

procedure TPrimeFrm.HandleThreadCompletion(var Message: TMessage);
begin
if Assigned(FThread) then
 begin
  FThread.WaitFor;
  ResultsMemo.Lines.Add(FThread.ResultString);
  FThread.Free;
  FThread := nil;
 end;
end;

// В рабочем потоке...

Type

TPrimeThrd = class(TThread)

Private

FTestNumber: integer;

FResultString: string;

Protected

function IsPrime: boolean;

procedure Execute; override;

public

property TestNumber: integer write FTestNumber;

property ResultString: string read FResultString;

end;

procedure TPrimeThrd.Execute;

begin

// do smth...

FResultString := IntToStr(FTestNumber) + ' is not prime.' ;

if not Terminated then {Line B}

PostMessage(PrimeFrm.Handle, WM_THREAD_COMPLETE, 0, 0);

end;

// В главном потоке обрабатываем OnMessage

{ Unit PrimeForm }

...

Const

WM_THREAD_COMPLETE = WM_APP + 5437; { Just a magic number }

...

procedure HandleThreadCompletion(var Message: TMessage);

message WM_THREAD_COMPLETE;

...

procedure TPrimeFrm.HandleThreadCompletion(var Message: TMessage);

begin

if Assigned(FThread) then

begin

FThread.WaitFor;

ResultsMemo.Lines.Add(FThread.ResultString);

FThread.Free;

FThread := nil;

end;

Ограничения метода Synchronize

У метода Synchronize есть несколько недостатков, благодаря которым он
подходит лишь для простых многопоточных приложений.
– Synchronize полезен лишь при взаимодействии между рабочим
потоком и основным потоком VCL.
– Использование Synchronize подразумевает,что рабочий поток ждет,
пока основной поток VCL будет в состоянии ожидания, даже когда
это не так уж и необходимо.
– Если приложение часто использует Synchronize, главный поток VCL
становится “узким местом”, и возникают проблемы с
производительностью.

– Если Synchronize используется для непосредственного
взаимодействия двух рабочих потоков, оба они могут быть
приостановлены, ожидая главный поток.
– Synchronize может вызвать зацикливание, если главный поток VCL
ожидает другие потоки.
Правда, у Synchronize есть и одно преимущество над другими механизмами
синхронизации:
– В методе, вызываемом с помощью Synchronize, может быть любой
код, в том числе и потоко-небезопасный код VCL.

Критические секции

Простой пример – пишем что-то в буфер TStringList, и каждый поток обращается к разделяемому ресурсу через FCS. Enter / FCS.Leave

Код потока

unit uTestThread;

interface

uses
  System.Classes, SyncObjs, SysUtils;

type
  TTestThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
  end;

implementation

{ TTestThread }

uses
  uMain, Winapi.Windows;

procedure TTestThread.Execute;
var
  i, j: Integer;
begin
  if Assigned(Main.CS) then
  begin
    for i := 0 to 5 do
    begin
      Main.CS.Enter;
      Main.Buffer.Add(intToStr(i));
      Main.CS.Leave;
      Sleep(1000);
      PostMessage(Main.Handle, WM_DATA_IN_BUF, 0, 0);
    end;
  end;
end;

end.

unit uTestThread;

interface

uses

System.Classes, SyncObjs, SysUtils;

type

TTestThread = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

public

end;

implementation

{ TTestThread }

uses

uMain, Winapi.Windows;

procedure TTestThread.Execute;

var

i, j: Integer;

begin

if Assigned(Main.CS) then

begin

for i := 0 to 5 do

begin

Main.CS.Enter;

Main.Buffer.Add(intToStr(i));

Main.CS.Leave;

Sleep(1000);

PostMessage(Main.Handle, WM_DATA_IN_BUF, 0, 0);

end;

end.

Код Main

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, //
  SyncObjs //
;

const
  WM_DATA_IN_BUF = WM_APP + 1000;

type
  TMain = class(TForm)
    bStart: TButton;
    procedure bStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FBuffer: TStringList;
    FCS: TCriticalSection;
    procedure HandleBuffer(var aMessage: TMessage); message WM_DATA_IN_BUF;
    procedure SetBuffer(const Value: TStringList);
    procedure SetCS(const Value: TCriticalSection);
    { Private declarations }
  public
    { Public declarations }
    property Buffer: TStringList read FBuffer write SetBuffer;
    property CS: TCriticalSection read FCS write SetCS;
  end;

var
  Main: TMain;

implementation

{$R *.dfm}
uses
  uTestThread;

procedure TMain.bStartClick(Sender: TObject);
begin
  with TTestThread.Create(true) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
end;

procedure TMain.HandleBuffer(var aMessage: TMessage);
begin
  FCS.Enter;
  Caption := FBuffer.Text;
  FCS.Leave;
end;


procedure TMain.SetBuffer(const Value: TStringList);
begin
  FBuffer := Value;
end;

procedure TMain.SetCS(const Value: TCriticalSection);
begin
  FCS := Value;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := true;
  FCS := TCriticalSection.Create;
  FBuffer := TStringList.Create;
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
  FCS.Free();
  FBuffer.Free;
end;

end.

unit uMain;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, //

SyncObjs //

;

const

WM_DATA_IN_BUF = WM_APP + 1000;

type

TMain = class(TForm)

bStart: TButton;

procedure bStartClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

FBuffer: TStringList;

FCS: TCriticalSection;

procedure HandleBuffer(var aMessage: TMessage); message WM_DATA_IN_BUF;

procedure SetBuffer(const Value: TStringList);

procedure SetCS(const Value: TCriticalSection);

{ Private declarations }

public

{ Public declarations }

property Buffer: TStringList read FBuffer write SetBuffer;

property CS: TCriticalSection read FCS write SetCS;

end;

var

Main: TMain;

implementation

{$R *.dfm}

uses

uTestThread;

procedure TMain.bStartClick(Sender: TObject);

begin

with TTestThread.Create(true) do

begin

FreeOnTerminate := true;

Start;

end;

procedure TMain.HandleBuffer(var aMessage: TMessage);

begin

FCS.Enter;

Caption := FBuffer.Text;

FCS.Leave;

end;

procedure TMain.SetBuffer(const Value: TStringList);

begin

FBuffer := Value;

end;

procedure TMain.SetCS(const Value: TCriticalSection);

begin

FCS := Value;

end;

procedure TMain.FormCreate(Sender: TObject);

begin

ReportMemoryLeaksOnShutdown := true;

FCS := TCriticalSection.Create;

FBuffer := TStringList.Create;

end;

procedure TMain.FormDestroy(Sender: TObject);

begin

FCS.Free();

FBuffer.Free;

end;

end.

Результат работы

Видно, что потоки получали доступ к буферу и Caption по очереди. Сначала первый, потом второй, потом первый, второй и так далее…

Потоки выстраиваются в очередь перед входом в критическую секцию. Поэтому, при долгой обработке – возможны большие очереди и ожидания.

Функции ожидания критической секций ждут бесконечно. Нет возможности указать ждать столько-то секунд или отказаться от выполнения.

To be continued…

Delphi. Потоки по книге Мартина Харви. Конспект

Запуск потока

Флаг Terminated для потока

Событие OnTerminate

Остановка основного потока после остановки дополнительных потоков. Пример

Syncronize из рабочего потока и WaitFor из основного потенциально может привести к DeadLock

Ограничения метода Synchronize

Критические секции

MY PROJECTS

Recent Posts

Categories