Discussion :

[aimer_Delphi]

Bonsoir a tous,
SVP , y a t il une astuce pour limité le nombre d'instance a exécuté sur la même machine ,
par exemple interdire d'exécuté une instances de mon application plus de 5 fois.

j'ai vue la faq , mais c'est limité a une seul fois seulement.
cordialement.

[aimer_Delphi]

Bonsoir a tous,
j'ai trouvé la solution .

voici le source du Projet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
program Project1;
 
uses
  Forms,
Dialogs,Windows,TlHelp32,SysUtils,
  Unit1 in 'Unit1.pas' {Form1};
 
function ProcessCount(const ExeName: String): Integer;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize:= SizeOf(FProcessEntry32);
  ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
  Result:= 0;
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeName))) then
        Inc(Result);
    ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;
 
 
{$R *.res}
 
begin
    if ProcessCount(ExtractFileName(Application.ExeName)) > 2 then // je précise le nombre d'instances autorisés.
    begin
        MessageDlg('Application is already running!', mtError, [mbOK], 0);
        Application.Terminate;
    end
    else
    begin
        Application.Initialize;
        Application.CreateForm(TForm1, Form1);
        Application.Run;
    end;
end.

le lien de la solution
https://www.tek-tips.com/faqs.cfm?fid=7523
peut être ca va servir quelqu'un d'autre.
cordialement.

[Andnotor]

Ce code n'est pas très beau !

TH32CS_SNAPPROCESS retourne le nom de l'exécutable mais sans le chemin. Tous ces tests sont donc inutiles.

Utilise plutôt SameText qui fait une comparaison de chaînes sans tenir compte de la casse.

Une boucle First..Next s'écrit ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
if First then
repeat
until not Next;

Prend aussi l'habitude de protéger la libération d'un handle par un bloc try..finally.

Ce qui donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
function TForm1.InstanceCount: integer;
var
  FileName :TFileName;
  Handle   :THandle;
  Process  :TProcessEntry32;
 
begin
  Result         := 0;
  FileName       := ExtractFileName(Application.ExeName);
  Process.dwSize := SizeOf(TProcessEntry32);
  Handle         := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 
  try
    if Process32First(Handle, Process) then
    repeat
      if SameText(Process.szExeFile, FileName) then
        Inc(Result);
    until not Process32Next(Handle, Process);
 
  finally
    CloseHandle(Handle);
  end;
end;

Et dans le corps du programme, pourquoi appeler Application.Terminate puisqu'il n'y a pas d'Application.Run ?


Mais à l'instar du mutex pour une seule instance, tu peux ici aussi utiliser un objet de synchronisation : TSemaphore.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
uses SyncObjs;
 
var
  MaxInstance :TSemaphore;
 
begin
  //5 instances max
  MaxInstance := TSemaphore.Create(nil, 5, 5, 'MyApp_MaxInstanceCount', FALSE);
 
  try
    //WaitFor décrémente le compteur du sémaphore.
    //Timeout s'il est déjà à 0 => Exit.
    if MaxInstance.WaitFor(1) <> wrTimeout then
    try
      Application.Initialize;
      Application.MainFormOnTaskbar := True;
      Application.CreateForm(TForm1, Form1);
      Application.Run;
 
    finally
      //Incrémente le compteur, nouvelle instance possible.
      //IMPORTANT ! Free ne lance pas de Release !
      MaxInstance.Release;
    end;
 
  finally
    MaxInstance.Free;
  end;
end.

[aimer_Delphi]

Bonsoir,
Merci beaucoup pour la réponse ,
svp , je veux bien tester la solution des Semaphore ,
mais j'obtient une erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

identificateur non déclaré TSemaphore

.
je suis sous delphi 7.
amicalement.

[Lung]

Gestion des mutex (à améliorer):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
var
	H : THandle;
	Erreur: Integer;
begin
  SetLastError(NO_ERROR);
  H := CreateMutex(nil, False,'MONAPPLI');
  Erreur := GetLastError;
  if ( Erreur = ERROR_ALREADY_EXISTS ) or ( Erreur = ERROR_ACCESS_DENIED )
    then
    begin
    MessageDlg('MONAPPLI est déjà utilisé sur votre poste.'+#13+
    'Vous ne pouvez pas ouvrir 2 fois l''application.',mtInformation,[mbOK],0);
    CloseHandle(H);
    Exit;
  end;
 
//...
 
end;

[Andnotor]

La classe TSemaphore est l'encapsulation Delphi des API Windows mais elle ne simplifie pas tellement les choses, tellement les appels directs semblent identiques

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
uses Windows;
 
var
  MaxInstance :THandle;
 
begin
  //5 instances max
  MaxInstance := CreateSemaphore(nil, 5, 5, 'MyApp_MaxInstanceCount');
 
  try
    //WaitForSingleObject décrémente le compteur du sémaphore.
    //Timeout s'il est déjà à 0 => Exit.
    if WaitForSingleObject(MaxInstance, 1) <> WAIT_TIMEOUT then
    try
      Application.Initialize;
      Application.MainFormOnTaskbar := True;
      Application.CreateForm(TForm1, Form1);
      Application.Run;
 
    finally
      //Incrémente le compteur, nouvelle instance possible.
      ReleaseSemaphore(MaxInstance, 1, nil);
    end;
 
  finally
    CloseHandle(MaxInstance);
  end;
 
end.

A noter que si le nombre limite est fixé à 1, le comportement est similaire à celui du mutex