Per impedire che un programma venga eseguito più volte contemporaneamente, si può procedere in vari modi, vedremo di descriverne alcuni.
Il primo di questi metodi che andremo ad implementare consiste nel modificare il file di progetto inserendovi un check della "global atom table", che rimane a disposizione per tutte le applicazioni :
program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
var
atom: integer;
begin
if GlobalFindAtom('pippo') = 0 then
atom := GlobalAddAtom('pippo')
else
Exit;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
GlobalDeleteAtom(atom);
end.
Ogni volta che lanciamo il programma verrà controllata la "global atom table" tramite la funzione api GlobalFindAtom e se il programma non è in esecuzione verrà creata una voce nella suddetta tabella, mentre se il programma è già in esecuzione l'esecuzione verrà terminata. Alla fine di una normale terminazione del programma verrà rimossa la voce dalla atom table.
La funzione GlobalAddAtom aggiunge una stringa di caratteri alla "global atom table" e restituisce un valore unico (un "global atom") che identifica la stringa in questione.
La funzione GlobalFindAtom cerca, all' interno della "global atom table", la stringa di
caratteri specificata e ottiene il "global atom" associato con quella stringa.
Per maggiori informazioni sulla Global Atom Table vi suggerisco questo link.
Un altro metodo è quello di utilizzare un mutex.
program TestMutex;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
var
mHandle: THandle; // Mutexhandle
begin
mHandle := CreateMutex(nil, True, 'pippo');
if GetLastError = ERROR_ALREADY_EXISTS then
exit; // o halt
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
if mHandle <> 0 then CloseHandle(mHandle);
end.
Il mutex viene creato usando la funzione CreateMutex:
HANDLE CreateMutex(LPSECURITY_ATTRIBUTES lpMutexAttributes,
BOOL bInitialOwner,
LPCTSTR lpName);
Un altro modo è quello di usare un semaforo, che è molto simile ad un mutex, anzi per chi non lo sapesse un mutex è come se fosse un caso particolare di semaforo in cui l'accesso viene limitato sempre ad un solo thread, quindi un semaforo con la limitazione ad uno è del tutto analogo ad un mutex:
program TestSemaphore;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
var
Sem: THandle; // Semaphore handle
begin
Sem := CreateSemaphore(nil, 0, 1, 'pippo');
if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then begin
CloseHandle(Sem);
exit; // o halt
end;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Le modalità sono sempre le stesse solo che si usano entità diverse.
Nell'ultimo caso è stata usata la funzione CreateSemaphore:
HANDLE CreateSemaphore(
LPSECURITY_ATTRIBUTES lpSemaphoreAttributes, // SD
LONG lInitialCount, // initial count
LONG lMaximumCount, // maximum count
LPCTSTR lpName // object name
);
I problemi subentrano però quando un processo viene terminato in modo anormale. In questo caso infatti, in tutti i casi esposti fino ad ora, mancherebbe la parte finale del procedimento, ovvero la pulizia o azzeramento dell'istanza al termine dell'esecuzione del programma. Questo causerà una impossibilità di avviare il programma a meno che non venga riavviato il pc oppure non venga implementata una procedura straordinaria, eventualmente non un parametro opzionale che forzi l'avvio:
if (ParamCount=1)and(ParamStr(1)='-force') then begin
atom:=GlobalFindAtom('pippo');
end
else begin
if GlobalFindAtom('pippo')=0 then
atom:=GlobalAddAtom('pippo')
else
exit;
end;
Una soluzione ideale però invece potrebbe essere quella di verificare invece direttamente i processi in esecuzione, a quel punto se oltre alla istanza stessa in esecuzione venisse trovato almeno un altro processo l'esecuzione verrebbe interrotta. Per fare ciò useremo una funzione che conta i processi con lo stesso nome:
uses
...
TLHelp32,
SysUtils,
...
function FindNumberOfProcess(ExeFileName: string): integer;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
count:integer;
begin
count:=0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or
(UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then begin
inc(count);
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
Result := count;
CloseHandle(FSnapshotHandle);
end;
begin
if FindNumberOfProcess(ExtractFileName(Application.ExeName))>1 then
exit;
....
end.
Questa nonostante appaia più complicata delle altre tecniche risulta essere quella più efficace, perchè anche in caso di terminazione anomala consente la gestione della singola istanza di processo.
