Submitted by Serguei_Tarassov on
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;