...verhindern, dass ein Programm mehrmals gestartet wird?

//1. CreateMutex

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.

printed from
www.swissdelphicenter.ch
developers knowledge base