Delphi/Free Pascal: very simple "old school" mutex
The code below show how to implement very simple but cross-platform "old school" mutex (mutually exclusive semaphore)
interface
type
TMutex = class
private
FFileHandle: integer;
public
constructor Create(const AName: string; const WaitForMSec: integer = 10000);
destructor Destroy; override;
end;
implementation
uses
Classes, SysUtils, DateUtils,
{$IFDEF MSWINDOWS}
Windows
{$ENDIF};
function GetTempDir: string;
begin
{$IFDEF MSWINDOWS}
SetLength(Result, 255);
SetLength(Result, GetTempPath(255, (PChar(Result))));
{$ENDIF}
{$IFDEF LINUX}
Result := GetEnv('TMPDIR');
if Result = '' then
Result := '/tmp/'
else if Result[Length(Result)] <> PathDelim then
Result := Result + PathDelim;
{$ENDIF}
end;
constructor TMutex.Create(const AName: string; const WaitForMSec: integer);
function NextAttempt(const MaxTime: TDateTime): boolean;
begin
Sleep(1);
Result := Now < MaxTime;
end;
var
MaxTime: TDateTime;
LockFileName: string;
begin
inherited Create;
LockFileName := IncludeTrailingPathDelimiter(GetTempDir) + AName + '.tmp';
MaxTime := IncMillisecond(Now, WaitForMSec);
repeat
if FileExists(LockFileName) then
FFileHandle := FileOpen(LockFileName, fmShareExclusive)
else
FFileHandle := FileCreate(LockFileName, fmShareExclusive);
until (FFileHandle <> -1) or not NextAttempt(MaxTime);
if FFileHandle = -1 then
raise Exception.CreateFmt('Unable to lock mutex (File: %s; waiting: %d msec)', [LockFileName, WaitForMSec]);
end;
destructor TMutex.Destroy;
begin
if FFileHandle <> -1 then
FileClose(FFileHandle);
inherited;
end;
Use case example.
with TMutex.Create('MyMutex') do
try
... // protected code here
finally
Free;
end;
blog comments powered by Disqus