Mega Code Archive
Semaphore and mutex
<![CDATA[
Title: Semaphore and mutex
Question: Understanding semaphores and mutex
Answer:
In windows there are 4 synchronization objects to use with multithreading applications :
1- Critical Section
2- Event
3- Semaphore
4- Mutex
but in Delphi there is no encapsulation for Mutex or Semaphore there is only TCriticalSection and TEvent and they are implemented in SyncObjs Unit
Semaphores :
Semaphores Objects are used to manipulate a group of threads.
To make specified count of threads work together.
For example .. you have a file on your hard disk that share some info using a network application and you dont want more than 4 connections to access this file simultaneously for performance reasons but there is 10 connections currently connected to you application and all of them need to access this file .
So you have to Synchronize between 10 connections by letting 4 connections only access this file simultaneously .. in this case you have to use Semaphore
You need this list of function to handle semaphore object
CreateSemaphore //used to make new object and specify
//number of threads that can gain access
//in the same time
OpenSemaphore //access already exist object by name
CloseHandle //release handle of opened handle to the object
ReleaseSemaphore //decrement count of threads that use semaphore
WaitForSingleObject //make thread wait to gain access from semaphore
//and increment count of threads by one
I have made this example to demonstrate how semaphores work
This example show you how to move specified count of balls together
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Contnrs;
type
TMainForm = class(TForm)
btnSimultaneousRunningThreads: TButton;
procedure btnSimultaneousRunningThreadsClick(Sender: TObject);
private
//this array hold balls positions
//each slot in this array is used for one ball
//and each value should be between 0 and 100
FBalls:array[1..10] of byte;
FThreadsList:TObjectList;
//Handle for Semaphore Object
FSemaphore:Cardinal;
protected
procedure DoCreate; override;
procedure DoClose(var Action: TCloseAction); override;
procedure Paint; override;
{ Private declarations }
public
destructor Destroy; override;
procedure LaunchThreads;
procedure DestroyThreads;
end;
TModifyThread=class(TThread)
protected
procedure DoTerminate; override;
protected
FForm:TMainForm;
FSlot:Byte;//Slot of FBalls array that
//used to define visual ball position
procedure Execute; override;
end;
var
MainForm: TMainForm;
implementation
procedure TMainForm.DoClose(var Action: TCloseAction);
begin
inherited;
DestroyThreads;
CloseHandle(FSemaphore);
end;
procedure TMainForm.Paint;
var
x:Integer;
i:Integer;
BallPos:Integer;
R:TRect;
begin
inherited;
Canvas.Brush.Color:=clWhite;
Canvas.FillRect(ClientRect);
x:=ClientWidth div 11;
//this loop is used to draw 10 lines with 10 balls on them
//on each line there is ball that is differ in it's position
//according to the corresponding slot in FBalls array
for i:=1 to 10 do
begin
Canvas.Pen.Color:=clBlue;
Canvas.Pen.Width:=2;
Canvas.PenPos:=Point(x * i,20);
Canvas.LineTo(x * i,ClientHeight-20);
BallPos:=FBalls[i];
R.Top:=(ClientHeight-20) - ( (ClientHeight-40)*(BallPos) div 100 ) -5;
R.Left:=(x*i) -5;
R.Right:=R.Left +10;
R.Bottom:=R.Top+10;
Canvas.Brush.Color:=clRed;
Canvas.Pen.Width:=1;
Canvas.Pen.Color:=clRed;
Canvas.Ellipse(R);
end;
end;
{ TModifyThread }
procedure TModifyThread.DoTerminate;
begin
inherited;
FForm.FThreadsList.Extract(Self);
end;
procedure TModifyThread.Execute;
var
x:Integer;
Semaphore:Cardinal;
begin
inherited;
//Access already created semaphore object by name
Semaphore:=OpenSemaphore(EVENT_ALL_ACCESS,false,'My Semaphore');
while true do
begin
//this function will hold the execution of the current thread
//unitl the state of Semphore object turn to Signaled state
WaitForSingleObject(Semaphore,INFINITE);
Sleep(250);
//Change current position of the ball
x:=FForm.FBalls[FSlot]+10;
if x100 then x:=0;
FForm.FBalls[FSlot]:=x;
FForm.Invalidate;
Sleep(250);
//Mean current thread finished with semaphore object
//to let another threads get access
ReleaseSemaphore(Semaphore,1,nil);
if Terminated then
begin
CloseHandle(Semaphore);
exit;
end;
end;
CloseHandle(Semaphore);
end;
procedure TMainForm.btnSimultaneousRunningThreadsClick(Sender: TObject);
var
Num:Integer;
val:String;
begin
DestroyThreads;
CloseHandle(FSemaphore);
//Be sure to close all opened handles of our semaphore
//in order to destroy it
if InputQuery('','Enter number simultaneous runing threads'+sLineBreak+
'this value should be between 1 and 10',val) then
begin
Num:=StrToIntDef(Val,0);
if Num10 then
Num:=10
else if Num Num:=1;
//Recreate Simaphore Object with new options
FSemaphore:=CreateSemaphore(nil,Num,Num,'My Semaphore');
end;
LaunchThreads;
end;
destructor TMainForm.Destroy;
begin
FThreadsList.Free;
inherited;
end;
procedure TMainForm.DestroyThreads;
//this function used to terminate all instances of threads
//and wait until we be sure that no thread is still running
var
i:Integer;
begin
for i:=0 to FThreadsList.Count-1 do
TThread(FThreadsList[i]).Terminate;
while FThreadsList.Count0 do
Application.ProcessMessages;
end;
procedure TMainForm.LaunchThreads;
function CreateThread(Slot: Byte): TModifyThread;
begin
result:=TModifyThread.Create(true);
result.FForm:=Self;
result.FSlot:=Slot;
result.Resume;
FThreadsList.Add(result);
end;
var
i:byte;
begin
DestroyThreads;
for i:=1 to 10 do
CreateThread(i);
end;
procedure TMainForm.DoCreate;
begin
inherited;
//This list is used to hold created instances of threads
//in order to manipulate them
FThreadsList:=TObjectList.Create(false);
DoubleBuffered:=true; //in order to prevent flickering
//Create Semphore Object with specified name
FSemaphore:=CreateSemaphore(nil,10,10,'My Semaphore');
//Create 10 instances of TModifyThread
LaunchThreads;
end;
Mutex :
Mutex object is not used only to synchronize between threads with in single process, you can also use it to synchronize between multiple threades in more than one process and to synchronize between processes it selves.
For example you can ensure that there is only one instance of your application by creating a mutex with specified name when you launch you application.
But before you create your mutex you should insure that there is no other mutex created before with the same name or that will mean there is another instance already running now .
And you have to destroy your mutex when you terminate your application to let another instances work .
CreateMutex //create new mutex object with specified name
OpenMutex //get handle to already running mutex by its name
WaitForSingleObject //wait for ownership to the mutex
ReleaseMutex //release ownership of mutex and let another threads
//be able to take ownership
CloseHandle //close opened Mutex and destroy it when no more
//handles opened
For example to prevent more than one instance of you application work
Just modify you application DPR file to look like this
program MyProgram;
uses
Forms,
Dialogs,
MainForm in 'MainForm.pas',
Windows;
{$R *.res}
var
Mutex:Cardinal;
Begin
//look for previous created mutex with our application name
Mutex:=OpenMutex(MUTEX_MODIFY_STATE,false,'My Application Name');
if Mutex0 then
begin
CloseHandle(Mutex);
ShowMessage('There is another instance of this application already running');
exit;
end;
//there is no previous Mutex so create new one
Mutex:=CreateMutex(nil,false,'My Application Name');
//take ownership of our mutex
WaitForSingleObject(Mutex,INFINITE);
//run program main loop
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
//destroy our mutex
CloseHandle(Mutex);
end.
]]>