Mega Code Archive
Semaphores
<![CDATA[
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.
]]>