鸭子打字在Delphi 2007？

题：

有没有办法用Delphi 2007进行鸭式打字(即没有泛型和高级Rtti功能)？

Delphi 2010的鸭子打字资源：

> Duck Duck Delphi在google项目到ARCANA.
> Duck Typing in Delphi by Daniele Teti.
> AOP and duck typing in Delphi by Stefan Glienke.

最后编辑：

我已经深入到上面列出的资源中,并在这里研究了每个发布的答案.

我最终提出了我的要求,提出了一个follow up post这个问题.

解决方法

在ObjAuto.pas和可调用变体类型的帮助下,应该是可能的(用XE编写,但也应该在Delphi 7或更低版​​本中运行)：

unit DuckTyping;

interface

function Duck(Instance: TObject): Variant;

implementation

uses
  ObjAuto,SysUtils,TypInfo,Variants;

type
  TDuckVarData = packed record
    VType: tvarType;
    Reserved1,Reserved2,Reserved3: Word;
    VDuck: TObject;
    Reserved4: LongWord;
  end;

  TDuckVariantType = class(TPublishableVariantType)
  protected
    function GetInstance(const V: tvarData): TObject; override;
  public
    procedure Clear(var V: tvarData); override;
    procedure copy(var Dest: tvarData; const Source: tvarData;
      const Indirect: Boolean); override;
    function DoFunction(var Dest: tvarData; const V: tvarData;
      const Name: string; const Arguments: tvarDataArray): Boolean; override;
  end;

var
  DuckVariantType: TDuckVariantType;

{ TDuckVariantType }

procedure TDuckVariantType.Clear(var V: tvarData);
begin
  V.VType := varEmpty;
  TDuckVarData(V).VDuck := nil;
end;

procedure TDuckVariantType.copy(var Dest: tvarData; const Source: tvarData;
  const Indirect: Boolean);
begin
  if Indirect and VarDataIsByRef(Source) then
    VarDatacopyNoInd(Dest,Source)
  else
  begin
    with TDuckVarData(Dest) do
    begin
      VType := VarType;
      VDuck := TDuckVarData(Source).VDuck;
    end;
  end;
end;

function TDuckVariantType.DoFunction(var Dest: tvarData; const V: tvarData;
  const Name: string; const Arguments: tvarDataArray): Boolean;
var
  instance: TObject;
  methodInfo: PMethodInfoHeader;
  paramIndexes: array of Integer;
  params: array of Variant;
  i: Integer;
  ReturnValue: Variant;
begin
  instance := GetInstance(V);
  methodInfo := getmethodInfo(instance,ShortString(Name));
  Result := Assigned(methodInfo);
  if Result then
  begin
    SetLength(paramIndexes,Length(Arguments));
    SetLength(params,Length(Arguments));
    for i := Low(Arguments) to High(Arguments) do
    begin
      paramIndexes[i] := i + 1;
      params[i] := Variant(Arguments[i]);
    end;

    ReturnValue := ObjectInvoke(instance,methodInfo,paramIndexes,params);
    if not VarIsEmpty(ReturnValue) then
      Varcopy(Variant(Dest),ReturnValue);
  end
  else
  begin
    VarClear(Variant(Dest));
  end;
end;

function TDuckVariantType.GetInstance(const V: tvarData): TObject;
begin
  Result := TDuckVarData(V).VDuck;
end;

function Duck(Instance: TObject): Variant;
begin
  TDuckVarData(Result).VType := DuckVariantType.VarType;
  TDuckVarData(Result).VDuck := Instance;
end;

initialization
  DuckVariantType := TDuckVariantType.Create;

finalization
  FreeAndNil(DuckVariantType);

end.

你可以这样简单地使用它：

type
  {$METHODINFO ON}
  TDuck = class
  public // works in XE,not sure if it needs to be published in older versions
    procedure Quack;
  end;

procedure TDuck.Quack;
begin
  ShowMessage('Quack');
end;

procedure DoSomething(D: Variant);
begin
  D.Quack;
end;

var
  d: TDuck;
begin
  d := TDuck.Create;
  try
    DoSomething(Duck(d));
  finally
    d.Free;
  end;
end;