我需要实现哪些接口以允许在VBA中使用Delphi编写的COM对象中的ForEach？

Question

想象一下，我想在VBA（伪代码）中做这样的事情，并假设我有一个可枚举的属性IDList：

Dim MyObject object
set MyObject= CreateObject("MyObjectClass")

for each Item as integer in MyObject.IDList
  Debug.Write(Cstr(Item) & ";")
Next

在德尔福，我的财产IDList会是什么样子？简单地从IEnumerable<integer>或IEnumerable推导它似乎没有做到这一点。

基本代码

为了避免使用默认的IENum和IEnum<T>接口的麻烦，我在Delphi端创建了我自己的枚举接口集，用于对象pascal for .. in ..循环。

 ISGEnumeratorBase= interface(IInterface)
    ['{DA91A203-3B39-4287-9A6F-6E9E4B184BAD}']
    function MoveNext: Boolean;
  end;

  ISGEnumeratorReset = interface (ISGEnumeratorBase)
    ['{FBD2EFBD-D391-4BE2-A3AB-9C9D09197F78}']
    procedure Reset;
  end;

  ISGEnumeratorClone = interface (ISGEnumeratorBase)
    ['{E3A128FD-7495-464D-BD5E-3EBA3AEFE94F}']
    function Clone:ISGEnumeratorBase;
  end;

  /// <summary>
  ///   <para>
  ///     Required for implementing for..in loops
  ///   </para>
  ///   An alternative generic interface for the IEnumerator&lt;T&gt; defined
  ///   in the system unit. Allows for easier implementation of enumerators for
  ///   interfaced classes etc.
  /// </summary>
  ISGEnumerator<T> = interface(ISGEnumeratorBase)
    function GetCurrent:T;
    property Current: T read GetCurrent;
  end;

  /// <summary>
  ///   <para>
  ///     Required for implementing for..in loops
  ///   </para>
  ///   <para>
  ///     An alternative generic interface for the IEnumerator&lt;T&gt;
  ///     defined in the system unit. Allows for easier implementation of
  ///     enumerators for interfaced classes etc. <br />
  ///   </para>
  /// </summary>
  ISGEnumerable<T>=interface(IInterface)
    function GetEnumerator:ISGEnumerator<T>;
  end;

因此，我在我的应用程序中使用的枚举器使用这些接口来“发布”自己。我想要的是有一个适配器类，允许在IEnumVariant和ISGEnumerator<T>接口上创建ISGEnumerable<T>接口

Answer 1

摘要

我创建了一个通用接口适配器，允许或多或少地轻松实现IEnumVariant接口。我还发现IEnumVariant接口是在Delphi提供的ActiveX单元中定义的，它使用stdole32.tpl作为类型库。

OLE枚举器基类

以下是枚举器基础和通用枚举器基类：

type
  TSGOLEVariantEnumeratorAdapterBase=class (TAutoIntfObject,IEnumVariant)
  private class var
    vOLETypeLib:ITypeLib;
  private
    class function GetOLETypeLib: ITypeLib; static;
    class Destructor ClassDestroy;
    // for IOLEEnumVariant
    function Next(celt: LongWord; var rgvar: OleVariant; out pceltFetched: Longword): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;
  protected
    class property OLETypeLib:ITypeLib read GetOLETypeLib;
    function DoNext(aFetchRequestCount: LongWord; var rgvar: OleVariant; out aActuallyFetchedCount: Longword): boolean; virtual; abstract;
    function DoSkip(aSkipCOunt: LongWord): boolean; virtual; abstract;
    function DoReset: boolean; virtual;
    function DoClone(out Enum: IEnumVariant): boolean; virtual;
  public
    constructor Create;
  end;

  TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>=class (TSGOLEVariantEnumeratorAdapterBase,ISGEnumerator<TEnumeratedType>)
  private
    FSourceEnumerator:ISGEnumerator<TEnumeratedType>;
  protected
    function MapCurrentToVariant(aCurrent:TEnumeratedType):olevariant; virtual;
    function DoReset: boolean; override;
    function DoClone(out Enum: IEnumVariant): boolean; override;
    function DoNext(aFetchRequestCount: LongWord; var rgvar: OleVariant; out aActuallyFetchedCount: Longword): boolean; override;
    function DoSkip(aSkipCOunt: LongWord): boolean; override;
    property SourceEnumerator:ISGEnumerator<TEnumeratedType> read FSourceEnumerator implements ISGEnumerator<TEnumeratedType>;
  public
    constructor Create(const aSourceEnumerator:ISGEnumerator<TEnumeratedType>);
  end;

我在实例化TAutoIntfObject基类和正确的类型库方面苦苦挣扎，但我终于成功地完成了下面的工作。我使用类var作为类型库，以避免一遍又一遍地加载它。

constructor TSGOLEVariantEnumeratorAdapterBase.Create;
begin
  inherited Create(OLETypeLib,IEnumVariant);
end;

class destructor TSGOLEVariantEnumeratorAdapterBase.ClassDestroy;
begin
  vOLETypeLib:=nil;
end;

class function TSGOLEVariantEnumeratorAdapterBase.GetOLETypeLib: ITypeLib;
begin
  // HH we cannot lose Win.ComServ in a package
  // thats why I cloned the call or LoadTypeLibrary here
  if not Assigned(vOLETypeLib) then
    OleCheck(LoadTypeLibEx('stdole32.tlb', REGKIND_NONE, vOLETypeLib));
  Result:=vOLETypeLib;
end;

之后我实现了接口的方法，也允许为dispintf正确处理异常。循环实现的实际“肉”放在从接口方法调用的虚拟方法中。接口方法如下所示：

function TSGOLEVariantEnumeratorAdapterBase.Next(celt: LongWord; var rgvar: OleVariant;
  out pceltFetched: Longword): HResult;
VAR lActuallyFetched:longword;
begin
  lActuallyFetched:=0;
  try
    if DoNext(celt,rgvar,lActuallyFetched) then
      Result:=S_OK
    else Result:=S_FALSE;
    if Assigned(@pceltFetched) then
      pceltFetched:=lActuallyFetched;
  except
    Result:=SafeCallException(ExceptObject,ExceptAddr);
  end;
end;

function TSGOLEVariantEnumeratorAdapterBase.Skip(celt: LongWord): HResult;
begin
  try
    if DoSkip(celt) then
      Result:=S_OK
    else Result:=S_FALSE;
  except
    Result:=SafeCallException(ExceptObject,ExceptAddr);
  end;
end;

function TSGOLEVariantEnumeratorAdapterBase.Reset: HResult;
begin
  try
    if DoReset then
      Result:=S_OK
    else Result:=S_FALSE;
  except
    Result:=SafeCallException(ExceptObject,ExceptAddr);
  end;
end;

function TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.DoClone(out Enum: IEnumVariant): boolean;
VAR lCloneIntf:ISGEnumeratorClone;
    lCLonedEnumerator:ISGEnumerator<TEnumeratedType>;
begin
  if Supports(FSourceEnumerator,ISGEnumeratorClone,lCloneIntf) then
  begin
    lCLonedEnumerator:=ISGEnumerator<TEnumeratedType>(lCloneIntf.Clone);
    Enum:=TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>(self.ClassType).Create(lCLonedEnumerator);
    Result:=True;
  end
  else Result :=inherited;
end;


function TSGOLEVariantEnumeratorAdapterBase.Clone(out Enum: IEnumVariant): HResult;
begin
  try
    if DoClone(Enum) then
      Result:=S_OK
    else Result:=S_FALSE;
  except
    Result:=SafeCallException(ExceptObject,ExceptAddr);
  end;
end;

克隆和重置我已经为Clone和Reset方法添加了虚拟方法，但实际上在我的示例中没有从Excel VBA中调用这些方法，

通用IEnumVariant适配器类接下来是创建通用适配器，它覆盖Doxxx方法并添加MapCurrentToVariant例程以从源枚举器获取“当前”值到输出变量。此例程是虚拟的，因此可以覆盖它以进行特殊或更有效的转换。

因此泛型类看起来像这样：

TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>=class (TSGOLEVariantEnumeratorAdapterBase,ISGEnumerator<TEnumeratedType>)
  private
    FSourceEnumerator:ISGEnumerator<TEnumeratedType>;
  protected
    function MapCurrentToVariant(aCurrent:TEnumeratedType):olevariant; virtual;
    function DoReset: boolean; override;
    function DoClone(out Enum: IEnumVariant): boolean; override;
    function DoNext(aFetchRequestCount: LongWord; var rgvar: OleVariant; out aActuallyFetchedCount: Longword): boolean; override;
    function DoSkip(aSkipCOunt: LongWord): boolean; override;
    property SourceEnumerator:ISGEnumerator<TEnumeratedType> read FSourceEnumerator implements ISGEnumerator<TEnumeratedType>;
  public
    constructor Create(const aSourceEnumerator:ISGEnumerator<TEnumeratedType>);
  end;

实现重写的例程非常简单。

constructor TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.Create(
  const aSourceEnumerator: ISGEnumerator<TEnumeratedType>);
begin
  FSourceEnumerator:=aSourceEnumerator;
  inherited Create;
end;

function TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.MapCurrentToVariant(aCurrent: TEnumeratedType): olevariant;
begin
  Result:=TValue.From<TEnumeratedType>(aCurrent).AsVariant;
end;
function TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.DoNext(aFetchRequestCount: LongWord;
  var rgvar: OleVariant; out aActuallyFetchedCount: Longword): boolean;
type
  TVariantList=array[0..0] of Olevariant;
begin
  aActuallyFetchedCount:=0;
  while (aFetchRequestCount>0) and SourceEnumerator.MoveNext do
  begin
    dec(aFetchRequestCount);
    TVariantList(rgvar)[aActuallyFetchedCount]:=MapCurrentToVariant(SourceEnumerator.Current);
    inc(aActuallyFetchedCount);
  end;
  Result:=(aFetchRequestCount=0);
end;

function TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.DoSkip(aSkipCOunt: LongWord): boolean;
begin
  while (aSkipCount>0) and SourceEnumerator.MoveNext do
    dec(aSkipCount);
  Result:=(aSkipCOunt=0);
end;

我稍后添加了Clone和Reset选项，因为它们实际上并未被我的应用程序使用，因此可能将来使用。实现看起来像这样：

function TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.DoClone(out Enum: IEnumVariant): boolean;
VAR lCloneIntf:ISGEnumeratorClone;
    lCLonedEnumerator:ISGEnumerator<TEnumeratedType>;
begin
  if Supports(FSourceEnumerator,ISGEnumeratorClone,lCloneIntf) then
  begin
    lCLonedEnumerator:=ISGEnumerator<TEnumeratedType>(lCloneIntf.Clone);
    Enum:=TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>(self.ClassType).Create(lCLonedEnumerator);
    Result:=True;
  end
  else Result :=inherited;
end;

function TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.DoReset: boolean;
VAR lResetIntf:ISGEnumeratorReset;
begin
  if Supports(FSourceEnumerator,ISGEnumeratorReset,lResetIntf) then
  begin
    lResetIntf.Reset;
    Result:=True;
  end
  else Result := inherited;
end;

最后，我决定创建一个可枚举的适配器类，在某些情况下可能会派上用场：

  TSGGenericOLEVariantEnumerableAdapter<TEnumeratedType>=class (TAutoIntfObject,ISGEnumerable<TEnumeratedType>)
  private
    FSourceEnumerable:ISGEnumerable<TEnumeratedType>;
  protected
    function Get__NewEnum: IUnknown; safecall; inline;
    property SourceEnumerable:ISGEnumerable<TEnumeratedType> read FSourceEnumerable implements ISGEnumerable<TEnumeratedType>;
  public
    constructor Create(const aTypeLib:ITypeLib;const aDispIntf:TGUID;const aSourceEnumerable:ISGEnumerable<TEnumeratedType>);
  end;

该类的实施：

constructor TSGGenericOLEVariantEnumerableAdapter<TEnumeratedType>.Create(const aTypeLib:ITypeLib;const aDispIntf:TGUID;const aSourceEnumerable:ISGEnumerable<TEnumeratedType>);
begin
  FSourceEnumerable:=aSourceEnumerable;
  inherited Create(aTypeLib,aDispIntf);
end;

function TSGGenericOLEVariantEnumerableAdapter<TEnumeratedType>.Get__NewEnum: IUnknown;
begin
  Result:=TSGGenericOLEVariantEnumeratorAdapter<TEnumeratedType>.Create(SourceEnumerable.GetEnumerator);
end;

在我计划使用我的代码的地方，一切看起来都很干净，而且只需要很少实现。下面是一个枚举器的示例，用于从我的实际应用程序模型中获取一堆对象ID：

  TAMDBObjIDEnumeratorAdapter=class (TSGGenericOLEVariantEnumeratorAdapter<integer>);

  TAMDBObjIDEnumerableAdapter=class (TSGGenericOLEVariantEnumerableAdapter<integer>,IAMObjectIDs,ISGEnumerable<integer>)
  public
    constructor Create(const aSourceEnumerable:ISGEnumerable<integer>);
  end;
....

constructor TAMDBObjIDEnumerableAdapter.Create(const aSourceEnumerable: ISGEnumerable<integer>);
begin
  inherited Create(comserver.TypeLib,IAMObjectIDs,aSOurceEnumerable);
end;

代码实际上已经使用Excel和Delphi进行了测试，但是为Delphi枚举器提供我的内部解决方案的所有代码超出了这个问题的主题，那就是为什么我没有为此创建一个演示项目。谁知道，如果我找到时间和足够的赞成/请求，我可能会在这方面投入更多精力。我希望我在Delphi中寻找“工作和清洁”解决方案的过程将有助于其他人。