在Delphi中实例化不同类型的通用机制

时间:2018-09-05 20:37:41

标签: oop delphi generics inheritance

我正在尝试使用泛型来“泛化”一个实例化不同类型网络传输的变量。我不确定“ generic = no RTTI”规则是否会使该方法无效,因为我还没有紧跟泛型。

我已经阅读了这篇文章:

What is the correct way to structure this generic object creation,它在问题中陈述以下内容:

  

如果可能的话,我想做的另一件事是改变两个   创作:

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的每个实例-不进行类型转换-自动显示子类特有的属性/字段/方法。

这样,我可以拥有一个配置屏幕,该屏幕允许管理员在组合框中选择传输的类型,让该变量值在代码中的<>内设置类型,并由一组代码来处理该对象的类型。

使用泛型有可能吗?

1 个答案:

答案 0 :(得分:0)

这是我第一次在班级工厂做(微弱的)尝试,以前从未做过。它可以部分工作(生成正确的类),但是如果不进行类型转换,则不能作为基类的不同子类进行访问,这违背了目的。请查看内嵌评论

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;

所以我仍然缺少一些东西……有人看到错误了吗?