1. 技术文章
  2. What interface to I need to implement to allow ForEach in VBA on a COM object written in delphi?

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

由 馋奶兔 提交于 2019-12-23 15:48:15

问题


Imagine I want to do something like this in VBA (pseudocode), and assuming my has an enumerable property IDList:

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

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

What would my property IDList have to look like in Delphi? Simply deriving it from IEnumerable<integer> or IEnumerable does not seem to do the job.

Base code

In order to avoid trouble with the default IENum and IEnum<T> interfaces I have created my own set of interfaces for enumeration on the Delphi side, to be used in object pascal for .. in .. loops.

 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;

So the enumerators I use in my application use these interfaces to "publish" themselves. What I want is to have an adapter class that allows for creating the IEnumVariant interface on may ISGEnumerator<T> and ISGEnumerable<T> interfaces


回答1:


Summary

I have created a generic interface adapter that allows for more or less easy implementation of the IEnumVariant interface. I also discovered that the IEnumVariant interface is defined in the ActiveX unit provided with Delphi, and that it uses stdole32.tpl as a type library.

OLE enumerator base classes

Here are the enumerator base and the generic enumerator base 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;

I struggled with the instantiation TAutoIntfObject base class and the correct type libraries, but I finally managed to work it out like below. I use a class var for the type library to avoid loading it over and over again.

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;

After that I implemented the interface's methods, also allowing for exceptions to be handled correctly for the dispintf. The actual "meat" of the loop implementation are put in virtual methods called from the interface methods. The interface methods look like this:

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 and Reset I have added virtual methods for the Clone and Reset methods, but these are actually not called from within Excel VBA in my example,

Generic IEnumVariant adapter class The next thing was to create the Generic adapter which overrides the Doxxx methods and adds a MapCurrentToVariant routine to get the 'Current' value from the source enumerator to the output variant. This routine is virtual so it can be overridden for special or more efficient transformations.

Thus the generic class looks like this:

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;

Implementing the overridden routines was pretty straightforward.

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;

I have added the Clone and Reset options later on, as they are not actually used by my application, so maybe for future usage. The implementations look like this:

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;

Finally, I decided to create an enumerable adapter class as well which may come in handy in some cases:

  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;

The implementation of the 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;

At the spots where I plan to use my code, everything looks rather clean, and only little has to be implemented. Below is an example of the enumerator to get a bunch of object IDs from my actual application model:

  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;

The code has actually been tested using Excel and Delphi, but providing all the code with my internal solutions for the Delphi enumerators is way beyond the topic of this issue, that;s why I did not create a demo project for this. Who knows, if I find the time and enough upvotes/requests I may put some more energy in this. I hope my journey into finding a "working and clean" solution for this in Delphi will help others.



来源：https://stackoverflow.com/questions/52114727/what-interface-to-i-need-to-implement-to-allow-foreach-in-vba-on-a-com-object-wr

标签
vba
Delphi
collections
com
ienumerator
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!