Zmiany - Delphi 10.3 Community Edition

Drajwer

Zmiany wymuszone

***

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

{**Dla Delphi 10.3 Community Edition**}
{**Winapi.Windows,Vcl.Forms,**}
{**Unit1 in 'Unit1.pas' {Form1};**}

{$R *.res}

var
  Handle: THandle;

begin
  MessID := RegisterWindowMessage('"NazwaMutexuTwojejAplikacji"');
  {Aby zmienna Handle została zainicjowana, taka sztuczka}
  Handle:=CreateMutex(nil,FALSE, nil);
  CloseHandle(Handle);
  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
{Dla Delphi 10.3 Community Edition}
{**Winapi.Windows}

Zdeklaruj zmienną
Handle typu THandle

Dopisz w kodzie

  MessID := RegisterWindowMessage('"NazwaMutexuTwojejAplikacji"');
Handle:=CreateMutex(nil, FALSE, nil);
  CloseHandle(Handle);
  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;
{**Dla Delphi 10.3 Community Edition**}
{**Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.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 dla Delphi 10.3
  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;

Uzupełnienie:
Funkcja ma następującą składnię:
Handle:=CreateMutex(lpMutexAttributes,bInitialOwner,lpName);

lpMutexAttributes jest to wartość typu LPSECURITY_ATTRIBUTES - w skrócie związany z deskryptorem zabezpieczeń, zawiera m.in SID.
Odsyłam do Windows Documentation na stronie: https://docs.microsoft.com/pl-pl/windows/win32/api/synchapi/nf-synchapi-createmutexa
Dla nas wystarczy, że jeżeli ten parametr ma wartość NULL nil, to muteks otrzymuje domyślny deskryptor zabezpieczeń.

bInitialOwner jest to wartość typu PRAWDA/FAŁSZ, true lub false - Jeśli ma wartość PRAWDA, to obiekt wywołujący utworzył muteks,
a wątek wywołujący uzyskuje początkową własność obiektu mutex. Aby ustalić, czy program wywołujący utworzył muteks, należy sprawdzić jaki
jest wynik wywołania funkcji.

lpName - Nazwa obiektu mutex. Nazwa jest ograniczona do znaków MAX_PATH . W porównaniu nazw rozróżniana jest wielkość liter.
Jeśli lpName ma wartość NULL , obiekt mutex jest tworzony bez nazwy. Jeśli lpName pasuje do istniejącej nazwy, to funkcja kończy się
niepowodzeniem, a funkcja GetLastError zwraca wartość: ERROR_INVALID_HANDLE.
Jeżeli zwrócona zostanie wartość: ERROR_ALREADY_EXISTS oznacza to, że istnieje już mutex o nazwie lpName.

Funkcja zwraca wartość typu: THandle
Jeśli funkcja się powiedzie, zwracana wartość jest uchwytem do nowo utworzonego obiektu mutex.
Jeśli funkcja zawiedzie, zwracana wartość to NULL nil

Sprawdzone w Delphi 10.3 Community Edition.
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