Einzelnen Beitrag anzeigen

Hansa

Registriert seit: 9. Jun 2002
Ort: Saarland
7.554 Beiträge
 
Delphi 8 Professional
 
#4
  Alt 2. Okt 2002, 20:57
Hallo Leute,

@Admin : hier habe ich vorher was gepostet, ist weg. Vielleicht auch diesen Beitrag verschieben bei FAQ oder so. Werde oft nach sowas gefragt.

Vielleicht ist das hier für den gewünschten Zweck zuviel, jedenfalls funktionierts. Es geht um sogenannte Semaphoren (Fremdwörterlexikon : Signalflagge (griech.)). Wie man am Quelltext sieht, ist es nicht von mir alleine, aber weiß nicht mehr wo's herkam. Das Prinzip ist eigentlich leicht zu verstehen. So wie ein Zug, der bei grün fahren darf und bei rot nicht, so kann ein Programm nur gestartet werden, wenn es nicht bereits aktiv ist. In dieser Variante (es gibt auch andere) kann also ein Programm, selbst wenn es minimiert wurde, nicht noch
einmal gestartet werden. Wird dies versucht, so wird das in der Taskleiste "geparkte" maximiert und ist noch genau so, wie es vor der Minimierung war (Eingabefelder usw.). Mehrfachstarts, die das System eventuell abstürzen lassen sind dann ausgeschlossen.

Folgende Unit muß in die USES Liste :

Code:
unit sema;

interface

uses
  Windows, Messages,SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

function BereitsAktiv: Boolean;

IMPLEMENTATION

function BereitsAktiv: Boolean;
var
  semName,
  appClass: PChar;
  hSem   : THandle;
  hWndMe : HWnd;
  appTitle: Array[0..MAX_PATH] of Char;
begin
  // Init
  Result := FALSE;
  GetMem(semName,15);
  GetMem(appClass,15);
  StrPCopy(semName,'sema');
  StrPCopy(appClass,'TApplication');
  StrPCopy(appTitle,ExtractFileName(Application.Title));

  // Create a Semaphore in memory. If this is the
  // first instance, then hSem's value should be 0.
  hSem := CreateSemaphore(nil,0,1,semName);

  // Check to see if the semaphore exists
  if (hSem <> 0) and (GetLastError() =
                      ERROR_ALREADY_EXISTS) then
    begin
      CloseHandle(hSem);

      // Get the current window's handle then change
      // its title so we can look for the other instance
      hWndMe := FindWindow(appClass,appTitle);
      SetWindowText(hWndMe,'ZZZZZZZ');

      // Search for other instance of this window then bring
      // it to the top of the Z-order stack. We find it by
      // matching the Application Class and
      // Application Title.
      hWndMe := FindWindow(appClass,appTitle);
      if (hWndMe <> 0) then
        begin
          BringWindowToTop(hWndMe);
          ShowWindow(hWndMe,SW_SHOWNORMAL);
        end;

      Result := TRUE;
    end;

  // Destroy PChars
  FreeMem(semName,15);
  FreeMem(appClass,15);
end;

end.
Im DPR muß noch folgende Änderung rein :

Code:
{$R *.res}

begin
  if NOT BereitsAktiv then
    begin
      Application.Initialize;
      Application.CreateForm(TForm1, Form1);
      Application.CreateForm(TDataModul, DataModul);
      Application.Run;
    end
  else
    Application.Terminate;
end.
Gruß
Hansa
  Mit Zitat antworten Zitat