Delphi/Free Pascal: very simple "old school" mutex

| category: Programming | author: st
Tags: ,

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