Delphi FAQ

Jak zablokować wielokrotne uruchomie programu

Drajwer

Aby zablokować wielokrotne uruchamianie tej samej aplikacji w obrębie jednego systemu, można zastosować jeden ze sposobów przedstawionych w tej wskazówce.

W pliku głównym *.dpr, można umieścić kod tworzący muteks:

program Foo;
 
uses
  Forms ,
  windows,
  Unit1 in 'Unit1.pas' {Form1};
 
{$R *.RES}
 
begin
//Tu sie zaczyna ten kod
 CreateMutex(nil, FALSE, 'UNIKALNA_NAZWA');
   if GetLastError() <> 0 then Halt;
//A tu kończy
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Oczywiście tam gdzie UNIKALNA_NAZWA można wpisać dowolną nazwę. Taki sam można umieścić w zdarzeniu OnCreate głównego formularza:

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateMutex(nil, FALSE, 'UNIKALNA_NAZWA'); 
    if GetLastError() <> 0 then Halt;
end;

Drugi sposób to skorzystanie z funkcji FindWindow i sprawdzenie czy okno o podanej nazwie jest już otwarte:

var
  h_wnd : HWND;
begin
  h_wnd := FindWindow('TForm1', 'Form1');
  if h_wnd <> 0 then ShowWindow(h_WND, SW_SHOWMAXIMIZED); //pokaż jesli jest na listwie
    else 
  begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
  //nie zapomnij przy zamknięciu aplikacji 
  Form1 := nil;
end;

Sprawdzona wersja (działająca) dla mechanizmu blokującego równoczesne uruchomienie więcej niż jednej kopii programu.
Dla uproszczenia nazwię go CMutex.

Modyfikacji podlegają dwa pliki:

  1. Główny plik aplikacji (Nazwa.dpr):
program CMutex;
 
uses
  Forms, Windows,
  Unit1 in 'Unit1.pas' {Form1};
 
{$R *.res}
 
var
  Handle: THandle;
 
begin
  MessID := RegisterWindowMessage('"NazwaMutexuTwojejAplikacji"');
  try
    Handle := CreateMutex(nil, True, '"NazwaMutexuTwojejAplikacji"');
    if GetLastError = ERROR_ALREADY_EXISTS then 
      begin
        PostMessage(HWND_BROADCAST, MessID, 0, 0);
      end 
        else 
      begin
        Application.Initialize;
        Application.CreateForm(TForm1,Form1);
        Application.Run;
        Application.Terminate;
      end;
  finally
    if Handle <> 0 then CloseHandle(Handle);
  end;
end.

Dopisz w klauzuli uses
Windows

Zdeklaruj zmienną
Handle typu THandle

Dopisz w kodzie

  MessID := RegisterWindowMessage('"NazwaMutexuTwojejAplikacji"');
  try
    Handle := CreateMutex(nil, True, '"NazwaMutexuTwojejAplikacji"');
    if GetLastError = ERROR_ALREADY_EXISTS then 
      begin
        PostMessage(HWND_BROADCAST,MessID,0,0);
      end 
        else 
      begin
        //[...]
      end;
  finally
    if Handle <> 0 then CloseHandle(Handle);
  end;

Edytor Delphi wskaże MessID jako nie znaną - zostanie ona zdeklarowana w module Unit1.pas

Zwróć uwagę, że przedstawione rozwiązanie zakłada, że Aplikacja posiada unikalny swój Mutex. "NazwaMutexuTwojejAplikacji"
Najprostsze rozwiązanie, to pobierz program InnoSetup oraz ISTool, a następnie w programie ISTool:
Menu Projekt>Opcje Instalatora>Aplikacja znajdziesz pozycję "Mutex aplikacji" >
Wpisz unikalną nazwę, którą wpisujesz także w kodzie programu
zamiast "NazwaMutexuTwojejAplikacji"

2.Plik aplikacji (Unit1.pas):

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
 
type
  TForm1 = Class(TForm)
    Procedure FormCreate(Sender:TObject);
  private
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  MessID: UINT;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
Begin
  if Msg.Message = MessID then 
    begin
      Application.Restore;
      SetForeGroundWindow(Application.MainForm.Handle);
      Handled:=True;
    end;
end;
 
Procedure TForm1.FormCreate(Sender:TObject);
begin
  Application.OnMessage := AppMessage;
end;
 
end.
  1. Zmiany w sekcji uses dopisz StdCtrls
  2. W sekcji Private dopisz procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  3. Zdeklaruj zmienną MessID typu UINT
  4. Dopisz treść procedury AppMessage
  5. Standartowo utwórz zdarzenie OnCreate i wpisz w nim Application.OnMessage := AppMessage;

Powyższy kod sprawdziłem na Borland® Delphi® for Microsoft® Windows™
Pozdrawiam wszystkich.

Zobacz też:

FAQ

10 komentarzy

...
Uses Windows,....
...

CreateMutex(nil, FALSE, 'XYX');
If GetLastError() < 0 Then Begin
Application.Terminate;
End Else Begin
Application.Initialize;
Application.Title := XYX;
Application.CreateForm(TForm1, Form1);
Application.Run;
Application.Terminate;
End;

procedure TForm1.FormCreate(Sender: TObject);
var
hM: HDC;
begin
hM:=CreateFileMapping(THANDLE($FFFFFFFF),nil,
PAGE_READONLY,0,32,'ApplicationTestMap');
if GetLastError=ERROR_ALREADY_EXISTS then
begin
Application.Terminate;
CloseHandle(hM);
end;
end;

CreateMutex działa świetnie w przypadku sprawdzania instancji aplikacji w której jest zaimplementowany. Czyli jeżeli sprawdzamy czy istnieje program "XYZ" w programie "XYZ" to działa to super. Natomiast przypuśćmy że do programu "XYZ" napisany jest jeszcze inny "ABC". I "ABC" sprawdza, czy istnieje "XYZ". Jeżeli tak, to uruchamia się, w przeciwnym wypadku oczywiście jest odmiennie:

W programie "ABC" ustalamy:
CreateMutex(nil, FALSE, 'TYTUŁ_XYZ');

Niestety zawsze tu wychodzi Error = 0 czyli "operacja powiodła się", co oznacza nie mniej ni wiecej tylko tyle że "XYZ" nie jest uruchomiony... nieważne czy działa czy nie. Tutaj raczej FindWindow sprawdzi się lepiej, chyba że istnieje obejście tego problemu?

można i tak

var
h_wnd:HWND;
begin
h_wnd:= findwindow('TForm1','Form1');
if h_wnd<0 then begin
ShowWindow(h_WND,SW_SHOWMAXIMIZED);//pokaż cały
end
else begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;

Kilka linków:

wersja dla BCB:
http://4programmers.net/Forum/viewtopic.php?id=25186

Ograniczenie do dowolnej ilości kopii (np. 3)
http://4programmers.net/Forum/viewtopic.php?id=42359

częste powiązanie tego problemu z komponentem CoolTrayIcon i przywracaniem programu po uruchomieniu drugiej kopii (jak np. WinAmp)
http://4programmers.net/Forum/viewtopic.php?id=42501

flabra - Twoja wersja nie jest dobra - CreateMutex jest tu najlepszym i zalecanym rozwiązaniem - często go stosuję.
A dlaczego FindWindow odpada? Ano istnieje możliwość, że przy szybkim uruchamianiu kolejnych egzemplarzy programu aplikacja odpali się, ale jeszcze nie zdąży stworzyć okna. W tym czasie uruchomi się drugi egzemplarz i będziesz miał więcej niż jedną wersję programu uruchomioną. CreateMutex gwarantuje zabezpieczenie przed takim przypadkiem.

program prog;
uses windows,...; //
begin
hWnds:=findwindow(myclassname,myprogname);
if hWnds<0 then
begin
showwindowasync(hWnds,sw_show);
halt
end;
// reszta kodu
end.

I papa.

Wystarczy że wpiszesz
Aplication.messagebox();

Ja bym jeszcze sprubował wżucić do "GetLastError() < 0 Then" ShowMessage + komunikat i dopiero halt... ale to chyba działało by tylko w FormCreate...

Dodało by sie pare bajerów ale co do nich niejestem pewny