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: 245
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: 342
Registriert: Sa 22. Okt 2016, 23:12
OS, Lazarus, FPC: OS: Windows 10 | Lazarus: 2.0.8 + Fixes + Trunk 32bit
CPU-Target: 32Bit
Wohnort: Dresden

Re: Mehrfachstart verhindern

Beitrag von sstvmaster »

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

hubblec4
Beiträge: 245
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?

Antworten