vba - 我需要实现什么接口(interface)才能允许 VBA 中的 ForEach 作用于用 delphi 编写的 COM 对象？

Question

假设我想在 VBA(伪代码)中执行类似的操作，并假设我有一个可枚举属性 IDList:

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

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

我的属性(property)是什么 IDList必须看起来像德尔福？简单地从 IEnumerable<integer> 导出它或IEnumerable似乎没有完成这项工作。

基本代码

为了避免出现默认IENum的麻烦和IEnum<T>接口(interface) 我已经在 Delphi 端创建了自己的一组枚举接口(interface)，用于 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;

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

Answer 1

摘要

我创建了一个通用接口(interface)适配器，可以或多或少地轻松实现 IEnumVariant 接口(interface)。我还发现 IEnumVariant 接口(interface)是在 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 基类和正确的类型库方面遇到了困难，但我最终成功地解决了这个问题，如下所示。我对类型库使用类变量以避免一遍又一遍地加载它。

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;

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

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;

我稍后添加了克隆和重置选项，因为它们实际上并未被我的应用程序使用，所以也许供将来使用。实现如下所示:

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 枚举器提供我的内部解决方案的所有代码远远超出了本期主题，这就是为什么我没有为此创建演示项目。谁知道呢，如果我有时间和足够的支持/请求，我可能会投入更多的精力。我希望我在德尔福寻找“有效且干净”的解决方案的旅程能够对其他人有所帮助。