我需要实现什么接口才能在 delphi 中编写的 COM 对象上允许 VBA 中的 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 在 Delphi 中应该是什么样子？简单地从 IEnumerable<integer> 或 IEnumerable 派生它似乎并不能完成这项工作。

基本代码

为了避免默认 IENum 和 IEnum<T> 接口出现问题，我在 Delphi 端创建了自己的一组用于枚举的接口，用于 object 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;

所以我在我的应用程序中使用的枚举器将这些接口用于 "publish" 自身。我想要的是有一个适配器 class 允许在 ISGEnumerator<T> 和 ISGEnumerable<T> 接口

上创建 IEnumVariant 接口

Answer 1

总结

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

OLE 枚举器基 classes

这是枚举器基数和通用枚举器基数 classes:

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 基础 class 和正确的类型库上苦苦挣扎，但我终于设法像下面那样解决了。我为类型库使用 class 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 正确处理异常。循环实现的实际 "meat" 放在从接口方法调用的虚拟方法中。接口方法如下所示：

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 适配器 class 接下来是创建通用适配器，它覆盖 Doxxx 方法并添加一个 MapCurrentToVariant 例程以从源枚举器获取 'Current' 值到输出变体。此例程是虚拟的，因此可以覆盖它以进行特殊或更有效的转换。

因此通用 class 看起来像这样：

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;

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

  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;

执行class:

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 枚举器提供所有代码以及我的内部解决方案超出了本期的主题，那就是为什么我没有为此创建演示项目。谁知道呢，如果我有足够的时间 upvotes/requests，我可能会在这上面投入更多的精力。我希望我在 Delphi 中为此寻找 "working and clean" 解决方案的旅程能帮助其他人。

我需要实现什么接口才能在 delphi 中编写的 COM 对象上允许 VBA 中的 ForEach？

What interface to I need to implement to allow ForEach in VBA on a COM object written in delphi?

delphi

com

collections

ienumerator

vba