Semaphores

Whereas a Mutex may be used to allow only a single instance of your app, a Semaphore can be use to allow a specific number.

Creating semaphores

A Semaphore is created using the windows CreateSemaphore API command.



HANDLE CreateSemaphore(

  LPSECURITY_ATTRIBUTES lpSemaphoreAttributes,// security attributes

  LONG lInitialCount, // initial count

  LONG lMaximumCount, // maximum count

  LPCTSTR lpName // pointer to semaphore-object name

);



Example

HSemaphore := CreateSemaphore(nil, MaximumInstances,

  MaximumInstances,PChar(UniqueName));



Unique name must be a Windows-wide unique identifier, I recommend that you use CompanyName.ProductName, or even a GUID (Press CTRL+SHIFT+G to generate a GUID at design time).



Here is a class wrapper for a SemaPhore, create an instance of the class and use LOCK to use a reserved place and Unlock to release it.



unit Semaphores;



interface

uses

  Windows, SysUtils;



const

  cSemaphoreCannotCreate = 'Cannot create semaphore';



type

  ESemaphoreError = class(Exception);



  TSemaphore = class

  private

    HSemaphore : THandle;

    FLocked : Boolean;

  public

    Constructor Create(UniqueName : string;

         MaximumInstances : Integer); virtual;

    destructor Destroy; override;



    function Lock(aTimeoutMilliseconds : DWord) : Boolean;

    procedure UnLock;



    property Locked: Boolean read FLocked;

  end;



implementation



{ TSemaphore }



constructor TSemaphore.Create(UniqueName: String;

  MaximumInstances: Integer);

begin

  inherited Create;

  FLocked := False;

  HSemaphore := 0;

  HSemaphore := CreateSemaphore(nil,MaximumInstances,MaximumInstances,PChar(UniqueName));



  if HSemaphore = 0 then

    raise ESemaphoreError.Create(cSemaphoreCannotCreate);



end;



destructor TSemaphore.Destroy;

begin

  UnLock;

  inherited;

end;



function TSemaphore.Lock(aTimeoutMilliseconds: DWord): Boolean;

var

  Res : Integer;

begin

  Res := WaitForSingleObject(hSemaphore, aTimeoutMilliseconds);

  Result := (Res in [WAIT_ABANDONED, WAIT_OBJECT_0]);

  if Result then FLocked := True;

end;



procedure TSemaphore.UnLock;

begin

  if not Locked then exit;

  ReleaseSemaphore(hSemaphore,1,nil);

end;



end.