Zmiany - Delphi 10.3 Community Edition

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ż:

• FindWindow
• Obsługa komunikatów w Delphi