Programowanie w języku Delphi » FAQ

Jak zablokować wielokrotne uruchomie programu

  • 2012-04-28 21:59
  • 10 komentarzy
  • 5092 odsłony
  • Oceń ten tekst jako pierwszy
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ż:

10 komentarzy

pstmax 2009-04-05 19:10

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

pansiu 2007-10-11 23:37

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;

Domi_Juz 2006-12-01 10:58

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?

akpert 2006-01-17 23:29

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;

Marooned 2003-12-05 12:38

Kilka linków:

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

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

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

Marooned 2003-12-05 12:27

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.

flabra 2003-10-24 17:30

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.

daten 2003-03-08 17:08

Wystarczy że wpiszesz
Aplication.messagebox();

SAPER 2003-02-08 17:28

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

Drajwer 2002-12-14 14:42

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