Новичок
Профиль
Группа: Участник
Сообщений: 1
Регистрация: 11.6.2010
Репутация: нет
Всего: нет
|
Доброго времени суток дорогие программисты, смиренно прощу у вас помощи в разборе кода программ по сабжу. Просто все время обучения в институте изучали С++/С# а теперь преподователь на зачет требует программы на Delphi, осталось вот три. Помогите разобрать код, что и зачем это используеться, по возможности каждую строчку описать, не буду против если упростите или сделаете поприятнее (добавила скачивание т.к. с визуализацией, вирусов нет не бойтесь  Лабораторная работа №8.Синхронизация потоков с помощью мьютексов Напишите программу, в которой два потока работая параллельно, генерируют в цикле (100 итераций) некоторую последовательность целых чисел: первый поток – отрицательные, второй – положительные числа. Каждое новое число должно быть добавлено в начало общего связанного списка. После завершения работы первого и второго потоков, третий поток должен вывести содержимое списка на экран. lab8| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
THread1 = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure print1;
end;
THread2 = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure print2;
end;
PNode = ^TNode;
TNode = record
i:Integer;
nextNode;
prevNode;
end;
TList = class
head: PNode;
tail: PNode;
procedure ADDNode(i: integer);
constructor Create;
end;
var
Form1: TForm1;
th1, th2, m: THandle;
t1,t2: TTHread;
Memory: Integer;
list: TList;
implementation
{$R *.dfm}
procedure TList.AddNode(i: integer);
var
node: PNode;
begin
New(node);
node.i := i;
if head = nil then
begin
node.prev := nil;
node.next := nil;
head := node;
tail := node;
end
else
begin
node.prev := tail;
node.next := nil;
tail.next := node;
tail := node;
end;
end;
constructor TList.Create;
begin
head := nil;
tail := nil;
inherited Create;
end;
procedure THread1.print1;
begin
list.AddNode(Memory);
end;
procedure THread2.print2;
begin
list.AddNode(Memory);
end;
procedure THread1.Execute;
var
i:Integer;
begin
for i:=1 to 30 do
begin
WaitForSingleObject(m,INFINITE);
Memory:=-i;
Synchronize(print1);
ReleaseMutex(m);
end;
end;
procedure THread2.Execute;
var
i:Integer;
begin
for i:=1 to 30 do
begin
WaitForSingleObject(m,INFINITE);
Memory:=i;
Synchronize(print2);
ReleaseMutex(m);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
m:=CreateMutex(nil,false,'Mutex');
t1:=THread1.Create(false);
t2:=THread2.Create(false);
list:=TList.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
node: PNode;
begin
Memo1.Clear;
node:=list.tail;
while node<>list.head.prev do
begin
Form1.Memo1.Lines.Add(IntToStr(node.i));
node:=node.prev;
end;
end;
end.
|
Синхронизация потоков с помощью критических секций Напишите программу, в которой один поток помещает произвольные числа в стек, а два других потока извлекают числа из стека и выводят их на экран. Стек реализовать на основе массива. lab9| Код |
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils,
windows;
type
Stack = class
m: array[0..100] of Integer;
public
constructor Create;
procedure Put(x: Integer);
function Get: Integer;
function IsEmpty: Boolean;
function IsFull: Boolean;
end;
var
h1,h2,h3:THandle;
st:Stack;
crit:RTL_CRITICAL_SECTION;
th_id1,th_id2,th_id3:Cardinal;
procedure Stack.Put(x:Integer);
begin
if (m[0]<100) then
begin
EnterCriticalSection(crit);
m[0]:=m[0]+1;
m[m[0]]:=x;
LeaveCriticalSection(crit);
end;
end;
function Stack.Get:Integer;
begin
Result:=0;
if (m[0]>0) then
begin
Result:=m[m[0]];
EnterCriticalSection(crit);
m[0]:=m[0]-1;
LeaveCriticalSection(crit);
end;
end;
function Stack.IsEmpty:Boolean;
begin
Result:=(m[0]=0);
end;
function Stack.IsFull:Boolean;
begin
Result:=(m[0]=100);
end;
constructor Stack.Create;
begin
m[0]:=0;
end;
procedure Th1;
var
i:Integer;
begin
for i:=1 to 100 do
begin
st.Put(i);
end;
end;
procedure Th2;
begin
while not st.IsEmpty do
begin
writeln('Th1: '+InttoStr(st.Get));
end;
end;
procedure Th3;
begin
while not st.IsEmpty do
begin
writeln('Th2: '+InttoStr(st.Get));
end;
end;
begin
InitializeCriticalSection(crit);
st:=Stack.Create;
h1:=CreateThread(nil,0,@Th1,nil,0,th_id1);
h2:=CreateThread(nil,0,@Th2,nil,0,th_id2);
h3:=CreateThread(nil,0,@Th3,nil,0,th_id3);
readln;
end.
|
Синхронизация потоков с помощью семафоров В парикмахерской работают два мастера, и одновременно может находиться не более 5 клиентов, ожидающих своей очереди. Через случайные промежутки времени в парикмахерскую пытаются попасть новые клиенты, но зайти они могут лишь в том случае, если есть свободные места. Если очередь не пуста, мастер вызывает из нее клиента и в течение случайного промежутка времени занимается его стрижкой, в противном случае мастер отдыхает.lab10| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure AddClient;
procedure DeleteClient;
private
{ Private declarations }
public
{ Public declarations }
end;
Thread1 = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
Thread2 = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
Thread3 = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
var
Form1:TForm1;
sem1,sem2:THandle;
t1:Thread1;
t2:Thread2;
t3:Thread3;
m1:array[1..5] of BOOL;
m2:array[1..2] of BOOL;
Panels:array[1..5] of TPanel;
Barber:array[1..2] of TPanel;
implementation
{$R *.dfm}
procedure TForm1.DeleteClient;
var
i:Integer;
res:BOOL;
begin
res:=false;
for i:=5 downto 1 do
begin
if m1[i]=true then
begin
m1[i]:=false;
res:=true;
break;
end;
end;
if res then
begin
Panels[i].Color:=$00ffffff;
end;
end;
procedure TForm1.AddClient;
var
i: integer;
res: bool;
begin
res:=false;
for i:=1 to 5 do
begin
if m1[i]=false then
begin
m1[i]:=true;
res:=true;
break;
end;
end;
if res then
begin
Panels[i].Color:=$000000ff;
end;
end;
procedure Thread1.Execute;
begin
while true do
begin
WaitForSingleObject(sem1,INFINITE);
Sleep(random(10)*100+500);
Form1.AddClient;
ReleaseSemaphore(sem2,1,nil);
end;
end;
procedure Thread2.Execute;
begin
while true do
begin
WaitForSingleObject(sem2,INFINITE);
Form1.DeleteClient;
ReleaseSemaphore(sem1,1,nil);
Barber[1].Color:=$00ff0000;
Sleep(random(10)*200+500);
Barber[1].Color:=$00ffffff;
Sleep(300);
end;
end;
procedure Thread3.Execute;
begin
while true do
begin
WaitForSingleObject(sem2,INFINITE);
Form1.DeleteClient;
ReleaseSemaphore(sem1,1,nil);
Barber[2].Color:=$00ff0000;
Sleep(random(10)*200+500);
Barber[2].Color:=$00ffffff;
Sleep(300);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i:Integer;
begin
for i:=1 to 5 do
begin
Panels[i]:=TPanel.Create(self);
Panels[i].Color:=$00FFFFFF;
Panels[i].Width:=40;
Panels[i].Height:=40;
Panels[i].Top:=10;
Panels[i].Left:=10+42*(i-1);
Panels[i].Parent := Self;
Panels[i].Caption:=IntToStr(i);
Panels[i].Show;
end;
for i:=1 to 2 do
begin
Barber[i]:=TPanel.Create(self);
Barber[i].Color:=$00FFFFFF;
Barber[i].Width:=40;
Barber[i].Height:=40;
Barber[i].Top:=120;
Barber[i].Left:=10+42*(i-1);
Barber[i].Parent := Self;
Barber[i].Caption:=IntToStr(i);
Barber[i].Show;
end;
sem1:=CreateSemaphore(nil,5,5,nil);
sem2:=CreateSemaphore(nil,0,5,nil);
t1:=THread1.Create(false);
t2:=THread2.Create(false);
t3:=THread3.Create(false);
end;
end.
|
|
Объекты ожидания в Delphi. Мьютекс, Семафор и Крит 
Загрузка ...
