Click here to Skip to main content
Click here to Skip to main content

Functors in VBA

, 7 Mar 2012 CPOL
Rate this:
Please Sign up or sign in to vote.
This articles describes the implementation of functors (of sorts) for VBA using C++ ATL.

Introduction

This article suggests an implementation of functors (i.e. function objects) in ATL for VBA/VB6 consumption.

VBA comes with very little support for pointers and no support for function pointers apart from the AddressOf operator. I have been working with Excel VBA for the past few years and I often feel that access to function pointers would make my life much easier when it comes to generic programming.

This implementation allows VBA code like the below to be written:

'-- 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!")

Background/ C++ Implementation

The project (written in C++ ATL - VS2010) compiles to a COM DLL. The exported Functor objects can be used in VBA code to:

  • Store the address of a function (the function type is an input at this stage) and
  • Later call it by using the method of the Functor object that matches the function type

The IDL declarations of the HookFunction() method and a sample function calling method are:

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*);

The hooked functions can be of one of the types that are typedef'd in Functor.h:

// 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*); 

These function types correspond to members of the enum FuncType (defined in VBA_Functors.idl) that is also exported from the 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
};

The DLL also exports an initializer class (used to simulate a constructor with arguments) that exposes functions that return newly initialized COM objects; here New_Functor()returns a newly initialized Functor (IFunctor) object. From 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);
}

The IDL declarations follow. Notice the appobject attribute of coclass ClassInitializer. This makes the object global (i.e. its methods can be invoked by VBA code that references the DLL without dimensioning a variable of the type).

[...]
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

The file [VBA_Functors_Test.xls] that is included with the source code contains a few (contrived) examples of using Functor objects from VBA.

  • The VBA project contains a reference to the DLL (VBA_Functors.dll)
  • The DLL is a COM DLL that needs to be registered (typically using regsvr32.exe, for some instructions, see this link)

In order to correctly initialize a Functor object from VBA, you need to:

  • Dimension and initialize a Functor variable
  • Hook to an existing VBA function. The function has to be of one of the pre-specified types and the correct function type needs to be passed-in through the second argument of HookFunction() (as mentioned above, function types are encapsulated in the FuncType enum so VBA auto-complete conveniently kicks in)
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

Using the function New_Functor() allows for more compact syntax:

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

You can then use the Functor object to invoke the hooked function. Here is the UseFunctors() sub extended to include the function call:

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

Using New_Functor() also enables inline initialization of functors when calling functions that take Functor arguments. Consider the following snippet taken from the MORE REALISTIC EXAMPLE section of the VBA code in the sample .xls file:

'-- 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

In my opinion, things become even more interesting when one considers exporting "stock" functors from a DLL (exported methods of a global object come to mind) that can be used selectively on the VBA side to drive the behaviour of algorithms exported by the DLL (mutating/non-mutating for_each on VBA SafeArrays for example?)

Points of Interest

Some points worth noting:

  1. Having worked in a corporate environment, I've come to realize that security policies can clash with the registration of COM components. The latter were traditionally registered under HKEY_LOCAL_MACHINE and the typical user doesn't have write access to the hive.

    Registering components under HKEY_CURRENT_USER addresses this. In ATL AtlSetPerUserRegistration(true) can be used to that end. Here is the DllRegisterServer definition in VBA_Functors.cpp:

    // 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;
    }
  2. The file com_definitions.h included in this project structures HRESULTs commonly used as return values of COM methods in enums under COMErrorCodes namespace. This allows code like below to be written (without having to look up the codes in 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);
     }
    }
  3. Keen observers might have noticed in the typedefs for functions that return Boolean, that the return values are not implemented as an extra [out,retval] parameter. True/False is instead returned directly through the function's return value (presumably for efficiency reasons):
    typedef VARIANT_BOOL (__stdcall *pfn_retbool_0)(void);

History

  • 03 June 2011: First revision

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

Yiannis Spyridakis
Software Developer LogismiX
United Kingdom United Kingdom
Yiannis has been working as a developer in finance for over 6 years.
 
His background is in statistics and finance, but technology is his passion.
 
He started developing in Excel VBA and later graduated to C++, COM and C#. He also has a soft spot for Web Technologies (HTML, JavaScript, ASP.NET MVC).
 
Lately he has been working on a rapid development framework for the MS Office UI (Ribbon Commander) and has been having fun creating a framework that targets multiple technologies (VBA, .NET, C++).

Comments and Discussions

 
GeneralCalling functions by name in VBScript / VBA - alternative method using no DLLs etc Pinmemberjsc427-Jun-11 2:32 
It is possible to write a generic function to call other functions without regard to the no of arguments using 'pure' VBScript / VB for Applications.
 
e.g. (this is the VBScript version, but you should be able to take it 'as is' or improve it for VBA):
 
Public Function	CallFn(ByVal FunctionName, ByVal Args)	' ( As String, As Variant ) As Variant
	' Args is array of arguments or single argument or Empty if no arguments
	' Note: To pass a single argument that is Empty or an Array, wrap it in another Array
	Const	Args10	= ", Args(x0), Args(x1), Args(x2), Args(x3), Args(x4), Args(x5), Args(x6), Args(x7), Args(x8), Args(x9)"	' Serialised set of 10 arguments
	Const	Args10ItemSize	= 10	' Size of each ", Args(xn)" component in Args10

	Dim	nArgs	' As Integer	' Size of Args array
	Dim	nArgsDiv10	' As Integer	' No of batches of arguments to build
	Dim	nArgsMod10	' As Integer	' Tail end arguments
	Dim	ArgList	' As String	' Arguments as a serialised list

	If	IsEmpty(Args)	Then	' No arguments
		CallFn	= Eval(FunctionName)
	ElseIf	IsArray(Args)	Then	' Multiple arguments
		nArgs	= UBound(Args)
		nArgsDiv10	= nArgs \ 10
 
		' Get tail end arguments
		ArgList	= Replace(Left(Args10, Args10ItemSize * (nArgs Mod 10 + 1)), "(x", "(" & nArgsDiv10)
 
		' Get leading arguments
		nArgsDiv10	= nArgsDiv10 - 1
		While	nArgsDiv10 >= 0
			ArgList	= Replace(Args10, "(x", "(" & nArgsDiv10) & ArgList
			nArgsDiv10	= nArgsDiv10 - 1
		WEnd
 
		CallFn	= Eval(FunctionName & "(" & Mid(ArgList, 3) & ")")
	Else	' Single argument
		CallFn	= Eval(FunctionName & "(Args)")
	End If
End Function	' CallFn
 
Example of functions that can be called using this function:
'	Sample test functions
Function	DivBy2(X)	' One argument
	DivBy2	= X / 2
End Function
 
Function	Sum2(A, B)
	Sum2	= A + B
End Function
 
Function	NoArgs
	MsgBox	Now
End Function
 
Function	Sum13(A, B, C, D, E, F, G, H, I, J, K, L, M)
	Sum13	= A + B + C + D + E + F + G + H + I + J + K + L + M
End Function
 
Function	Sum20(A, B, C, D, E, F, G, H, I, J, K, L, M, O, P, Q, R, S, T, U)
	Sum20	= A + B + C + D + E + F + G + H + I + J + K + L + M + O + P + Q + R + S + T + U
End Function
 
Using the CallFn function with these samples:
'	Use function CallFn with the sample functions
MsgBox	CallFn("DivBy2", 27)	' Displays: 13.5
MsgBox	CallFn("Sum2", Array(1, 2))	' Displays: 3
MsgBox	CallFn("NoArgs", Empty)	' Displays the current time (from function) then displays nothing (no result)
MsgBox	CallFn("Sum13", Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13))	' Displays 91
MsgBox	CallFn("Sum20", _
	Array(	1, 2, 3, 4, 5, 6, 7, 8, 9, 10, _
		11, 12, 13, 14, 15, 16, 17, 18, 19, 20)	_
		)	' Special case: Empty tail when in batches of 10	' Displays 210

GeneralRe: Calling functions by name in VBScript / VBA - alternative method using no DLLs etc PinmemberYiannis Spyridakis8-Jun-11 22:49 
GeneralRe: Calling functions by name in VBScript / VBA - alternative method using no DLLs etc Pinmemberjsc429-Jun-11 1:10 
GeneralRe: Calling functions by name in VBScript / VBA - alternative method using no DLLs etc [modified] PinmemberTheon McKendry13-Jan-12 16:24 
GeneralRe: Calling functions by name in VBScript / VBA - alternative method using no DLLs etc PinmemberYiannis Spyridakis15-Jan-12 1:35 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

| Advertise | Privacy | Terms of Use | Mobile
Web03 | 2.8.141216.1 | Last Updated 7 Mar 2012
Article Copyright 2011 by Yiannis Spyridakis
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid