Mehrfachstart verhindern

Für alles, was in den übrigen Lazarusthemen keinen Platz, aber mit Lazarus zutun hat.
Antworten
msvanred
Beiträge: 1
Registriert: Di 12. Mär 2013, 12:14

Mehrfachstart verhindern

Beitrag von msvanred »

Hallo Gemeinde,

bzgl. Verhindern von Mehrfachstarts einer Applikation gibt's aus der Delphi - Ecke ja bereits einige Einträge...

u.a.

Delphi Mehrfachstart einer .exe verhindern - Delphi-PRAXIS
Doppelstart einer Anwendung

Meiner Meinung nach ist die dort - im weiteren Verlauf - beschriebene Lösung mit dem Mutex die geschickteste;
wenn man "nur" den Start unterdrücken möchten

"Schwieriger" wird's wenn man die bereits laufende Anwendung (eigentlich das Hauptfenster) nach vorne bringen und ggf. noch Daten/Parameter übergeben möchte. Da hilft der Mutex nicht wirklich weiter.

Hier im Forum gibt's noch einen Thread über

Verhalten von FindWindow unter Lazarus

in dem beschrieben wird, das FindWindow unter Lazarus, zumindest in der aktuellen Version, nichts viel Sinn macht:
der eine Übergabeparameter von FindWindow muss IMMER auf "Window" stehen, der andere ist die Caption des gesuchten Fensters
spätestens wenn zwei Fenster die gleiche Titelteile habe ist's vorbei.

Dennoch - wer damit kein grundsätzliches Problem hat - kann über FindWindow sich das Fensterhandle besorgen und dann via

Code: Alles auswählen

    Windows.ShowWindow(h,SW_Restore);
    Windows.SetForegroundWindow(h);


die Anwendung nach vorne bringen (h ist das Fensterhandle).
Anschließend kann man dann z.B. via PostMessage eine Nachricht an des Fenster senden - wieder basierend auf dem Handle.

Mir persönlich ist das zuviel Windowsspezifisch (selbst wenn ich ausschließlich auf Windows unterwegs wäre) und das o.g. "Restrisiko" bzgl. Fensterhandle Suche via FindWindow ist natürlich sehr unschön.

Ich würde eher empfehlen, für die gesamte Funktionalität IPC Server / Client verwenden (TSimpleIPCClient, TSimpleIPCServer - unit simpleipc; als Komponenten auf dem Tab "System").
Damit kann man

    Mehrfachstarts verhindern
    Fenster nach vorne bringen - nun ja, eher indirekt :wink:
    (beliebige) Parameter an die laufende Instanz senden


Das kann man natürlich unterschiedlich implementieren; mir gefällt folgende Version ganz gut

Code: Alles auswählen

function SendMessageToInstance(aID: string; aMsg: string): Boolean;
var
  IPCClt: TSimpleIPCClient;
begin
Result:=False;
IPCClt := TSimpleIPCClient.Create(nil);
  try
    IPCClt.ServerID := aID;
    if IPCClt.ServerRunning then
      begin
      IPCClt.Active:=True;
      IPCClt.SendStringMessage(aMsg);
      IPCClt.Active:=False;
      Result:=True;
      end;
  finally
    IPCClt.Free;
  end;
end;   



function SendMessageToInstance ist eine global sichtbare Funktion. Sie liefert True zurück, wenn die übergebene aMsg: string an einen IPCServer mit der ID aID: string übergeben werden konnte; d.h. die Anwendung läuft bereits. Diese Funktion kann überall aufgerufen werden, sinvollerweise "ganz am Anfang" in der *.lpr;

z.B.

Code: Alles auswählen

 
if not SendMessageToInstance('myIPCSrv', 'anyMsg') then
  // die aID muss mit den Namen des Srvs auf dem Formular korrelieren !!
    begin
    Application.Initialize;
    Application.CreateForm(...);
    ...
    Application.Run;
    end;
 


Damit erspart man sich auch ein Abwürgen der neuen Application via Exit oder Terminate.
Zur "elganten" Reaktion auf Messages muss nun noch die SimpleIIPCServer Komponente auf einem Formular platziert werden, welches automatisch erzeugt wird, also z.B. das Hauptformular.

Wichtig (Eigenschaften von TSimpleIPCServer):

    Global:=True
    ServerID:='myIPCSrv' ... muss mit dem Aufruf von SendMessagteToInstance (s.o.) korrelieren !
    Active:=False; ... darf erst nach Initialisierung der Programms (z.B. in FormShow o.ä.) auf True gesetzt werden.

Nun nur noch den geeigneten Code in das OnMessage Event des TSimpleIPCServer platzieren,
z.B. (BringToFront) und den übergebenen Parameter auswerten wie's gerade notwendig ist.

mark332
Beiträge: 202
Registriert: Do 16. Mai 2013, 13:49
OS, Lazarus, FPC: Windows 10 H.P. (x64) / Ubuntu 14.04.X
CPU-Target: AMD Octacore 4.0GHz

Re: Mehrfachstart verhindern

Beitrag von mark332 »

Gute Idee, werde ich mir demnächst mal anschauen ;)
------------------------------------------------------------
Warum gibt es hier eigentlich kein [SPOILER][/SPOILER] ?

hubblec4
Beiträge: 341
Registriert: Sa 25. Jan 2014, 17:50

Re: Mehrfachstart verhindern

Beitrag von hubblec4 »

Das Thema ist zwar schon alt aber es beschreibt am besten was ich auch vorhabe daher antworte ich mal drauf.

Ich habe auch etwas zur Mutex-Variante gelesen aber das kann ich nicht nutzen wegen platformübergreifender Programmierung.

Ich habe dann von dieser Seite alles soweit mal in eine kleine Test app gepackt.


Main:

Code: Alles auswählen

 
unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, simpleipc, ExtCtrls;
 
type
 
 { TForm1 }
 
 TForm1 = class(TForm)
  SimpleIPCServer1: TSimpleIPCServer;
  procedure FormShow(Sender: TObject);
  procedure SimpleIPCServer1Message(Sender: TObject);
 
 
 end;
 
 
 function SendMessageToInstance(aID: string; aMsg: string): Boolean;
 
 
 
var
 Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
 
function SendMessageToInstance(aID: string; aMsg: string): Boolean;
var
  IPCClt: TSimpleIPCClient;
begin
Result:=False;
IPCClt := TSimpleIPCClient.Create(nil);
  try
    IPCClt.ServerID := aID;
    if IPCClt.ServerRunning then
      begin
      IPCClt.Active:=True;
      IPCClt.SendStringMessage(aMsg);
      IPCClt.Active:=False;
      Result:=True;
      end;
  finally
    IPCClt.Free;
  end;
end;
 
{ TForm1 }
 
// onShow
procedure TForm1.FormShow(Sender: TObject);
begin
  SimpleIPCServer1.Active:=true;
end;
 
 
// IPCServer onMessage
procedure TForm1.SimpleIPCServer1Message(Sender: TObject);
begin
  BringToFront;
  //hack to force app bring to front
  FormStyle := fsSystemStayOnTop;
  FormStyle := fsNormal;
  Caption:=SimpleIPCServer1.StringMessage;
end
 
end.
 


lpr:

Code: Alles auswählen

 
program AppOnceOnly;
 
{$mode objfpc}{$H+}
 
uses
 {$IFDEF UNIX}{$IFDEF UseCThreads}
 cthreads,
 {$ENDIF}{$ENDIF}
 Interfaces, // this includes the LCL widgetset
 Forms, main
 { you can add units after this };
 
{$R *.res}
 
begin
  if not SendMessageToInstance('app','einige params oder so') then
  begin
   RequireDerivedFormResource:=True;
   Application.Scaled:=True;
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
  end;
 
 
end.
 
 


Das Aufrufen einer neuen Instanz wird damit wunderbar unterbunden. Allerdings wird keine Message verarbeitet. Im IPC-Server ist dem onMessage-Event eine Prozedur zugewiesen aber diese wird nicht wirklich automatisch ausgeführt, wenn der IPC-Client SendStringMessage() ausführt.

Das fertige Laz-Package uniqueinstance haber ich mir dann mal angeschaut und dort wird mittels eines Timers immer mal wieder die Message vom IPC-Server gecheckt.

Ist dies der einzigste Weg um die Messages zu verarbeiten? Geht es auch ohne Timer?

Main mit Timer:

Code: Alles auswählen

 
unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, simpleipc, ExtCtrls;
 
type
 
 { TForm1 }
 
 TForm1 = class(TForm)
 
  SimpleIPCServer1: TSimpleIPCServer;
  procedure FormCreate(Sender: TObject);
  procedure FormShow(Sender: TObject);
  procedure SimpleIPCServer1Message(Sender: TObject);
 private             
   FTimer : TTimer;
 
   procedure CheckMessage(Sender: TObject);
 
 public
 
 end;
 
 
 
 
 function SendMessageToInstance(aID: string; aMsg: string): Boolean;
 
 
 
var
 Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
 
function SendMessageToInstance(aID: string; aMsg: string): Boolean;
var
  IPCClt: TSimpleIPCClient;
begin
Result:=False;
IPCClt := TSimpleIPCClient.Create(nil);
  try
    IPCClt.ServerID := aID;
    if IPCClt.ServerRunning then
      begin
      IPCClt.Active:=True;
      IPCClt.SendStringMessage(aMsg);
      IPCClt.Active:=False;
      Result:=True;
      end;
  finally
    IPCClt.Free;
  end;
end;
 
{ TForm1 }
 
procedure TForm1.CheckMessage(Sender: TObject);
begin
  SimpleIPCServer1.PeekMessage(1, True);
end;
 
 
 
// onShow
procedure TForm1.FormShow(Sender: TObject);
begin
  SimpleIPCServer1.Active:=true;
end;
 
// onCreate
procedure TForm1.FormCreate(Sender: TObject);
begin
  FTimer:=TTimer.Create(self);
  FTimer.Interval:=1000;
  FTimer.OnTimer:=@CheckMessage;
end;
 
 
// IPCServer onMessage
procedure TForm1.SimpleIPCServer1Message(Sender: TObject);
begin
  BringToFront;
  //hack to force app bring to front
  FormStyle := fsSystemStayOnTop;
  FormStyle := fsNormal;
  Caption:=SimpleIPCServer1.StringMessage;
end;
 
end.
 
 

sstvmaster
Beiträge: 575
Registriert: Sa 22. Okt 2016, 23:12
OS, Lazarus, FPC: W10, L 2.2.6
CPU-Target: 32+64bit
Wohnort: Dresden

Re: Mehrfachstart verhindern

Beitrag von sstvmaster »

Das wäre dann das gleiche wie das Paket "UniqueInstance" im OPM.
LG Maik

Windows 10,
- Lazarus 2.2.6 (stable) + fpc 3.2.2 (stable)
- Lazarus 2.2.7 (fixes) + fpc 3.3.1 (main/trunk)

hubblec4
Beiträge: 341
Registriert: Sa 25. Jan 2014, 17:50

Re: Mehrfachstart verhindern

Beitrag von hubblec4 »

sstvmaster hat geschrieben:Das wäre dann das gleiche wie das Paket "UniqueInstance" im OPM.


Ja so im groben ist es das gleiche, nur etwas weniger Code.
Also es geht nur mit Timer so wie es aussieht.

Ist dieser Timer denn sehr Resourcen-Fressend?

angross
Beiträge: 10
Registriert: So 29. Dez 2019, 17:13
OS, Lazarus, FPC: Fedora 36, WinX, Lazarus 2.2.2/2.2.2
CPU-Target: x86_64
Wohnort: Berlin

Re: Mehrfachstart verhindern

Beitrag von angross »

Diese "Mehrfachstart-Verhinderung" konnte ich gerade seeeehr gut gebrauchen :D
Ich arbeite unter Fedora Linux meist mit sehr vielen Desktops, auf denen man leicht die Übersicht verlieren kann und Programme eben auch mehrfach startet ... Bei meinen eigenen ruft das zumindest unangenehme Seiteneffekte hervor, wenn z.B. dieselbe sqlite Datenbank in beiden geöffnet ist -- und man plötzlich einen Satz nicht mehr speichern kann ...

Zwar funktioniert weder unter Fedora noch WinX das Hervorkramen der ersten gestarteten Instance richtig, aber beide Systeme zeigen wenigstens eine Message im Benachrichtigungs-Center an bzw. flimmert in der Taskleiste der Programmeintrag, und bei Klick darauf kommt man dann doch zum Ziel.

Unter WinX funktioniert bei mir aber die Sequenz

//hack to force app bring to front
FormStyle := fsSystemStayOnTop;
FormStyle := fsNormal;

gar nicht, sondern liefert seltsame Effekte. Aber egal, wichtig ist, dass der Mehrfachstart verhindert wird.

Danke dafür!

sstvmaster
Beiträge: 575
Registriert: Sa 22. Okt 2016, 23:12
OS, Lazarus, FPC: W10, L 2.2.6
CPU-Target: 32+64bit
Wohnort: Dresden

Re: Mehrfachstart verhindern

Beitrag von sstvmaster »

Dafür gibt es doch "UniqueInstance", aktuelle Version 1.1.0.0, im Online Package Manager.
UniqueInstance provides a component to limits one instance per application
Supported widgetsets: win32/win64, gtk2, carbon
LG Maik

Windows 10,
- Lazarus 2.2.6 (stable) + fpc 3.2.2 (stable)
- Lazarus 2.2.7 (fixes) + fpc 3.3.1 (main/trunk)

angross
Beiträge: 10
Registriert: So 29. Dez 2019, 17:13
OS, Lazarus, FPC: Fedora 36, WinX, Lazarus 2.2.2/2.2.2
CPU-Target: x86_64
Wohnort: Berlin

Re: Mehrfachstart verhindern

Beitrag von angross »

Uniqueinstance ist natürlich einfacher zu handlen -- habe es gerade getestet.
Letztendlich muss man die genannten Befehle

Code: Alles auswählen

//hack to force app bring to front
BringToFront
FormStyle := fsSystemStayOnTop;
FormStyle := fsNormal;
ja trotzdem selbst setzen, und die letzteren beiden haben unter Linux keine Wirkung und bringen unter WinX die genannten Probleme.
Mit BringToFront funktioniert es ja nur indirekt, wie beschrieben.

Grüße aus Berlin

Antworten