Programme qui se ferme si une autre instance est déjà démarrée

**sgmsg** · 26/11/2015, 15h28

Bonjour à tous

J'ai trouvé comment vérifier si une application tourne avant de la lancer...

J'aimerais plutôt que l'application se ferme d'elle-même si une autre instance tourne déjà.

Merci d'avance.

**ShaiLeTroll** · 26/11/2015, 19h44

Utilise des MUTEX comme dans la

Comment n'instancier qu'une seule fois un programme ?

Un vieux code de 2002 (il peut être même plus vieux, c'est inspiré d'un exemple de Phidels) qui en plus met la fenêtre de la précédente instance au premier plan
Avec les Delphi gère différemment la MainForm cela peut ne pas fonctionner (MainFormOnTaskbar à False)

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
unit Unique_Instance;
 
{
 dans la projet :
 
Application.Initialize;
Application.Title := 'Titre du Programme';
if not UniqueInstance(Application.Title) then Exit;
Application.CreateForm(TMenuFrm, MenuFrm);
Application.Run;
 }
 
 
interface
 
uses
    forms,windows,sysutils;
 
type
  PFindWindowStruct = ^TFindWindowStruct;
  TFindWindowStruct = record
    Caption: string;
    ClassName: string;
    WindowHandle: THandle;
  end;
 
function UniqueInstance(Nom: String): boolean;
procedure GoMainApp(Nom: String);
function FindAWindow(ACaption: string): THandle;
function EnumWindowsProc(hWindow: hWnd;lParam : LongInt): Boolean; stdcall;
 
implementation
 
function UniqueInstance(Nom: String): boolean;
begin
  CreateMutex(nil, False, PChar(Nom));
  Result := GetLastError <> ERROR_ALREADY_EXISTS;
  if not Result then GoMainApp(Application.Title);
end;
 
 
 
procedure GoMainApp(Nom: String);
var
  ActifHnd: THandle;
begin
     ActifHnd:= FindAWindow(Nom);
     if ActifHnd <> 0 then begin
       ShowWindow(ActifHnd, SW_NORMAL);
       SetForegroundWindow(ActifHnd);
     end;
end;
 
function FindAWindow(ACaption: string): THandle;
var
  WindowInfo: TFindWindowStruct;
begin
     with WindowInfo do begin
          Caption:= ACaption;
          ClassName:= '';
          WindowHandle:= 0;
          EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo));
          result:= WindowHandle;
          //showmessage(IntTostr(result));
 
     end;
end;
 
function EnumWindowsProc(hWindow: hWnd;lParam : LongInt): Boolean; stdcall;
var
  lpBuffer: PChar;
  WindowCaptionFound: bool;
  ClassNameFound: bool;
 
begin
     GetMem(lpBuffer, 255);
     Result:= True;
     WindowCaptionFound:= False;
     ClassNameFound:= False;
     try
        if GetWindowText(hWindow, lpBuffer, 255) > 0 then
           if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) = 1 then begin
              WindowCaptionFound:= true;
              if PFindWindowStruct(lParam).ClassName = '' then
            ClassNameFound:= True
         else if GetClassName(hWindow, lpBuffer, 255) > 0 then
              if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer)) > 0 then
                 ClassNameFound:= True;
      end;
    if (WindowCaptionFound and ClassNameFound) then begin
      PFindWindowStruct(lParam).WindowHandle:= hWindow;
      Result:= False;
    end;
 
  finally
    FreeMem(lpBuffer, sizeof(lpBuffer^));
  end;
end;
 
end.

**sgmsg** · 27/11/2015, 05h14

Merci Shai

T'es vraiment top. Merci beaucoup.

Je me demande bien comment je pourrai te rendre la pareille.

Pour des algos, des simplications laisse moi savoir

Merci encore

A+

**exyacc** · 27/11/2015, 12h30

moi, j'utilise le composant JvAppInstances que se trouve dans la bibliothèque Jedi - JVCL au cas ou tu aurais cette bibliothèque ...

**Andnotor** · 27/11/2015, 16h46

Envoyé par ShaiLeTroll

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
function EnumWindowsProc(hWindow: hWnd;lParam : LongInt): Boolean; stdcall;
var
  lpBuffer: PChar;
  WindowCaptionFound: bool;
  ClassNameFound: bool;
 
begin
     GetMem(lpBuffer, 255);
     Result:= True;
     WindowCaptionFound:= False;
     ClassNameFound:= False;
     try
        if GetWindowText(hWindow, lpBuffer, 255) > 0 then
           if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) = 1 then begin
              WindowCaptionFound:= true;
              if PFindWindowStruct(lParam).ClassName = '' then
            ClassNameFound:= True
         else if GetClassName(hWindow, lpBuffer, 255) > 0 then
              if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer)) > 0 then
                 ClassNameFound:= True;
      end;
    if (WindowCaptionFound and ClassNameFound) then begin
      PFindWindowStruct(lParam).WindowHandle:= hWindow;
      Result:= False;
    end;
 
  finally
    FreeMem(lpBuffer, sizeof(lpBuffer^));
  end;
end;
 
end.

J'invoquais dernièrement SetProp/GetProp et c'est typiquement un cas où je l'utiliserais :

Code :

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

1
2
3
4
5
6
7
8
9
procedure TForm1.FormCreate(Sender: TObject);
begin
  SetProp(Handle, 'MonAppIdentifier', 1);
end;
 
function EnumWindowsProc(hWindow: hWnd;lParam : LongInt): Boolean; stdcall;
begin
  Result := GetProp(hWindow, 'MonAppIdentifier') = 1;
end;

Plus léger non

De plus, ça fonctionne même si le titre de la fenêtre est sujet à variation

**ShaiLeTroll** · 30/11/2015, 10h29

l'API SetProp est très intéressante !

Je ne connaissais pas !

Si un jour j'ai l'occasion de mettre un UniqueInstance dans une application ce que je n'ai pas fait depuis des années, j'utiliserais ton astuce !

J'y vois aussi un intérêt pour ma classe d'échange de données inter-process !