Thema: Delphi Class Factory Problem

Einzelnen Beitrag anzeigen

Ghostwalker

Registriert seit: 16. Jun 2003
Ort: Schönwald
1.299 Beiträge
 
Delphi 10.3 Rio
 
#1

Class Factory Problem

  Alt 29. Apr 2018, 09:29
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 ?
Angehängte Dateien
Dateityp: zip FactoryDemo.zip (4,9 KB, 8x aufgerufen)
Uwe
e=mc² or energy = milk * coffee²

Geändert von Ghostwalker (29. Apr 2018 um 09:30 Uhr) Grund: Anhang vergessen
  Mit Zitat antworten Zitat