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

Каждый поток может создать другой поток и т.д. Потоки не могут существовать отдельно от процесса, т.е. каждый поток принадлежит какому-то процессу и этот поток выполняет код, только в адресном пространстве этого процесса. Иными словами, поток не может выполнить код чужого процесса, хотя в nt-системах есть лазейка, но это уже тема отдельной статьи.

Многопоточность обеспечивает псевдопараллельную работу множества программ. В некоторых случаях без создания потоков нельзя обойтись, например, при работе с сокетами в блокирующем режиме.

В delphi существует специальный класс, реализующий потоки - tthread. Это базовый класс, от которого надо наследовать свой класс и переопределять метод execute.

tnew = class(tthread)
private
{ private declarations }
protected
procedure execute; override;
end;
…
procedure tnew.execute;
begin
{ place thread code here }
// Код, который будет выполняться в отдельном потоке
end;

Теперь можно в теле процедуры tnew.execute писать код, выполнение, которого подвешивало бы программу.

Тонкий момент. В теле процедуры не надо вызывать метод execute предка.

Теперь необходимо запустить поток. Как всякий класс tnew необходимо создать:

var
new: tnew;
…
begin
new := tnew.create(true);
end;

Значение true в методе create значит, что после создания класса поток автоматически запущен не будет.

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

new.freeonterminate := true;

Устанавливаем приоритет в одно из возможных значений:

tpidle Работает, когда система простаивает
tplowest Нижайший
tplower Низкий
tpnormal Нормальный
tphigher Высокий
tphighest Высочайший
tptimecritical Критический

new.priority := tplowest;

Не рекомендую устанавливать слишком большой приоритет т.к. поток может существенно загрузить систему.

Тонкий момент. Если в потоке присутствует бесконечный цикл обработки чего-либо, то поток будет загружать систему под завязку. Чтобы избежать этого вставляйте функцию sleep(n), где n - количество миллисекунд, на которое поток приостановит свое выполнение, встретив это функцию. n следует выбирать в зависимости от решаемой задачи.

Запускаем поток:

new.resume;

Кстати, если Вы планируйте писать код потока в отдельном модуле, то можно немного упростить написание скелета класса. Для этого выберите в хранилище объектов - thread object (Это на закладке new). Выскочит окно, в котором надо ввести имя класса, после чего, нажав Ок, автоматически создаться новый модуль со скелетом Вашего класса.

Синхронизация потоков при обращении к vcl-компонентам

Значит, мы научились создавать потоки. Но тут всплывает интересная вещь: что будет, если два потока обращаются к одним и тем же данным по записи? Например, два потока пытаются изменить заголовок главной формы.

Специально для этого в ОС реализованы механизмы синхронизаций. В частности, в классе tthread есть метод позволяющий избежать параллельного доступа к vcl-компонентам:

procedure synchronize(method: tthreadmethod);

Он то и позволяет избежать конфликта при обращении к одним vcl-компонентам разными потоками. В качестве параметра ему передается адрес процедуры без параметров. А как вызвать с параметрами? Для этого можно использовать внутриклассовые переменные.

tnew = class(tthread)
private
{ private declarations }
st: string;
procedure update;
protected
procedure execute; override;
end;

var
new: tnew;
…
procedure update;
begin
form1.caption := s;
end;
…
begin
s := 'yes';
synchronize(update);
end;

Вот полный пример, в котором метод addstr добавляет в memo несколько строчек. Если мы просто вызовем метод, то строчки от потоков будут добавятся в произвольном порядке. Если addstr вызовем методом synchronize, то строчки добавятся сначала от одного потока, а затем от второго. Получается, что поток монопольно захватывает ресурс memo и добавляет в него необходимую информацию, после добавления поток освобождает memo и вот теперь уже другой поток может добавлять в memo свои данные. Поменьше слов - побольше сурсов:

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls;

type
tform1 = class(tform)
memo1: tmemo;
button1: tbutton;
procedure button1click(sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

tnew = class(tthread)
private
s: string;
procedure addstr;
protected
procedure execute; override;
end;

var
form1: tform1;
new1, new2: tnew;

implementation

{$r *.dfm}

procedure tform1.button1click(sender: tobject);
begin
new1 := tnew.create(true);
new1.freeonterminate := true;
new1.s := '1 thread';
new1.priority := tplowest;
new2 := tnew.create(true);
new2.freeonterminate := true;
new2.s := '2 thread';
new2.priority := tptimecritical;
new1.resume;
new2.resume;
end;

{ tnew }
procedure tnew.addstr;
begin
form1.memo1.lines.add(s);
sleep(2);
form1.memo1.lines.add(s);
sleep(2);
form1.memo1.lines.add(s);
sleep(2);
form1.memo1.lines.add(s);
sleep(2);
form1.memo1.lines.add(s);
end;

procedure tnew.execute;
begin
synchronize(addstr); // Вызов метода с синхронизацией
//addstr; // Вызов метода без синхронизации
end;

end.

Другие способы синхронизации. Модуль syncobjs

В модуле syncobjs находятся классы синхронизации, которые являются оберткой вызовов api-функций . Всего в этом модуле объявлено пять классов. tcriticalsection, tevent, а так же и более простая реализация класса tevent - tsimpleevent и используются для синхронизации потоков, остальные классы можно и не рассматривать. Вот иерархия классов в этом модуле:

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

Наиболее простым в понимании является tcriticalsection или критическая секция. Код, расположенный в критической секции, может выполняться только одним потоком. В принципе код ни как не выделяется, а происходит обращение к коду через критическую секцию. В начале кода находится функция входа в секцию, а по завершению его выход из секции. Если секция занята другим потоком, то потоки ждут, пока критическая секция не освободится.

В начале работы критическую секцию необходимо создать:

var
section: tcriticalsection; // глобальная переменная
begin
section.create;
end;

Допустим, имеется функция, в которой происходит добавление элементов в глобальный массив:

function addelem(i: integer);
var
n: integer;
begin
n := length(mas);
setlength(mas,n + 1);
mas[n + 1] := i;
end;

Допустим, эту функцию вызывают несколько потоков, поэтому, чтобы не было конфликта по данным можно использовать критическую секцию следующим образом:

function addelem(i: integer);
var
n: integer;
begin
section.enter;
n := length(mas);
setlength(mas,n + 1);
mas[n + 1] := i;
section.leave;
end;

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

section.free;

Как Вы поняли, очень надеюсь, что вход и выход из критической секции не обязательно должен находиться в одной функции. Вход обозначает, только то, что другой поток встретив вход и обнаружив его занятость, будет приостановлен. А выход просто освобождает вход. Совсем просто, критическую секцию можно представит как узкую трубу на один поток, как только поток подходит к трубе, он заглядывает в нее и если видит, что через трубу уже кто-то лезет, будет ждать, пока другой не вылезет.

А вот и пример, в котором происходит добавление элемента в динамический массив. Функция sleep добавляет задержку в цикл, что позволяет наглядно увидеть конфликт по данным, если Вы, конечно, уберете вход и выход из критической секции в коде.

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, syncobjs;

type
tform1 = class(tform)
button1: tbutton;
memo1: tmemo;
procedure formcreate(sender: tobject);
procedure formdestroy(sender: tobject);
procedure button1click(sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

tnew = class(tthread)
protected
procedure execute; override;
end;

var
form1: tform1;
cs: tcriticalsection;
new1, new2: tnew;
mas: array of integer;

implementation

{$r *.dfm}

procedure tform1.formcreate(sender: tobject);
begin
setlength(mas,1);
mas[0] := 6;
// Создаем критическую секцию
cs := tcriticalsection.create;
end;

procedure tform1.formdestroy(sender: tobject);
begin
// Удаляем критическую секцию
cs.free;
end;

{ tnew }
procedure tnew.execute;
var
i: integer;
n: integer;
begin
for i := 1 to 10 do
begin
// Вход в критическую секцию
cs.enter;
// Код, выполнение которого параллельно запрещено
n := length(mas);
form1.memo1.lines.add(inttostr(mas[n-1]));
sleep(5);
setlength(mas,n+1);
mas[n] := mas[n-1]+1;
// Выход из критической секции
cs.leave;
end;
end;

procedure tform1.button1click(sender: tobject);
begin
new1 := tnew.create(true);
new1.freeonterminate := true;
new1.priority := tpidle;
new2 := tnew.create(true);
new2.freeonterminate := true;
new2.priority := tptimecritical;
new1.resume;
new2.resume;
end;

end.

Немного wait-функциях

Для начала не много о wait-функциях. Это функции, которые приостанавливают выполнение потока. Частным случаем wait-функции является sleep, в качестве аргумента передается количество миллисекунд, на которое требуется заморозить или приостановит поток.

Тонкий момент. Если вызвать sleep(0), то поток, откажется от своего такта - процессорного времени и тут же встанет в очередь с готовностью на выполнение.

Полной wait-функции в качестве параметров передается дескрипторы потока(ов). Я не буду останавливаться на них сейчас подробно. В принципе, wait-функции инкапсулируют некоторые классы синхронизации в явном виде, остальные в не явном виде.

События tevent

События tevent могут использоваться не только в многопоточном приложении, но и в однопоточном в качестве координации между секциями кода и при передачи данных их одного приложения в другое. В многопоточных приложениях использование tevent кажется более разумным и понятнее.

Все происходит следующим образом. Если событие установлено, то работать дальше можно, если событие сброшено, то все остальные потоки ждут. Различие между событиями и критическими секциями в то, что события проверяются в коде самого потока и используется wait-функция в явном виде. Если в критической секции wait-функция выполнялась автоматически, то при использовании событий необходимо вызывать ее для заморозки потока.

События бывают с автосбросом и без автосброса. С автосбросом значит, что сразу после возврата из wait-функции событие сбрасывается. При использовании событий без автосброса необходимо самим сбрасывать их.

Событием без автосброса удобно делать паузу в каком-то определенном участке кода потока. Просто сделать паузу в потоке, когда не имеет значения, где произойдет заморозка можно использовать метод tthread.suspend. События с автосбросом можно использовать, так же как и критические секции.

Для начала событие необходимо создать и желательно до того как будут созданы потоки их использующие, хотя точнее до вызова wait-функции.

create(eventattributes: psecurityattributes; manualreset, initialstate: boolean; const name: string);

eventattributes - берем nil.
manualreset - автосброс - false, без автосброса - true.
initialstate - начальное состояние true - установленное, false - сброшенное.
const name - имя события, ставим пустое. Событие с именем нужно при обмене данных между процессами.

var
event: tevent;
new1, new2: tnew; // потоки
…
begin
event := tevent.create(nil, false, false, '');
end;
procedure tnew.execute;
var
n: integer;
begin
event.waitfor(infinite);
n := length(mas);
setlength(mas,n + 1);
mas[n + 1] := i;
event.setevent;
end;

Все теперь ошибки не будет.

Более простым в использовании является класс tsimpleevent, который является наследником tevent и отличается от него только тем, что его конструктор вызывает конструктор предка сразу с установленными параметрами:

create(nil, true, false, '');

Фактически, tsimpleevent есть событие без автосброса, со сброшенным состоянием и без имени.

Следующий пример показывает, как приостановить выполнение потока в определенном месте. В данном примере на форме находятся три progressbar, поток заполняет progressbar. При желании можно приостановить и возобновить заполнение progressbar. Как Вы поняли мы будем создавать событие без автосброса. Хотя тут уместнее использовать tsimpleevent, мы использовали tevent, т.к. освоив работу с tevent будет просто перейти на tsimpleevent.

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, syncobjs, comctrls;

type
tform1 = class(tform)
button1: tbutton;
progressbar1: tprogressbar;
progressbar2: tprogressbar;
progressbar3: tprogressbar;
button2: tbutton;
procedure formcreate(sender: tobject);
procedure formdestroy(sender: tobject);
procedure button1click(sender: tobject);
procedure button2click(sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

tnew = class(tthread)
protected
procedure execute; override;
end;

var
form1: tform1;
new: tnew;
event: tevent;

implementation

{$r *.dfm}

procedure tform1.formcreate(sender: tobject);
begin
// Создаем событие до того как будем его использовать
event := tevent.create(nil,true,true,'');
// Запускаем поток
new := tnew.create(true);
new.freeonterminate := true;
new.priority := tplowest;
new.resume;
end;

procedure tform1.formdestroy(sender: tobject);
begin
// Удаляем событие
event.free;
end;

{ tnew }
procedure tnew.execute;
var
n: integer;
begin
n := 0;
while true do
begin
// wait-функция
event.waitfor(infinite);
if n > 99 then
n := 0;
// Одновременно приращиваем
form1.progressbar1.position := n;
form1.progressbar2.position := n;
form1.progressbar3.position := n;
// задержка для видимости
sleep(100);
inc(n)
end;
end;

procedure tform1.button1click(sender: tobject);
begin
// Устанавливаем событие
// wait-функция будет фозвращать управление сразу
event.setevent;
end;

procedure tform1.button2click(sender: tobject);
begin
// wait-функция блокирует выполнение кода потока
event.resetevent;
end;

end.

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

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, syncobjs, comctrls;

type
tform1 = class(tform)
label1: tlabel;
procedure formcreate(sender: tobject);
procedure formdestroy(sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

tproc = class(tthread)
protected
procedure execute; override;
end;

tsend = class(tthread)
protected
procedure execute; override;
end;

var
form1: tform1;
proc: tproc;
send: tsend;
event: tevent;

implementation

{$r *.dfm}

procedure tform1.formcreate(sender: tobject);
begin
// Создаем событие до того как будем его использовать
event := tevent.create(nil,false,true,'');
// Запускаем потоки
proc := tproc.create(true);
proc.freeonterminate := true;
proc.priority := tplowest;
proc.resume;
send := tsend.create(true);
send.freeonterminate := true;
send.priority := tplowest;
send.resume;
end;

procedure tform1.formdestroy(sender: tobject);
begin
// Удаляем событие
event.free;
end;

{ tnew }
procedure tproc.execute;
begin
while true do
begin
// wait-функция
event.waitfor(infinite);
form1.label1.caption := 'proccessing...';
sleep(2000);
// Подготовка данных
//...
// разрешаем работать другому потоку
event.setevent;
end;
end;

{ tsend }
procedure tsend.execute;
begin
while true do
begin
// wait-функция
event.waitfor(infinite);
form1.label1.caption := 'sending...';
sleep(2000);
// Отсылка данных
//...
// разрешаем работать другому потоку
event.setevent;
end;
end;

end.

Вот и все объекты синхронизации модуля syncobjs, которых в принципе хватит для решения различных задач. В windows существуют другие объекты синхронизации, которые тоже можно использовать в delphi, но уже на уровне api. Это мьютексы - mutex, семафоры - semaphore и ожидаемые таймеры.

snugforce
Источник: http://callipso.bestcode.org