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

Семафор (semaphore) подобен взаимному исключению. Разница между ними в том, что семафор может управлять количеством потоков, которые имеют к нему доступ. Семафор устанавливается на предельное число потоков, которым доступ разрешен. Когда это число достигнуто, последующие потоки будут приостановлены, пока один или более потоков не отсоединятся от семафора и не освободят доступ.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
type
....
values = record
x,y,r:integer;
end;
mythread1 = class(tthread)
private
val: values;
procedure ToPaint;
protected
procedure Execute(); override;
end;

mythread2 = class(tthread)
private
val: values;
procedure ToPaint;
protected
procedure Execute(); override;
end;

var
....
potok1:mythread1;
potok2:mythread2;
hSem: THandle = 0;
....
function readfromfile():values;
var t:values;
begin
assignfile(input,'data.txt');
reset(input);
readln(input,t.x);
readln(input,t.y);
readln(input,t.r);
close(input);
result:=t;
end;
procedure mythread1.execute();
var WaitReturn: DWORD;
begin
while not Terminated do begin
WaitReturn := WaitForSingleObject(hSem, INFINITE);
if WaitReturn = WAIT_OBJECT_0 then begin
val:=readfromfile();
Synchronize(ToPaint);
//    sleep(100);
ReleaseSemaphore(hSem, 1, nil);
end;
end;
end;

procedure mythread2.execute();
var WaitReturn: DWORD;
t:values;
begin
while not Terminated do begin
WaitReturn := WaitForSingleObject(hSem, INFINITE);
if WaitReturn = WAIT_OBJECT_0 then begin
val:=readfromfile();
Synchronize(ToPaint);
//  sleep(1500);
ReleaseSemaphore(hSem, 1, nil);
end;
end;
end;

procedure mythread1.ToPaint;
begin
PatBlt(Form1.Image1.Canvas.Handle, 0, 0, Form1.Image1.Width, Form1.Image1.Height, WHITENESS);
form1.Image1.Canvas.Ellipse(val.x,val.y, val.x+val.r,val.y+val.r);
form1.memo1.Lines.Add(timetostr(time) + ' 1 поток работает');
end;

procedure mythread2.ToPaint;
begin
PatBlt(Form1.Image1.Canvas.Handle, 0, 0, Form1.Image1.Width, Form1.Image1.Height, WHITENESS);
form1.Image1.Canvas.Rectangle(val.x,val.y, val.x+val.r,val.y+val.r);
form1.memo1.Lines.Add(timetostr(time) + ' 2 поток работает');
end;

procedure TForm1.Button1Click(Sender: TObject);
var t:integer;
begin
hSem := CreateSemaphore(nil, 1, 1, nil);
potok1:= mythread1.Create(false);
potok1.Priority:=tpLower;
potok2:= mythread2.Create(false);
potok2.Priority:=tpLower
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
potok1.Terminate;
potok2.Terminate;
end;

CreateSemaphore(nil, 1, 1, nil) — это создание семафора без владельца и с которым может работать только один поток.

HANDLE CreateSemaphore ( LPSECURITY_ATTRIBUTES
lpSemaphoreAttributes,   // атрибут доступа
LONG lInitialCount,      // инициализированное начальное состояние счетчика
LONG lMaximumCount,      // максимальное количество обращений
LPCTSTR lpName           // имя объекта );

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

DWORD WaitForSingleObject
Функция завершается в том случае, если при проверке состояния сигнализирующего объекта 
происходит одно из событий:
 ·         Состояние объекта изменилось на "Включен"
 ·         Время ожидания, определенного при вызове функции, истекло.
Параметры:
 HANDLE hHandle,            // Handle сигнализирующего объекта
 DWORD dwMilliseconds       // Время ожидания в миллисекундах

Т.е. если бы запустили два потока без семафоров, то они бы выполнялись одновременно. А если у нас в потоке происходит такое событие, которое должно выполняться монопольно (например запись в файл).

Надеюсь, что статья будет полезна.