Custom Constructor /DI bei factory-basierter Objekterstellung

[Sequitar]

Lösung soweit:

Delphi-Quellcode:

interface
Type
  Tfactory = Class(TInterfacedObject)
  Strict Private
    Class Function Getclass(Classname: String; Out Index: Tcount;
      Out Constr: Pointer): TClass; Overload; Static;
    Class Var Fclassregister: Iclassregister;
    // implementation of ifactory interface
  Public
    Class Constructor Create; Reintroduce;
    Class Destructor Destroy; Reintroduce;
    // Class Procedure Reg(Cl: TClass; Aconstr: Pointer = Nil); Overload; Virtual;
    Class Procedure Reg(Cl: Tclass); Overload; Static;
    Class Procedure Reg(Classes: Array Of TClass); Overload; Static;
    Class Procedure UnReg(Cl: TClass); Overload; Static;
    Class Procedure UnReg(Classes: Array Of TClass); Overload; Static;
    Class Procedure Unregall; Virtual;
    Class Function New<T: Iinterface>(Classname: String;
      Parameters: Array Of Tvalue; Customconstructorname: String = 'create')
      : T; Overload;
    Class Function New<T: Iinterface>(Classname: String): T; Overload;
    Class Function IsRegistered(Classname: String): Boolean; Virtual;
    Class Function Getclass(Classname: String): TClass; Overload; Static;
    Class Function GetDecendents(Classname: String;
      Childrenonly: Boolean = True): Tstringlist; Static;
  End;
 {
    ============================================================================
    Instantiated factory and interface
    ============================================================================
  }
  Ifactory<T: Iinterface> = Interface
    ['{2DA05708-FB1B-426E-8FED-02A46A7F57B7}']
    Procedure Reg(Cl: Tclass); Overload;
    Procedure Reg(Classes: Array Of Tclass); Overload;
    Procedure UnReg(Cl: Tinterfacedclass); Overload;
    Procedure UnReg(Classes: Array Of Tclass); Overload;
    Function New(Classname: String; Parameters: Array Of Tvalue;
      Customconstructorname: String = 'create'): T; Overload;
    Function New(Classname: String): T; Overload;
    Function IsRegistered(Classname: String): Boolean;
    // Function Getclass(Classname: String): TClass; Overload;
  End;

  // instantiable Tfactory class
  TFactory<T: Iinterface> = Class(Tfactory, Ifactory<T>)
  Private
    Procedure Reg(Cl: Tclass); Overload;
    Procedure Reg(Classes: Array Of Tclass); Overload;
    Procedure UnReg(Cl: Tinterfacedclass); Overload;
    Procedure UnReg(Classes: Array Of Tclass); Overload;
    Function New(Classname: String; Parameters: Array Of Tvalue;
      Customconstructorname: String = 'create'): T; Overload;
    Function New(Classname: String): T; Overload;
    Function IsRegistered(Classname: String): Boolean;
  End;

 {
    ============================================================================
   A sample class to be created
    ============================================================================

 Ihello = Interface

    Procedure Hello;
  End;

  Thelloworld = Class(TInterfacedObject, Ihello)
    Procedure Hello;
  End;
  }

 implementation
//Base class and class register
{...}
Class Function Tfactory.New<T>(Classname: String; Parameters: Array Of Tvalue;
  Customconstructorname: String = 'create'): T;
  Var
    Ctx: TRttiContext;
    Method: Trttimethod;
    Aclass: Tclass;
    Atype: Trttitype;
  Begin
    Result := Nil;
    Try
      Aclass := Getclass(Classname);
      Atype := Ctx.GetType(Aclass);
      Method := Atype.GetMethod(Customconstructorname);
      If Assigned(Method)
      Then
        Result := Method.Invoke(Aclass, Parameters).AsType<T>;
    Except
      On E: Exception Do
        Showmessage(Self.Classname + ': Error constructing <' + Aclass.ClassName
          + '> - ' + E.Message + '.')
    End;
  End;

{...}

//instantiated
Function TFactory<T>.IsRegistered(Classname: String): Boolean;
  Begin
    Result := Inherited IsRegistered(Classname);
  End;

Function TFactory<T>.New(Classname: String; Parameters: Array Of Tvalue;
  Customconstructorname: String): T;
  Begin
    Result := Inherited New<T>(Classname, Parameters, Customconstructorname)
  End;

Function TFactory<T>.New(Classname: String): T;
  Begin
    Result := Inherited New<T>(Classname);
  End;

Procedure TFactory<T>.Reg(Cl: Tclass);
  Begin
    Inherited Reg(Cl);
  End;

Procedure TFactory<T>.Reg(Classes: Array Of Tclass);
  Begin
    Inherited Reg(Classes);
  End;

Procedure TFactory<T>.UnReg(Cl: Tinterfacedclass);
  Begin
    Inherited UnReg(Cl);
  End;

Procedure TFactory<T>.UnReg(Classes: Array Of Tclass);
  Begin
    Inherited UnReg(Classes);
  End;

wenn ich die class function normal aufrufe, kein problem. Leider knallts bei folgendem aufruf;

Delphi-Quellcode:

Procedure Testfactoryinterfacedconstraint;
  Var
    Factory: Ifactory<Ihello>; // beliebiges interface was von der zu generierenden klasse implementiert ist
    X: Ihello;//result object
  Begin
    Factory := TFactory<Ihello>.Create;
    Factory.Reg([Thelloworld, TAnotherHelloObject]); //zentral registriert
    X := Factory.New('thelloworld');//<< hier wird also obige function new aufgerufen, die das dann an die class function weiterleited.
//in der class function knallts dann an der folgenden stelle: (aclass korrekt gefunden,ebenso wie method)
{ If Assigned(Method)
      Then
        Result := Method.Invoke(Aclass, Parameters).AsType<T>; //hier beim ASType<T> conversion prozess>>invalid type cast}
    X.Hello;

  End;

Wieso wird denn da ein Typecast error ausgeworfen??





>>>>>Nachtrag: Der typecast lag an der fehlenden Interface identifikation via GUID.
Kann mir das "method.invoke().astype<t> keine entsprechende fehlermeldung ausgeben, wenn keine GUID oder ein nicht unterstütztes Interface angegeben? So ählnlich wie bei dem AS und IS operator?

Und kann ich evlt verhindern, dass mit  ifactory<t:interface>.reg(aclass:tclass) eine Klasse registriert wird, die T nicht unterstützt?