Add new comment

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;