VBA 中的 Functor

Yiannis Spyridakis

4.40/5 (10投票s)

2011年6月3日

CPOL

3分钟阅读

53638

1797

本文介绍了使用 C++ ATL 为 VBA 实现函子（某种程度上）。

引言

本文提出了一种在 ATL 中为 VBA/VB6 使用函子（即函数对象）的实现方法。

VBA 对指针的支持非常少，除了 AddressOf 运算符外，不支持函数指针。在过去几年里，我一直在使用 Excel VBA，我经常觉得，如果能够访问函数指针，我的通用编程工作将会变得轻松得多。

此实现允许编写如下所示的 VBA 代码

'-- Initialize a functor that hooks on a **Sub** that takes two args.
Dim opfn As Functor: Set opfn = New_Functor(AddressOf MyFunction, retvoid_2_args)
'-- Invoke the function through the functor
Call opfn.call_retvoid_2("This works", " fine!")

背景/ C++ 实现

该项目（用 C++ ATL - VS2010 编写）编译成一个 COM DLL。导出的 Functor 对象可以在 VBA 代码中使用以

存储函数的地址（函数类型在此阶段是一个输入）和
稍后通过使用与函数类型匹配的 Functor 对象的方法来调用它

HookFunction() 方法和一个示例函数调用方法的 IDL 声明如下

interface IFunctor : IDispatch{
 [id(1), helpstring("Hooks on a function")] 
  HRESULT HookFunction([in] LONG fnAddress, [in] enum FuncType functionType);

 [id(8), helpstring("Calls Function that a)Retruns VARIANT b)Takes 2 arguments")] 
  HRESULT call_retvar_2([in,out,optional]VARIANT* 
	Arg1,[in,out,optional]VARIANT* Arg2,[out,retval]VARIANT*);

被挂钩的函数可以是 Functor.h 中 typedef 的类型之一

// Functions returning void
typedef HRESULT (__stdcall *pfn_retvoid_0)(void);
typedef HRESULT (__stdcall *pfn_retvoid_1)(VARIANT*);
typedef HRESULT (__stdcall *pfn_retvoid_2)(VARIANT*, VARIANT*);
typedef HRESULT (__stdcall *pfn_retvoid_3)(VARIANT*, VARIANT*, VARIANT*);
// Functions returning VARIANT
typedef HRESULT (__stdcall *pfn_retvar_0)(VARIANT*);
typedef HRESULT (__stdcall *pfn_retvar_1)(VARIANT*, VARIANT*);
typedef HRESULT (__stdcall *pfn_retvar_2)(VARIANT*, VARIANT*, VARIANT*);
typedef HRESULT (__stdcall *pfn_retvar_3)(VARIANT*, VARIANT*, VARIANT*, VARIANT*);
// Functions returning VBA Boolean
typedef VARIANT_BOOL (__stdcall *pfn_retbool_0)(void);
typedef VARIANT_BOOL (__stdcall *pfn_retbool_1)(VARIANT*);
typedef VARIANT_BOOL (__stdcall *pfn_retbool_2)(VARIANT*, VARIANT*);
typedef VARIANT_BOOL (__stdcall *pfn_retbool_3)(VARIANT*, VARIANT*, VARIANT*);

这些函数类型对应于 enum FuncType (定义在 VBA_Functors.idl 中) 的成员，该枚举也从 DLL 中导出

[
 uuid(708D69A2-B470-4530-82B7-5D825EC9F8ED),
 v1_enum
] 
enum FuncType
{
 retvoid_0_args,
 retvoid_1_args,
 retvoid_2_args,
 retvoid_3_args,
 retvar_0_args,
 retvar_1_args,
 retvar_2_args,
 retvar_3_args,
 retbool_0_args,
 retbool_1_args,
 retbool_2_args,
 retbool_3_args
};

该 DLL 还导出一个初始化器类（用于模拟带有参数的构造函数），该类公开返回新初始化的 COM 对象的函数；此处 New_Functor() 返回一个新初始化的 Functor (IFunctor) 对象。来自 ClassInitializer.cpp

// Returns a newly initialized Functor object
STDMETHODIMP CClassInitializer::New_Functor(/*[in]*/LONG fnAddress, 
	/*[in]*/FuncType functionType, /*[out,retval]*/IFunctor** ret)
{
 HRESULT hr = CFunctor::CreateInstance(ret);
 if (FAILED(hr)){ 
  return hr;
 }
 return (*ret)->HookFunction(fnAddress, functionType);
}

IDL 声明如下。注意 coclass ClassInitializer 的 appobject 属性。这使得该对象成为全局对象（即，其方法可以被引用 DLL 而无需声明该类型变量的 VBA 代码调用）。

[...]
interface IClassInitializer : IDispatch{
 [id(1), helpstring("Returns a newly initialized Functor object")] 
  HRESULT New_Functor([in] LONG fnAddress, [in] enum FuncType functionType, 
	[out,retval] IFunctor**);
};
library VBA_FunctorsLib
{ ...
 [
  appobject, 
  uuid(C9CE3589-1E7F-4750-9E5F-4B48DB1883DB)  
 ]
 coclass ClassInitializer
 {
  [default] interface IClassInitializer;
 };
}

Using the Code

源代码中包含的文件 [VBA_Functors_Test.xls] 包含一些（人为的）使用 VBA 中的 Functor 对象的示例。

VBA 项目包含对 DLL (VBA_Functors.dll) 的引用
DLL 是一个 COM DLL，需要注册（通常使用 regsvr32.exe，有关一些说明，请参阅此链接）

为了从 VBA 正确初始化 Functor 对象，您需要

声明和初始化 Functor 变量
挂钩到现有的 VBA 函数。该函数必须是预先指定的类型之一，并且需要通过 HookFunction() 的第二个参数传入正确的函数类型（如上所述，函数类型封装在 FuncType 枚举中，因此 VBA 自动完成方便地启动）

Public Function SimpleFunction(ByRef vDisplay As Variant) As Variant
    SimpleFunction = MsgBox(vDisplay, vbYesNo, "Did that display correctly?")
End Function
Public Sub UseFunctors()
    Dim ofn As Functor: Set ofn = New Functor
    Call ofn.HookFunction(AddressOf SimpleFunction, retvar_1_args)
End Sub

使用函数 New_Functor() 允许更紧凑的语法

Public Sub UseFunctors()
    Dim ofn As Functor: Set ofn = New_Functor(AddressOf SimpleFunction, retvar_1_args)
End Sub

然后，您可以使用 Functor 对象来调用被挂钩的函数。这是扩展后的 UseFunctors() sub，包括函数调用

Public Sub UseFunctors()
    Dim ofn As Functor: Set ofn = New_Functor(AddressOf SimpleFunction, retvar_1_args)
    Dim vbmRes As VbMsgBoxResult
    vbmRes = ofn.call_retvar_1("Display this!")
End Sub

当调用带有 Functor 参数的函数时，使用 New_Functor() 还可以内联初始化函子。考虑一下从示例 .xls 文件中的 MORE REALISTIC EXAMPLE 部分获取的以下代码段

'-- Predicate functions
Public Function IsMultipleOfTwo(ByRef vNumber As Variant) As Boolean
    IsMultipleOfTwo = (0 = vNumber Mod 2)
End Function
Public Function IsMultipleOfThree(ByRef vNumber As Variant) As Boolean
    IsMultipleOfThree = (0 = vNumber Mod 3)
End Function
'-- The generic function
Public Function CountMultiplesOfNumber(ByRef lNumber() As Long, _
	ByRef pfn As Functor) As Long
    Dim vIter As Variant
    For Each vIter In lNumber
        If pfn.call_retbool_1(vIter) Then CountMultiplesOfNumber = _
						CountMultiplesOfNumber + 1
    Next vIter
End Function
'-- The client code
Public Sub TestAbove()
    Dim alNUms(0 To 100) As Long ' The array is somehow initialized...
    '-- CountMultiplesOfNumber is Customized using a Functor constructed in line
    MsgBox CountMultiplesOfNumber(alNUms, New_Functor_
		(AddressOf IsMultipleOfThree, retbool_1_args))
End Sub

我认为，当人们考虑从 DLL 中导出“库存”函子（想到了全局对象的导出方法）时，事情会变得更加有趣，这些函子可以选择性地用于 VBA 端，以驱动 DLL 导出的算法的行为（在 VBA SafeArrays 上变异/非变异 for_each 吗？）

关注点

一些值得注意的点

在企业环境中工作后，我意识到安全策略可能会与 COM 组件的注册发生冲突。后者传统上是在 HKEY_LOCAL_MACHINE 下注册的，而典型用户没有对该配置单元的写访问权限。
在 HKEY_CURRENT_USER 下注册组件可以解决此问题。在 ATL 中，可以使用 AtlSetPerUserRegistration(true) 来实现该目的。这是 VBA_Functors.cpp 中的 DllRegisterServer 定义
```
// DllRegisterServer - Adds entries to the system registry.
STDAPI DllRegisterServer(void)
{
 // Register/Unregister under HKCU
 ATL::AtlSetPerUserRegistration(true);
 // registers object, typelib and all interfaces in typelib
 HRESULT hr = _AtlModule.DllRegisterServer();
 return hr;
}
```
此项目中包含的文件 com_definitions.h 将通常用作 COM 方法返回值的 HRESULT 结构化为 COMErrorCodes 命名空间下的 enum。这允许编写如下所示的代码（而无需在 WinError.h 中查找代码）
```
STDMETHODIMP CFunctor::call_retvoid_0(void){
 if (retvoid_0_args == m_ft){
  ...
 }
 else{
  return Error(INCORRECT_FUNCTION_CALL_ERROR, 
	__uuidof(IFunctor), COMErrorCodes::E__INVALIDARG);
 }
}
```
敏锐的观察者可能已经在返回 Boolean 的函数的 typedef 中注意到，返回值没有实现为额外的 [out,retval] 参数。而是通过函数的返回值直接返回 True/False（大概是出于效率原因）
```
typedef VARIANT_BOOL (__stdcall *pfn_retbool_0)(void);
```

历史

2011 年 6 月 3 日：第一次修订