１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"マルチスレッド、ミューテクスで衝突回避"
unit StartF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, S
tdCtrls;
type
TStart = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Start: TStart;
Mut : THandle;
fflag : Boolean;
implementation
uses MainF;
{$R *.DFM}
procedure TStart.Button1Click(Sender: TObject);
begin
fflag := False;//現在、ファイル未使用。
Mut := (nil,False,'FindMut');
Main.showmodal;
(Mut);
end;
end.
/////////////////////
unit MainF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, St
dCtrls, Thread1, Thread2;
type
TMain = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
thr1 : TThrd1;
thr2 : TThrd2;
procedure ThrEnd1(Sender:TObject);
procedure ThrEnd2(Sender:TObject);
end;
var
Main: TMain;
ThrOn1 : Boolean;
ThrOn2 : Boolean;
implementation
{$R *.DFM}
procedure TMain.Button1Click(Sender: TObject);
begin
if ThrOn1 then
begin
ShowMessage('スレッド１は現時点ではまだ起動できません。'); Exit;
end;
Thr1 := TThrd1.Create(Edit1,False);
Thr1.OnTerminate := ThrEnd1; ThrOn1 := True;
end;
procedure TMain.Button2Click(Sender: TObject);
begin
if ThrOn2 then
begin
ShowMessage('スレッド２は現時点ではまだ起動できません。'); Exit;
end;
Thr2 := TThrd2.Create(Edit2,False);
Thr2.OnTerminate := ThrEnd2; ThrOn1 := True;
end;
procedure TMain.ThrEnd1(Sender:TObject);
begin
ThrOn1 := False;
end;
procedure TMain.ThrEnd2(Sender:TObject);
begin
ThrOn2 := False;
end;
procedure TMain.FormShow(Sender: TObject);
label 15;
var
iiii : Integer;
datf : TextFile;
begin
AssignFile(datf,'datafile.txt');
rewrite(datf);
writeln(datf,'1'); writeln(datf,'2');writeln(datf,'3');writeln(datf,'4');wri
teln(datf,'5');
writeln(datf,'6'); writeln(datf,'7');writeln(datf,'8');writeln(datf,'9');wri
teln(datf,'10');
CloseFile(datf);
end;
end.
/////////////////////
unit Thread1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, St
dCtrls;
type
TThrd1 = class(TThread)
private
procedure proc1;
procedure proc2;
procedure proc3;
procedure check;
protected
procedure Execute; override;
public
constructor Create(E1:TEdit;f:Boolean);
end;
implementation
uses StartF, MainF;
var
EE1 : TEdit;
datadata : array[0..10] of Char;
okflag1 : Boolean;
{ TThrd1 }
constructor TThrd1.Create(E1:TEdit;f:Boolean);
begin
inherited Create(f);
ThrOn1 := f;
EE1 := E1;
FreeOnTerminate := True;
end;
procedure TThrd1.proc1;
begin
EE1.Text := 'ファイル使用の許可待ち。';
end;
procedure TThrd1.proc2;
var
ttt : Integer;
begin
EE1.Text := datadata;
ttt := GetTickCount + 240;
repeat
Application.ProcessMessages;
until GetTickCount > ttt;
end;
procedure TThrd1.proc3;
begin
EE1.Text := 'スレッド１は終了しました。';
end;
procedure TThrd1.check;
begin
okflag1 := False;
if fflag = False then
begin
fflag := True;
okflag1 := True;
end;
end;
procedure TThrd1.Execute;
label 12;
label 15;
var
filepp : TextFile;
ttt : Integer;
begin
15:
(Mut,INFINITE);
check;
(Mut);
if okflag1 then
begin
AssignFile(filepp,'datafile.txt');
Append(filepp);
writeln(filepp,'20'); writeln(filepp,'30'); writeln(filepp,'40');
CloseFile(filepp);
AssignFile(filepp,'datafile.txt');
reset(filepp);
12: readln(filepp,datadata);
synchronize(proc2);
if eof(filepp) then
begin
CloseFile(filepp);
WaitForSingleObject(Mut,INFINITE);
fflag := False;
ReleaseMutex(Mut);
Exit;
end;
goto 12;
end
else
begin
synchronize(proc1);
ttt := GetTickCount + 150;
repeat
Application.ProcessMessages;
until GetTickCount > ttt;
goto 15;
end;
end;
end.
/////////////////////
unit Thread2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, St
dCtrls;
type
TThrd2 = class(TThread)
private
procedure proc1;
procedure proc2;
procedure proc3;
procedure check;
protected
procedure Execute; override;
public
constructor Create(E1:TEdit;f:Boolean);
end;
implementation
uses StartF, MainF;
var
EE1 : TEdit;
datadata : array[0..10] of Char;
okflag2 : Boolean;
{ TThrd2 }
constructor TThrd2.Create(E1:TEdit;f:Boolean);
begin
inherited Create(f);
ThrOn2 := f;
EE1 := E1;
FreeOnTerminate := True;
end;
procedure TThrd2.proc1;
begin
EE1.Text := 'ファイル使用の許可待ち。';
end;
procedure TThrd2.proc2;
var
ttt : Integer;
begin
EE1.Text := datadata;
ttt := GetTickCount + 240;
repeat
Application.ProcessMessages;
until GetTickCount > ttt;
end;
procedure TThrd2.proc3;
begin
EE1.Text := 'スレッド２は終了しました。';
end;
procedure TThrd2.check;
begin
okflag2 := False;
if fflag = False then
begin
fflag := True; okflag2 := True;
end;
end;
procedure TThrd2.Execute;
label 12;
label 15;
var
filepp : TextFile;
ttt : Integer;
begin
15:
WaitForSingleObject(Mut,INFINITE);
check;
ReleaseMutex(Mut);
if okflag2 then
begin
AssignFile(filepp,'datafile.txt');
Append(filepp);
writeln(filepp,'200'); writeln(filepp,'300'); writeln(filepp,'400');
CloseFile(filepp);
AssignFile(filepp,'datafile.txt');
reset(filepp);
12: readln(filepp,datadata);
synchronize(proc2);
if eof(filepp) then
begin
CloseFile(filepp);
WaitForSingleObject(Mut,INFINITE);
fflag := False;
ReleaseMutex(Mut);
Exit;
end;
goto 12;
end
else
begin
synchronize(proc1);
ttt := GetTickCount + 150;
repeat
Application.ProcessMessages;
until GetTickCount > ttt;
goto 15;
end;
end;
end.
Original document by 竹花 忠 氏 ID:(VZN00647)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。