منع المستخدم من فتح اكثر من نسخة لنفس البرنامج في الدلفي

unit Unit1;

uses
Windows, Dialogs, Sysutils;

{....}
implementation

{....}

var
mHandle: THandle; // Mutexhandle

initialization
mHandle := CreateMutex(nil, True, 'XYZ');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
ShowMessage('Program is already running!');
halt;
end;

finalization
if mHandle <> 0 then CloseHandle(mHandle)
end.

{
HANDLE CreateMutex(LPSECURITY_ATTRIBUTES lpMutexAttributes,
BOOL bInitialOwner,
LPCTSTR lpName);

lpMutexAttributes:
Ignored. Must be NULL.

bInitialOwner:
Boolean that specifies the initial owner of the mutex object.
If this value is TRUE and the caller created the mutex,
the calling thread obtains ownership of the mutex object.
Otherwise, the calling thread does not obtain ownership of the mutex.

lpName:
Long pointer to a null-terminated string specifying the name of the mutex object.
The name is limited to MAX_PATH characters and can contain any character except the
backslash path-separator character (\). Name comparison is case sensitive.

Return Values:
A handle to the mutex object indicates success.
If the named mutex object existed before the function call,
the function returns a handle to the existing object and GetLastError
returns ERROR_ALREADY_EXISTS.

}

{******************************************************************}

// 2. CreateSemaphore
// (Alternative Funtion, Alternative Funktion)

procedure TForm1.FormCreate(Sender: TObject);
var
Sem: THandle;
begin
Sem := CreateSemaphore(nil, 0, 1, 'PROGRAM_NAME');
if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
begin
CloseHandle(Sem);
ShowMessage('This program is already running.');
Halt;
end;
end;

{
HANDLE CreateSemaphore(
LPSECURITY_ATTRIBUTES lpSemaphoreAttributes, // SD
LONG lInitialCount, // initial count
LONG lMaximumCount, // maximum count
LPCTSTR lpName // object name
);

lpSemaphoreAttributes:
[in] Pointer to a structure that determines whether the returned handle
can be inherited by child processes.
If lpSemaphoreAttributes is NULL, the handle cannot be inherited.

lInitialCount:
[in] Specifies an initial count for the semaphore object.
This value must be greater than or equal to zero and less
than or equal to lMaximumCount.

lMaximumCount:
[in] Specifies the maximum count for the semaphore object.
This value must be greater than zero.

lpName
[in] Pointer to a null-terminated string specifying the name
of the semaphore object. The name is limited to MAX_PATH characters.
Name comparison is case sensitive.
}

{******************************************************************}

// 3: GlobalFindAtom, GlobalAddAtom

{
This sample shows how to determine if your program was
running in a current session of Windows
It can be usefull if you want ie. to limit your program (a demo)
to run only once per session. It can be stimulating for a registering. :
}

// Place in FormShow event:

procedure TForm1.FormCreate(Sender: TObject);
var
atom: Integer;
CRLF: string;
begin
if GlobalFindAtom('A Text used to be stored in memory') = 0 then
atom := GlobalAddAtom('A Text used to be stored in memory')
else
begin
CRLF := #10 + #13;
ShowMessage('This version may only be run once for every Windows Session.' +
CRLF +
'To run this program again, you need to restart Windows, or better yet:' +
CRLF +
'REGISTER !!');
Close;
end;
end;

// All you had to do was to write some "your" text and
// save it in the Windows global atom table.