1. Instanz nach vorn bringen, wenn 2. geöffnet wird - fensterunabhängig!

[RSE]

Um die offenen Fragen aus meinem letzten Post zu umgehen, habe ich nun umgebaut:

Delphi-Quellcode:

var
  PID: ULONG; // Process-ID von 1. Instanz
  HPipe: THandle = INVALID_HANDLE_VALUE; // wird für Server (= 1. Instanz, CreateNamedPipe) und für Client (= 2. Instanz, CreateFile) verwendet

function GetNamedPipeServerProcessId(hNamedPipe: THandle;
  out ServerProcessId: ULONG): BOOL; stdcall;
  external kernel32 name 'GetNamedPipeServerProcessId';

function EnumWindowsProcCallback(HWnd: THandle; PID: LPARAM): BOOL; stdcall;
var
  WinPID: DWORD;
begin
  GetWindowThreadProcessId(HWnd, WinPID);
  Result := WinPID <> (PULONG(PID))^;
  if not Result then
    SetForegroundWindow(HWnd);
end;

initialization

  HPipe := CreateNamedPipe(PipeName,
    PIPE_ACCESS_OUTBOUND or FILE_FLAG_FIRST_PIPE_INSTANCE,
    PIPE_TYPE_BYTE or PIPE_READMODE_BYTE or PIPE_WAIT, 1, 4, 4, 0, nil); // erste Pipe-Instanz erstellen
  if HPipe = INVALID_HANDLE_VALUE then
  begin // wenn Pipe bereits besteht
    HPipe := CreateFile(PipeName, GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0); // auf Pipe verbinden
    if HPipe <> INVALID_HANDLE_VALUE then
    begin
      if GetNamedPipeServerProcessId(HPipe, PID) then // Prozess-ID des Pipe-Servers erfragen (= 1. Instanz)
        EnumWindows(@EnumWindowsProcCallback, LPARAM(@PID)); // Fenster durchforsten
    end;
    // wenn Verbindung zur Pipe erfolgreich, Meldung anzeigen -> aktuelle Instanz ist die 2.
    // wenn Verbindung zur Pipe nicht erfolgreich, dann Meldung anzeigen wenn GetLastError <> ERROR_PIPE_BUSY -> keine Meldung für die 3. Instanz, die gleichzeitig geöffnet ist
    if (HPipe <> INVALID_HANDLE_VALUE) or (GetLastError <> ERROR_PIPE_BUSY) then
      MessageBox(0, 'Das Programm läuft bereits', '',
        MB_SYSTEMMODAL or MB_SETFOREGROUND or MB_TOPMOST);
    Halt;
  end;

finalization

  // Pipe-Handle freigeben - Server und Client
  if (HPipe <> INVALID_HANDLE_VALUE) and CloseHandle(HPipe) then
    HPipe := INVALID_HANDLE_VALUE; // Falls es sich um Client/2. Instanz handelt, dann ist die Pipe trotzdem weiterhin besetzt (weitere/spätere Verbindungsversuche verursachen ERROR_PIPE_BUSY) - Warum? #####

end.

Dadurch erübrigen sich 2 der 3 Punkte, aber einer bleibt bestehen:

Zitat von RSE:

• Punkt3: Ich wäre davon ausgegangen, dass die Pipe wieder frei ist, wenn die Verbindung durch das Freigeben des Handles beendet wurde. Was muss ich tun, um die Pipe wieder freizumachen?

An diesem Punkt bitte ich um eure Hilfe, es fällt mir dazu nichts weiter ein.

[ASM]

Anstelle mit Hilfe von Pipes lässt sich das Problem auch grundsätzlich anders lösen:
Man kann in den diversen Formfenstern des Programms individuelle Hooks der jeweiligen WndProc setzen. Dann ist es möglich, dort die beim Start der 2.Instanz abgesetzte HWND_BROADCAST-Message abzufangen und geeignet zu behandeln:

// in der MainForm:

Delphi-Quellcode:

Interface 

const
  // z.B. mit GUI-Code zweifelsfrei individualisieren
  UniqueAppTitle = 'MyApp#21218E21-EF54-45D9-AAA0-8F4E7455D5AE';
var
  UniqueAppMsg: DWord;
  
Implementation

{...}
  
initialization
  UniqueAppMsg := RegisterWindowMessage(pChar(UniqueAppTitle));
end.

// in jeder einzelnen Form-Unit (hier exemplarisch "FormX"):

Delphi-Quellcode:

Implementation

uses Mainunit; // unit der Mainform

var
  OriginalWndProc: Pointer;
  CurrentFormHandle: hWnd;

function FormX_HookedWndProc(FormHandle: hWnd; MessageID: LongInt;
  ParamW: LongInt; ParamL: LongInt): LongInt stdcall;
begin
  if MessageID = UniqueAppMsg then
  begin
    SendMessage(Application.Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
    SetForegroundWindow(Application.Handle);
    SendMessage(CurrentFormHandle, WM_SYSCOMMAND, SC_RESTORE, 0);
    Result := 0;
  end
  else
   Result := CallWindowProc(OriginalWndProc, FormHandle, MessageID, ParamW, ParamL);
end;

procedure TFormX.FormCreate(Sender: TObject);
begin
  CurrentFormHandle:=FormX.Handle;
  OriginalWndProc := Pointer(SetWindowLong(CurrentFormHandle, GWL_WNDPROC,
    LongInt(@FormX_HookedWndProc)));
end;

procedure TFormX.FormDestroy(Sender: TObject);
begin
  SetWindowLong(CurrentFormHandle, GWL_WNDPROC, LongInt(OriginalWndProc));
end;

// im Projektfile:

Delphi-Quellcode:

Uses Windows, ...;
var
  Mutex: THandle;

begin
  Mutex := CreateMutex(nil, True, UniqueAppTitle);
  if (Mutex = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then
  begin
    SendMessage(HWND_BROADCAST, UniqueAppMsg, 0, 0);
    Halt(0);
  end
  else
  try
    Application.Initialize;
    {...}
  finally
    if Mutex <> 0 then CloseHandle(Mutex);
  end;

[CCRDude]

@ASM: Uwe Raabe hat dazu oben etwas wichtiges gesagt: evtl. kann sich ein Programm gar nicht selber in den Vordergrund holen (ich mache das auch nicht so, dachte nur, dass das noch praktischer wäre, deswegen schrieb ich das als Vorschlag).

Aus eigener Erfahrung möchte ich noch ein paar wichtige Sachen ergänzen:

Fast User Switching und Terminal Services / Remote-Desktop-Zugriff ermöglichen es, dass theoretisch verschiedene Benutzer (oder verschiedene Instanzen desselben Benutzers ein Programm auf demselben Rechner nutzen wollen. Wäre blöd, wenn Benutzer A ein Dokument öffnen will und es bei Benutzer B aufgeht, weil der die erste Instanz offen hat.

Deswegen reicht ein UniqueAppTitle wie von ASM beschrieben auf keinen Fall aus! Session-ID und Username gehören da mit rein. Am besten noch den Namen des Desktops. Zusätzlich könnte der Prefix Local\ helfen, um das Mutex definitiv innerhalb der Session zu erzeugen (kommt halt drauf an, wofür man es will). Steht alles in der Hilfe zu CreateMutex

Gleiches gilt natürlich auch für den Namen der Pipe - sicherstellen, dass da keine Übergriffe stattfinden können!

Negativbeispiel: Adobe Reader (über mehrere Versionen, nicht sicher ob noch in aktueller). Admin A startet den Adobe Reader, um ein PDF zu lesen. DAU D, ein eingeschränkter Benutzeraccount, surft im Netz und öffnet im Browser ein PDF. Das Adobe Reader-Plugin ist so "intelligent", sich an den von A gestarteten Reader anzuflanschen. Jetzt hat D über die Öffnen-Funktion vollen Administrator-Zugriff.


Und wenn das Programm u.U. auch elevated sein kann, muss man planen, wie man damit umgeht, weil der BROADCAST u.U. nicht in beide Richtungen funktioniert (Programm, die elevated sind, sollen ja eben nicht per Window Messages von nicht elevateten Programmen "gesteuert" werden können).

[RSE]

Also auf zum nächsten Versuch:

Ich werde die Pipe wieder gegen einen Mutex ersetzen, um herauszubekommen, ob die aktuelle Instanz die einzige ist. Die Pipe ist, so wie ich sie momentan im Code habe, sowieso ziemlich zweckentfremdet. Wenn ich nun eine weitere Instanz finde (= der Mutex bereits reserviert/in Benutzung ist), dann sende ich mit BroadcastSystemMessage eine Message an alle Applications, die ein Antwort-Handle enthält. Die 1. Instanz reagiert darauf und schickt eine Message an das Antworthandle, welches die Prozess-ID enthält. Der Rest läuft dann wie bisher. Vielleicht finde ich auch noch Optimierungspotenzial - habe da eine Option BSF_ALLOWSFW gesehen.

Ich poste auf alle Fälle den finalen Code hier.

@ASM: Danke für die Idee mit den Broadcast-Messages!

@CCRDude: Das sind gute Hinweise, die du da bringst. In meinem Fall geht es allerdings nicht um das Öffnen von Dateien, sondern um ein reines Arbeitswerkzeug, das mit Daten aus einer Datenbank versorgt wird. Wenn dieses Programm mit dem selben Rechnernamen mehrfach ausgeführt wird, dann kommt die Organisation in diversen Tabellen durcheinander. Außerdem wird das Programm nur firmenintern eingesetzt, und da kann man schon einige Annahmen über den Einsatz machen Zumindest soweit, dass man keine Klimmzüge macht, um Fälle abzudecken, die sowieso nicht vorkommen werden. Der Admin wird sich z.B. nie im Remotezugriff auf einem Rechner selbst (zusätzlich) einloggen und dort dieses Programm starten. Bei Programmen, die die Firma verlassen würden, müsste man deine Hinweise natürlich beachten, keine Frage!

[Uwe Raabe]

Sidenote: Du kannst dir ja mal die madCollection und dort die Processes ansehen. Macht die Sache leichter.

[RSE]

@Uwe Raabe: Könntest du mir noch einen Hinweis geben, was genau ich mir dort ansehen sollte? Bei einem groben Überfliegen ist mir noch nichts speziell aufgefallen.

[RSE]

Es klappt! Endlich! Folgender Code hat gewonnen:

Delphi-Quellcode:

const
  ProgUID = 'geheim :-p';
  BSF_ALLOWSFW = $00000080; // fehlt in Unit Windows neben z.B. BSF_QUERY

var
  s: string;
  HMutex: THandle = 0;
  PBroadcastRecipients: PDWORD;
  WM_CCCSingleInstanceBroadcast: UINT = 0;

function TIrgendeineKlasse.SingleInstanceBroadcastReceiver(var m: TMessage): Boolean; // muss zwecks Akzeptanz durch Application.HookMainWindow als Methode einer Klasse implementiert sein
begin
  Result := False;
  if m.Msg = WM_CCCSingleInstanceBroadcast then
    Application.BringToFront;
end;

initialization

  WM_CCCSingleInstanceBroadcast := RegisterWindowMessage(ProgUID); // eindeutige Message-ID holen
  HMutex := CreateMutex(nil, True, ProgUID);
  if (HMutex = 0) or (GetLastError = ERROR_ALREADY_EXISTS) or
     (GetLastError = ERROR_ACCESS_DENIED) then
  begin
    // dieser Code läuft nur in der 2. Instanz des Programms
    New(PBroadcastRecipients);
    try
      PBroadcastRecipients^ := BSM_APPLICATIONS;
      BroadcastSystemMessage(BSF_ALLOWSFW or BSF_IGNORECURRENTTASK or
        BSF_POSTMESSAGE, PBroadcastRecipients, WM_CCCSingleInstanceBroadcast, 0, 0); // an alle: hier ist noch einer
      SwitchToThread; // Rest der Zeitscheibe verwerfen, damit die Instanz sich nach vorn bringen kann (falls das durch Race-Condition nicht klappt: Pech gehabt)
    finally
      Dispose(PBroadcastRecipients);
    end;
    MessageBox(0, 'Das Programm läuft bereits', '',
      MB_SYSTEMMODAL or MB_SETFOREGROUND or MB_TOPMOST); // über die erste Instanz legen
    Halt;
  end;
  Application.HookMainWindow(TIrgendeineKlasse.SingleInstanceBroadcastReceiver); // Klassenmethode sollte gehen - dieser Teil ist bei mir ganz anders umgesetzt

finalization

  if HMutex > 0 then
    CloseHandle(HMutex);

end.

[Uwe Raabe]

Zitat von RSE:

@Uwe Raabe: Könntest du mir noch einen Hinweis geben, was genau ich mir dort ansehen sollte? Bei einem groben Überfliegen ist mir noch nichts speziell aufgefallen.

Nichts Spezielles - es macht lediglich das Arbeiten mit den Kernel-Objekten leichter.