whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

157 Visitors Online


 
...load only one instance of a program?
Autor: Simon Grossenbacher
Homepage: http://www.swissdelphicenter.ch
[ Print tip ]  

Tip Rating (41):  
     


//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.

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners