Problem beim Programmneustart mit Instanzkontrolle

[Sir Rufo]

Hier die versprochene Klasse

Delphi-Quellcode:

unit AppMutex;

interface

type
  TAppMutexStrategy = class abstract
  private
    procedure SetActive( const Value : Boolean );
  protected
    function GetActive : Boolean; virtual; abstract;
    procedure AquireMutex; virtual; abstract;
    procedure ReleaseMutex; virtual; abstract;
  public
    destructor Destroy; override;
  end;

  TAppMutex = class
  private
    class var FStrategy : TAppMutexStrategy;
  private
    class procedure SetActive( const Value : Boolean ); static;
    class function GetActive : Boolean; static;
    class destructor Destroy;
  public
    class property Active : Boolean read GetActive write SetActive;
    class procedure SetStrategy( AStrategy : TAppMutexStrategy );
  end;

  TNamedAppMutexStrategy = class( TAppMutexStrategy )
  private
    FHandle : Cardinal;
    FName :   string;
  protected
    procedure AquireMutex; override;
    procedure ReleaseMutex; override;
    function GetActive : Boolean; override;
    function GetName : string; virtual;
    property Name : string read GetName;
  public
    constructor Create( const AName : string );
  end;

  TLocalAppMutexStrategy = class( TNamedAppMutexStrategy )
  protected
    function GetName : string; override;
  end;

  TGlobalAppMutexStrategy = class( TNamedAppMutexStrategy )
  protected
    function GetName : string; override;
  end;

implementation

uses
  Windows,
  SysUtils;

{ TAppMutex }

class destructor TAppMutex.Destroy;
begin
  FreeAndNil( FStrategy );
end;

class function TAppMutex.GetActive : Boolean;
begin
  Result := FStrategy.GetActive;
end;

class procedure TAppMutex.SetActive( const Value : Boolean );
begin
  FStrategy.SetActive( Value );
end;

class procedure TAppMutex.SetStrategy( AStrategy : TAppMutexStrategy );
begin
  if Assigned( FStrategy )
  then
    FreeAndNil( FStrategy );

  FStrategy := AStrategy;
end;

{ TAppMutexStrategy }

destructor TAppMutexStrategy.Destroy;
begin
  SetActive( False );
  inherited;
end;

procedure TAppMutexStrategy.SetActive( const Value : Boolean );
begin
  if Value = GetActive
  then
    Exit;

  if Value
  then
    AquireMutex
  else
    ReleaseMutex;
end;

{ TNamedAppMutexStrategy }

procedure TNamedAppMutexStrategy.AquireMutex;
var
  LLastError : Cardinal;
begin
  FHandle := CreateMutex( nil, True, PChar( Name ) );

  LLastError := GetLastError;

  if LLastError = ERROR_ALREADY_EXISTS
  then
    begin
      CloseHandle( FHandle );
      FHandle := 0;
    end;
end;

constructor TNamedAppMutexStrategy.Create( const AName : string );
begin
  inherited Create;
  FName := AName;
end;

function TNamedAppMutexStrategy.GetActive : Boolean;
begin
  Result := ( FHandle <> 0 );
end;

function TNamedAppMutexStrategy.GetName : string;
var
  LIdx : Integer;
begin
  Result   := FName;
  for LIdx := 1 to Length( Result ) do
    begin
      if not CharInSet( Result[LIdx], ['0' .. '9', 'A' .. 'Z', 'a' .. 'z', '-'] )
      then
        Result[LIdx] := '_';
    end;
end;

procedure TNamedAppMutexStrategy.ReleaseMutex;
begin
  CloseHandle( FHandle );
  FHandle := 0;
end;

{ TLocalAppMutexStrategy }

function TLocalAppMutexStrategy.GetName : string;
begin
  Result := 'Local\' + inherited;
end;

{ TGlobalAppMutexStrategy }

function TGlobalAppMutexStrategy.GetName : string;
begin
  Result := 'Global\' + inherited;
end;

end.

Im Einsatz so

Delphi-Quellcode:

program MutexTest;

uses
  Forms,
  MainView_Form in 'MainView_Form.pas' {MainView} ,
  AppMutex in 'AppMutex.pas',
  AlertView_Form in 'AlertView_Form.pas' {AlertView};

{$R *.res}

begin
  // Strategie einstellen
  TAppMutex.SetStrategy( TGlobalAppMutexStrategy.Create( '6D274674-150A-490E-B8D0-726C6D556F29' ) );
  // Aktivieren
  TAppMutex.Active := True;

  // Überprüfung
  if not TAppMutex.Active
  then
  begin
    TAlertView.Create( nil ).ShowModal;
    Halt;
  end;

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm( TMainView, MainView );
  Application.Run;

end.