Singleton in Delphi

[himitsu]

OK, dann hier mal meine Gedanken zu einem SingletonPattern

die Basisklasse für Delphi 2009 und davor:

Delphi-Quellcode:

type
  TSingleton = class(TObject)
  private
    fIsInitialized: Boolean;
    fAllowFree:     Boolean;
    fIsSingelton:   Boolean;
    class var fSingleton: TSingleton;
    class procedure DoFree;
  protected
    property isInitialized: Boolean read fIsInitialized;  // to see whether the constructor must be executed (in contructors)
    property AllowFree:     Boolean read fAllowFree;      // to detect whether the object is released (in destructors)
    property isSingelton:   Boolean read fIsSingelton;    // note: not yet available in constructor
  public
    class function NewInstance: TObject; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure FreeInstance; override;
  end;

class procedure TSingleton.DoFree;
begin
  if Assigned(fSingleton) then
    fSingleton.fAllowFree := True;
  fSingleton.Free;
end;

class function TSingleton.NewInstance: TObject;
begin
  if Assigned(fSingleton) then
    Result := fSingleton
  else
    Result := inherited;
end;

procedure TSingleton.AfterConstruction;
begin
  inherited;
  fIsSingelton := not Assigned(InterlockedCompareExchangePointer(Pointer(fSingleton), Pointer(Self), nil));
  fIsInitialized := True;
  if not fIsSingelton then fAllowFree := True;
end;

procedure TSingleton.BeforeDestruction;
begin
  if fAllowFree then
    inherited;
end;

procedure TSingleton.FreeInstance;
begin
  if fAllowFree then
    inherited;
end;

class destructor TSingleton.DestroyClass;
begin
  if Assigned(fSingleton) then
    fSingleton.fAllowFree := True;
  fSingleton.Free;
end;

initialization

finalization
  TSingleton.DoFree;

end.

die Basisklasse ab Delphi 2010 (die ältere Version geht aber auch noch):

Delphi-Quellcode:

type
  TSingleton = class(TObject)
  private
    fIsInitialized: Boolean;
    fAllowFree:     Boolean;
    fIsSingelton:   Boolean;
    class var fSingleton: TSingleton;
  protected
    property isInitialized: Boolean read fIsInitialized;  // to see whether the constructor must be executed (in contructors)
    property AllowFree:     Boolean read fAllowFree;      // to detect whether the object is released (in destructors)
    property isSingelton:   Boolean read fIsSingelton;    // note: not yet available in constructor
  public
    class function NewInstance: TObject; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure FreeInstance; override;
    class destructor DestroyClass;
  end;

class function TSingleton.NewInstance: TObject;
begin
  if Assigned(fSingleton) then
    Result := fSingleton
  else
    Result := inherited;
end;

procedure TSingleton.AfterConstruction;
begin
  inherited;
  fIsSingelton := not Assigned(InterlockedCompareExchangePointer(Pointer(fSingleton), Pointer(Self), nil));
  fIsInitialized := True;
  if not fIsSingelton then fAllowFree := True;
end;

procedure TSingleton.BeforeDestruction;
begin
  if fAllowFree then
    inherited;
end;

procedure TSingleton.FreeInstance;
begin
  if fAllowFree then
    inherited;
end;

class destructor TSingleton.DestroyClass;
begin
  if Assigned(fSingleton) then
    fSingleton.fAllowFree := True;
  fSingleton.Free;
end;

und eine Beispielklasse:

Delphi-Quellcode:

type
  TMyClass = class(TSingleton)
    Value: String;
    constructor Create;
    destructor Destroy; override;
  end;

constructor TMyClass.Create;
begin
  if not isInitialized then
  begin
    inherited;
    ////////////////////

    ShowMessage('Ich wurde erstellt');

    ////////////////////
  end;
end;

destructor TMyClass.Destroy;
begin
  if AllowFree then
  begin
    ////////////////////

    //ShowMessage('ich werde jetzt freigegeben');
    // wird nicht mehr angezeigt, nachdem die VCL beendet wurde
    MessageBox(0, 'ich werde jetzt freigegeben', '', 0);

    ////////////////////
    inherited;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  S: TMyClass;
begin
  S := TMyClass.Create;
  S.Value := 'test';
  S.Free;

  S := TMyClass.Create;
  ShowMessage('mein Wert ist: ' + S.Value);
end;