Общий механизм создания отдельных типов в Delphi

Question

Я пытаюсь использовать дженерики, чтобы «обобщить» переменную, которая создает сетевые транспорты разных типов. Я не уверен, что правило "generic = no RTTI" лишает законной силы подход или нет, поскольку я еще не освоил дженерики.

Я читал этот пост:

Как правильно структурировать создание этого общего объекта , в котором говорится следующее:

Еще одна вещь, которую я хотел бы сделать, если это возможно, это изменить два творения:

LAdapter := TSQLiteNativeConnectionAdapter.Create(LFilename)

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

чтобы использовать абстрактную функцию типа "GetAdapterClass" в родительском элементе TModelDatabaseConnection и просто объявите класс адаптера в ребенок сделать что-то вроде:

 LAdapter := GetAdapterClass.Create...

Это именно то, что я хотел бы сделать также. Так что, если вы можете изобразить это:

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.

Идея состоит в том, чтобы создать базовый класс, который имеет все поля / свойства / методы, которые являются общими для всех транспортов, затем имеет промежуточные классы, которые содержат поля / методы / свойства, которые являются общими только для определенного подмножества транспортов, и затем иметь окончательная версия каждого транспорта должна соответствовать типу.

Поэтому, когда я звоню:

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;

или, может быть, даже более общий, но у каждого экземпляра trans - без приведения типов - есть свойства / поля / методы, которые являются специфическими для подкласса, автоматически отображаются.

Таким образом, у меня может быть экран конфигурации, который позволяет администратору выбирать тип транспорта, скажем, в поле со списком, значение этой переменной задает тип внутри кода <> в коде, и один набор кода обрабатывает создание объект по типу.

Возможно ли это с использованием дженериков?

Answer 1

Вот моя первая (слабая) попытка на фабрике классов, никогда не делавшая этого раньше. Он работает частично (генерирует правильный класс), но не доступен как отдельный подкласс базового класса без приведения типов, что противоречит цели. Пожалуйста, смотрите встроенные комментарии

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.

Вот как я это проверил:

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;

Значит, я все еще что-то упускаю ... кто-нибудь видит ошибку?