Generic mechanism for instantiating distinct types in Delphi

Question

I'm trying to use generics to 'genericize' a var that instantiates network transports of different types. I'm not sure if the "generic=no RTTI" rule would invalidate the approach or not, as I'm not yet up to speed with generics.

I've read this post:

What is the correct way to structure this generic object creation , which states the following in the question:

One other thing I would like to do if possible, is to change two creations:

 LAdapter := TSQLiteNativeConnectionAdapter.Create(LFilename) LAdapter := TFireDacConnectionAdapter.Create(FDatabaseLink.FConnection as TFDConnection, FDatabaseLink.OwnedComponent) 

to use an abstract "GetAdapterClass" type function in the parent TModelDatabaseConnection and just declare the class of adapter in the child to do something like:

 LAdapter := GetAdapterClass.Create...

This is exactly what I would like to do as well. So if you can picture this:

type
  TTransport<T> = class(TComponent)
  private
    ...
    function GetTransport: TTransport;
    procedure SetTransport(AValue: TTransport);
    ...
  public
    ...
    property Transport: TTransport read GetTransport write SetTransport;
    ...
  end;

  TTCPIPTransport = class(TTransport<T>)
  private
    function GetSocket(Index: Integer): String;
    procedure SetSocket(Index: Integer; AValue: String);
  public
    property Socket[Index: Integer]: String read GetSocket write SetSocket;
  end;

  TServiceTransport = class(TTransport<T>)
  private
    function GetServiceName: String;
    procedure SetServiceName(AValue: String);
  public
    property ServiceName: String read GetServiceName write SetServiceName;
  end;

  TISAPITransport = class(TServiceTransport<T>);

  THTTPSysTransport = class(TServiceTransport<T>)
  private
    function GetURL(Index: Integer): String;
    procedure SetURL(Index: Integer; AValue: String);
  public
    property URL[Index: Integer]: read GetURL write SetURL;
  end;

  etc.

The idea is to create a base class that has all fields/properties/methods that are common to all transports, then have intermediate classes that contain fields/methods/properties that are common only to a certain subset of transports, then have the final version of each transport be specific to the type.

So when I call:

var
  trans: TTransport<T> // or TTransport<TTCPIPTransport> etc.
begin
  trans := TTransport<TTCPIPTransport>.Create(AOwner,....);
  trans.Transport.Socket[0] := '127.0.0.1:8523';
          OR
  trans := TTransport<TISAPITransport>.Create(AOwner,...);
  trans.Transport.ServiceName = 'Foo';
  ...
  etc.
end;

or perhaps even more generic then that, but have each instance of trans - without typecasting - have properties/fields/methods that are specific to the subclass automagically show up.

This way I can have a config screen that allows an administrator to select the type of transport say in a combo box, the have that variable value set the type inside the <> in code, and one set of code handles creation of the object by it's type.

Is this possible using generics?

Answer 1

Here is my first (feeble) attempt at a class factory, never done this before. It works partially (generates the correct class) but isn't accessible as a distinct subclass of the base class without typecasting, which defeats the purpose. Please see inline comments

TWSTransport = class(TComponent)
  ...
public
  constructor Create(AOwner: TComponent); virtual; 
  ....   
end;

TWSTransportClass = Class of TWSTransport;

TWSTCPIPTransportClass = class of TWSTCPIPTransport;

TWSHTTPSysTransport = class(TWSServiceTransport);

TWSServiceTransport = class(TWSTransport);

TWSTransportStringConversion = class(TWSTransport);

TWSTransportStreamFormat = class(TWSTransportStringConversion);

TTransportFactory = class(TClassList)
private
  function GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
public
  procedure RegisterTransportClass(ATransportClass: TWSTransportClass);
  property Transport[Index: TWSTransportClass; AOwner: TkbmMWServer]: TWSTransportClass read GetTransport;
end;    

function TTransportFactory.GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
begin
if IndexOf(Index) > -1 then
  Result := TWSTransportClass(Items[IndexOf(Index)])
else
  Result := TWSTransportClass(Index.Create(AOwner));
end;

procedure TTransportFactory.RegisterTransportClass(ATransportClass: TWSTransportClass);
var
  index: Integer;
begin
  // is the transport registered?
  index := IndexOf(ATransportClass);
  if index < 0 then
    // the transport is not registered, add it to the list
    Add(ATransportClass);
end;



initialization
  factory := TTransportFactory.Create;
  factory.RegisterTransportClass(TWSHTTPSysTransport);
  factory.RegisterTransportClass(TWSISAPIRESTTransport);
  factory.RegisterTransportClass(TWSTCPIPTransport);

finalization
  FreeAndNil(factory);

end.

Here's how I tested it:

procedure TForm4.FormCreate(Sender: TObject);
var
  //trans: TWSTCPIPTransport; // this doesn't work
  trans: TWSTransport; // this works
begin
  trans := factory.Transport[TWSTCPIPTransport,Self];
  showmessage(trans.classname); // this shows the correct classname - TWSTCPIPTransport
  trans.AddSocket('127.0.0.1:80'); // the compiler gives an error here because this call is specific to a subclass of TWSTransport, TWSTCPIPTransport.
end;

So I'm still missing something... anyone see the mistake?