Class Factory Problem

[Ghostwalker]

MoinMoin,

ich beschäftige mich grad mit dem Factory Pattern in zusammenhang mit Klassen. Ich hab mir auch verschiedene Beiträge hier in der DP sowie im Netz durchgelesen. Aber irgendwie bekomme ich es nicht hin.

Hier die Manager-Klasse:

Delphi-Quellcode:

unit Demo.Manager;

interface
uses
  System.Classes,
  System.Generics.Collections,
  Demo.Interfaces;

TYPE
  TManagerEntry = Record
                   TheClass : TClass;
                   TheInst  : TObject;
  End;

  MyManager = Class
  private
    class var fClasses:TDictionary<STRING,TManagerEntry>;
  protected
    Class Constructor Create;
    Class Destructor Destroy;
  Public
    Class Procedure RegisterEntry(Ident:String;AClass:TClass);
    Class function GetEntry(Ident:String):ITestInterface;
  End;

implementation
uses
  System.TypInfo,
  System.RTTI,
  System.SysUtils,
  Demo.Classes;

Class Constructor MyManager.Create;
begin
  fclasses := TDictionary<STRING,TManagerEntry>.create;
end;

Class Destructor MyManager.Destroy;
begin
  fclasses.free;
end;

Class Procedure MyManager.RegisterEntry(ident:string;AClass:TClass);
var
  tmp : TManagerEntry;

begin
  if (fclasses.containsKey(ident)) then
    Raise Exception.Create(ident+' is already registered !');
  if (Supports(AClass,ITestInterface)) then
  begin
    tmp.TheClass := AClass;
    tmp.TheInst := NIL;
    fclasses.add(ident,tmp);
  end;
end;

Class function MyManager.GetEntry(ident:string):ITestInterface;
var
  hlp : TManagerEntry;

  function CreateMyIntf(AClass:TClass):TObject;
  var
    ctx: TRttiContext;
    RT: TRttiType;
    Value: TValue;
    RM: TRttiMethod;
    ParamList: TList<TValue>;
    RP: TRttiParameter;

  begin
    result := NIL;
    ctx := TRttiContext.Create;
    RT := ctx.GetType(AClass);
    for rm in rt.GetMethods do
    begin
      if rm.IsConstructor then
      begin
        ParamList := TList<TValue>.Create;
        for rp in rm.GetParameters do
        begin
          TValue.Make(0, rp.ParamType.Handle, Value);
          ParamList.Add(Value);
        end;
        result := rm.Invoke(AClass,ParamList.ToArray).AsObject;
        ParamList.Free;
        break;
      end;
    end;
  end;

begin
  result := NIL;
  if (fclasses.ContainsKey(ident)) then
  begin
    hlp := fclasses[ident];
    if (hlp.TheInst = NIL) then
      hlp.TheInst := CreateMyIntf(hlp.TheClass);
    Supports(hlp.TheInst,ITestInterface,result);
  end;
end;

end.

Hier die Demoklassen, die ein entsprechendes Interface implementieren:

Delphi-Quellcode:

unit Demo.Classes;

interface
uses
  System.Classes,
  Demo.Interfaces,
  Demo.Manager;

Type
  TDemoClass1 = Class(TInterfacedObject,ITestInterface)
    public
      Procedure TuWas(Strings:TSTrings);
  End;

  TDemoClass2 = Class(TInterfacedObject,ITestInterface)
  public
    Procedure TuWas(Strings:TStrings);
  end;

  TDemoClass3 = Class(TInterfacedObject,ITestInterface)
  public
    Procedure TuWas(Strings:TStrings);
  end;


implementation


Procedure TDemoClass1.TuWas(Strings:TStrings);
begin
  Strings.append('1. Demo Klasse');
end;

Procedure TDemoClass2.TuWas(Strings:TStrings);
begin
  Strings.append('2. Demo Klasse');
end;

Procedure TDemoClass3.TuWas(Strings:TStrings);
begin
  strings.append('3. Demo Klasse');
end;

INITIALIZATION
  MyManager.RegisterEntry('Class1',TDemoClass1);
  MyManager.RegisterEntry('Class2',TDemoClass2);
  MyManager.RegisterEntry('Class3',TDemoClass3);

end.

Sobald ich das Programm starte, krachts mit einer Zugriffsverletzung beim RegisterEntry-Aufruf.

Ich vermute das der Aufruf des Klassenkonstruktors erst nach dem abarbeiten der INITIALIZATION-Abschnitte der Units erfolgt. Oder liegt das Problem woanders ?

[Uwe Raabe]

Zitat von Ghostwalker:

Ich vermute das der Aufruf des Klassenkonstruktors erst nach dem abarbeiten der INITIALIZATION-Abschnitte der Units erfolgt.

Ja, so ist es. Das liegt daran, daß Demo.Classes im Implementation-Uses steht und deswegen die Demo.Classes vor Demo.Manager initialisiert wird.

Allerdings wird Demo.Classes aber auch in Demo.Manager nicht verwendet und kann somit entfallen. Dann funktioniert es auch.

[Ghostwalker]

Thx, das war das Problem. Danke