代码之家 › 专栏 › 技术社区 › DeCoder

Delphi中实例化不同类型的泛型机制

inheritance generics delphi oop

DeCoder · 技术社区 · 7 年前

我尝试使用泛型来“泛化”一个实例化不同类型网络传输的var。我不确定“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实例(没有类型转换)自动显示特定于子类的属性/字段/方法。

这样,我就可以有一个配置屏幕,允许管理员选择传输的类型,比如在一个组合框中,将该变量的值设置为<gt;in代码中的类型,一组代码根据对象的类型处理对象的创建。

这是否可能使用泛型?

1 回复 | 直到 7 年前

DeCoder 7 年前

这是我第一次(微弱的)尝试在一个一流的工厂,从来没有这样做过。它可以部分地工作(生成正确的类),但是如果没有类型转换,它就不能作为基类的一个不同的子类来访问,这就破坏了它的用途。请参阅内联注释

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;