Showing posts with label ITypeInfo. Show all posts
Showing posts with label ITypeInfo. Show all posts

Wednesday, 7 August 2019

VBA - Python - Type Library Finder - use reflection to find a late bound object's containing library

I love finding rare stuff that works in Excel VBA, this blog is full of it! I love finding new useful type libraries of classes which drive functionality I didn't know was possible for a VBA developer. They turn up infrequently on Stack Overflow and other forum websites. Often the sample code creates an object using late binding and not with the type library. When I discover one of these I instantly want to find the containing type library to see what else is in that library. Such an investigation requires

  1. Looking up the ProgID (the text string passed to CreateObject()) to get a CLSID
  2. Looking up the CLSID to get the LIBID, the type library's guid
  3. Looking up the LIBID to get the type library's full name

So for example an interesting component is created with CreateObject("WIA.ImageFile") that has a clsid of {A2E6DDA0-06EF-4df3-B7BD-5AA224BB06E8}, and type library guid of {94A0E92D-43C0-494E-AC29-FD45948A5221} which has the full name of Microsoft Windows Image Acquisition Library v2.0.

Combing though the registry is a pain so fortunately we can write some Python code and use the reflection interfaces, ITypeInfo and ITypeLib which are usually restricted to C++ developers but which Python developers have access to and in turn we can expose to Excel VBA code.

Below is a Python COM Gateway class, I have supplied many examples on this blog so the procedure should be familiar (to regular readers at least). But to recap you need to run the following script with adminstrator privileges from a command console. Once registered, the class becomes creatable from VBA using CreateObject.

class WhichTypeLibrary(object):
    _reg_clsid_ = "{521B0A5A-4359-4874-AA9E-8F99DB35F4A6}"
    _reg_progid_ = 'PythonInVBA.WhichTypeLibrary'
    _public_methods_ = ['ReportTypeLibrary'] 

    def ReportTypeLibrary(self, o):
        try:
            pt = str(type(o))
            if pt == "<class 'win32com.client.CDispatch'>":
                ti = o._lazydata_[0]
            elif pt == "<class 'PyIDispatch'>" :
                ti = o.GetTypeInfo()
            else:
                return "Error, cannot get ITypeInfo interface."

            typelib = ti.GetContainingTypeLib()[0]

            return (typelib.GetDocumentation(-1)[0] + ":\t\t" +  typelib.GetDocumentation(-1)[1] )

        except Exception as e:
            return  "Error: " + str(e) + "\n"

def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(WhichTypeLibrary)


if __name__ == '__main__':
    RegisterThis()
    print("End of execution")

VBA Client Code

So the calling VBA code is shown below. It shows passing a Workbook object to the library finder which correctly reports it as belonging the Excel type library (that's obvious but it proves the logic is working). A second object is created which is far rarer (certainly I'd not heard of it) and the Python code correctly reports the library prefix, WIA, and the library description, 'Microsoft Windows Image Acquisition Library v2.0', which can then be found in the Tools References dialog box.

Option Explicit

Sub Test()
    On Error GoTo ErrHandler
    Dim oLibFinder As Object
    Set oLibFinder = CreateObject("PythonInVBA.WhichTypeLibrary")
    
    '* a simple example, find the containing type library of a Workbook, should print "Excel:      Microsoft Excel 15.0 Object Library"
    Debug.Print oLibFinder.ReportTypeLibrary(ThisWorkbook)
    
    '* a rarer example, should print "WIA:        Microsoft Windows Image Acquisition Library v2.0"
    Dim obj As Object
    Set obj = CreateObject("WIA.ImageFile")
    
    Debug.Print oLibFinder.ReportTypeLibrary(obj)
    
SingleExit:
    Exit Sub
ErrHandler:
    Debug.Print Err.Description
    Stop
    'Resume
    
End Sub

So the above program prints...

Excel:      Microsoft Excel 15.0 Object Library
WIA:        Microsoft Windows Image Acquisition Library v2.0

Factoid - ProgIDs have limit of 39 characters

What's Next, can the above Python class report on itself? No (or at least not yet).

If you are a little cheeky and wondered what would happen if you pass the library finder class itself to see what it said you would get an error.

Error: (-2147352567, 'Exception occurred.', None, None)

This is because the standard Python COM Gateway class carries no type information by default. It is capable of shipping type information is you associate it with a type library but then the type library needs to agree with the Python source. We can write some code to read a Python class and generate a type library and that will be the subject of the next post.

Thursday, 6 June 2019

Reflecting over a VBA Project and distinguishing between classes and documents modules

Welcome to another blog post in a series on the lesser known COM reflection APIs , ITypeLib and ITypeInfo, which are usually the preserve of C++ programmers but with the thanks of a great Python library, PythonCOM become readily accessible to VBA developers. In this post I am going to examine the anatomy of an Excel workbook VBA project.

You advised to read the prior posts in this series as they gently introduce this large topic with some interesting use cases. Those posts also have videos!

VBA Projects have document modules whereas VB6 projects don't

So VB6 developers have always been able to create a COM server Dll. The entry points for this are classes, but classes implement interfaces and when reading a type library one gets hold of a class's type information but to see the methods on which a class can be called one has to hop to the interface type information and read the methods information from the interface.

VBA developers cannot create a COM server Dll. However, it is surprising that VBA projects ship a whole type library implementation. With such type information client code written in C# can happily interact with VBA classes using COM interop technology.

However, matters are muddied because a VB6 project does not have any document classes like a VBA project does. So, VBA has a ThisWorkbook module which can contain code. Also, each worksheet can contain code in a 'code-behind' style. In this post, I poke around an Excel Workbook's VBA Project to see the distinguishing features. We need to learn how to do this so that we can acknowledge how code can live in the ThisWorkbook module and the worksheet code behind modules.

Our Test Workbook

So to set up the experiment we need to add some code. We need to add 3 class modules, CMyClass, CPolymorphicClass and ISnafu (which will act as an interface). We add code to these class modules. Also we add code to the ThisWorkbook module and to the Sheet1 "code-behind' module. The listings are given below along with a screenshot of the test workbook in the project explorer

No code is given for the UserForm1 but it is here to show that there is no type library information for it! Also I have skipped the code for the modPython module (actually it is given below). Standard modules are also (along with forms) invisible in terms of type library information. Also invisible are classes that have Instancing type "1 - Private", so make sure the instancing is set to "2 - PublicNotCreatable" where instructed.

Sheet1 (code-behind) module

Option Explicit

Function SomeLogic()
    'just a method signature
End Function

ThisWorkbook module

Option Explicit

Public Sub Workbook_Open()
    Application.Goto "ThisWorkbook.Test"
End Sub

Public Sub Test()
    'No code here
End Sub

CMyClass class module

You need to set the instancing to 2 - PublicNotCreatable

Option Explicit

Public Function Foo() As Long
    Foo = 42
End Function

Public Sub SayHi()
    MsgBox "hi"
End Sub

CPolymorphicClass class module

You need to set the instancing to 2 - PublicNotCreatable

Option Explicit

Implements ISnafu

Private Function ISnafu_SituationReport() As String
    ISnafu_SituationReport = "Normal"
End Function

ISnafu class module (will act as an interface)

You need to set the instancing to 2 - PublicNotCreatable

Option Explicit

Public Function SituationReport() As String

End Function

Reporting on the VBA Project's types

So its time to give the first pass of our reporting program which gives top level information for each of the ten type information artefacts in our VBA project. In the list below we give (i) the index (ii) the artefact's name (iii) artefact type (coclass, interface, dispinterface) (iv) the count of functions (v) the count of implemented types (vi) type flags and finally (vii) a GUID.

Just to note, a dispinterface is a dispatch-interface as opposed to a virtual function table or v-table interface; a v-table interface is reported just as "interface" and we'll meet this later. Sometimes, a classes implement a dual interface which has both virtual function table layout as well as the dispatch mechanism, inheriting from IDispatch. All VBA classes implement dual interfaces.

In case you didn't know. In COM, a COM class (or coclass) implements interfaces which are defined separately. In VBA (and VB6 & VB.NET), this separation between coclass and interface is kept hidden, usually the hidden interface has the name of the class but prepended with an underscore. So in the report below, Sheet1 coclass implements the _Sheet1 interface. The naming convention below is slightly broken in that the CMyClass coclass implements an interface of the same name, however you can see that hidden flag is missing so we could code around this. (Later, I'll show how to navigate from a coclass to its interface without the naming convention).

Other points of note are how the document classes, ThisWorkbook and Sheet1, as well as their interfaces, have the predeclid flag but this isn't enough to identify the document classes because we can pull a trick to make a VBA class static and so VBA classes can also have this predeclid flag.

If we look at cFuncs, the count of functions, then the _ThisWorkbook interface has 265, presumable 2 of these are the ones we added, but can we be sure? The CMyClass dispinterface reports 2 functions so this makes sense.


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} {C0360BCF-E003-4C03-BC75-8F360DC36111}

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} {BC5E6E4A-879E-4070-98BC-DCC7D4B374D4}

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} {80868766-E6A2-4624-8DF7-C4580704534D}

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} {037A1A58-A8B4-421C-B8A6-4754CA7E27F0}

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} {A802C7A7-3554-4DDC-8D92-39181054A2EB}

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} {0991D6B1-19C9-48C0-B4FC-90902BB7762B}

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} {0E2D9B97-0524-4A45-B26A-5D5973E9B88A}

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} {61F0CE30-560F-46EB-B484-65DF3B1103B9}

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} {6BACFCE0-67A1-42CE-8C1F-99CC054B2D89}

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} {A8097492-6617-47B8-8101-A487E1682214}

So we are slightly wiser as how to get the methods of a VBA class but no closer to being able to get the user added methods of the documents classes. We need more information.

Adding the referenced/implemented types

The token cImplTypes stands for count of implemented types. This tells us if we can call ITypeInfo::GetRefTypeOfImplType and ITypeInfo::GetRefTypeInfo methods to report references type descriptions. The docs are worth quoting

If a type description describes a COM class, it retrieves the type description of the implemented interface types. For an interface, GetRefTypeOfImplType returns the type information for inherited interfaces, if any exist.

It is interesting that requesting this extra information is a two step process. We call ITypeInfo::GetRefTypeOfImplType first which returns a number and then pass this number to ITypeInfo::GetRefTypeInfo. I've added this number to the report because it will matter later. In the meantime, for coclasses ITypeInfo::GetRefTypeOfImplType returns the index number of the interface. For the dispinterfaces, ITypeInfo::GetRefTypeOfImplType returns -1 and this then retrieves the IDispatch interface. Remember, for coclasses we get the implemented interface, but for interfaces we get the inherited interface.

I've added an extra line to the report to represent calls to ITypeInfo::GetRefTypeOfImplType (result in brackets) and then ITypeInfo::GetRefTypeInfo. These extra lines all start with 0: because for each cImplTypes=1 and it is zero-based. The code could handle multiple types, in theory.

I've also used colouring so now we can see the coclasses tieing up with the interfaces.


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch interface cFuncs:4 cImplTypes:1 {restricted} 

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(0)VBAProject._ThisWorkbook 

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(2)VBAProject._Sheet1 

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(4)VBAProject.CMyClass 

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(6)VBAProject._CPolymorphicClass 

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(8)VBAProject._ISnafu 

So the report looks a little more fleshed out. But we are no further to detecting the methods within the ThisWorkbook and Sheet1 code modules. What else can we do? Well, also as per the Microsoft Docs, in the Remarks sections it says

If the TKIND_DISPATCH type description is for a dual interface, the TKIND_INTERFACE type description can be obtained by calling GetRefTypeOfImplType with an indexof –1, and by passing the returned pRefTypehandle to GetRefTypeInfo to retrieve the type information

All VBA classes have dispinterfaces which are dual, meaning a blend of a vtable and a dispatch based interface, so the above remark applies. So let's add more lines to the report.

So jackpot! We can now detect that the ThisWorkbook modules does indeed have two user added functions (methods) so it must be straightforward to acquire the method info for these. Likewise, we can see the extra reported line for _Sheet1 interface has a cFuncs of 1, so that singleton method also must be easy to query.


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ThisWorkbook interface cFuncs:2 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch interface cFuncs:4 cImplTypes:1 {restricted} 

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(0)VBAProject._ThisWorkbook 

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._Sheet1 interface cFuncs:1 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(2)VBAProject._Sheet1 

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
  -1:(-3)VBAProject.CMyClass interface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(4)VBAProject.CMyClass 

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._CPolymorphicClass interface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(6)VBAProject._CPolymorphicClass 

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ISnafu interface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(8)VBAProject._ISnafu 

One last thing to show you

Okay, but how about the problem of identifying the document classes. First, let me show you some code which uses the Microsoft Visual Basic for Applications Extensibility 5.3 library, this will report which modules are document modules, denoted by 100. Note, that users can change the codename of Sheet1 to, for example, shFoo and ThisWorkbook to, for example, MyApp but they cannot change the VBComponent.Type property. So this is one way (a good way) of detecting document modules.

Sub ListModuleTypes()
    '* Requires tools reference to
    '* Microsoft Visual Basic for Applications Extensibility 5.3
    Dim prj As VBIDE.VBProject
    Set prj = ThisWorkbook.VBProject
    
    Dim vbc As VBIDE.VBComponent
    For Each vbc In prj.VBComponents
        Debug.Print vbc.Name, vbc.Type
    Next vbc

End Sub

Output for the above project

ThisWorkbook       100 
Sheet1             100 
CMyClass           2 
CPolymorphicClass  2 
ISnafu             2 
UserForm1          3 
modPython          1 
modTrash           1 

But I am itching to show you something I discovered quite by accident. When writing code to call the ITypeInfo::GetRefTypeOfImplType and ITypeInfo::GetRefTypeInfo methods I accidentally passed 0 to the second and got back undocumented results. I've have selectively added these to the report, only the dispinterfaces. I believe they return a dispinterface's internal base class (if that makes any terminology sense!)

So for our VBA classes' dispinterface, passing zero returns "VBInternal.DClass". For the ThisWorkbook module's dispinterface, passing zero returns Excel._Workbook (along with its cannonical GUID). Equally, for the Sheet1 module's dispinterface, passing zero returns "Excel._Worksheet". So these are hard coded strings that cannot be renamed like the modules' codenames. Very useful and something we can code against without resorting the the Visual Basic for Applications Extensibility interface above.

I've marked the extra lines with the ^ symbol ...


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ThisWorkbook interface cFuncs:2 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch interface cFuncs:4 cImplTypes:1 {restricted} 
   ^:Excel._Workbook interface cFuncs:263 cImplTypes:1 {dual oleautomation dispatchable} {000208DA-0000-0000-C000-000000000046}

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(0)VBAProject._ThisWorkbook 

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._Sheet1 interface cFuncs:1 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch
   ^:Excel._Worksheet interface cFuncs:145 cImplTypes:1 {dual nonextensible oleautomation dispatchable} {000208D8-0000-0000-C000-000000000046} 

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(2)VBAProject._Sheet1 
   ^:Excel._Worksheet interface cFuncs:145 cImplTypes:1 {dual nonextensible oleautomation dispatchable} {000208D8-0000-0000-C000-000000000046}

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
  -1:(-3)VBAProject.CMyClass interface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 
   ^:VBInternal._DClass dispinterface cFuncs:0 cImplTypes:1 {hidden nonextensible dispatchable} {FCFB3D2B-A0FA-1068-A738-08002B3371B5}

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(4)VBAProject.CMyClass 

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._CPolymorphicClass interface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 
   ^:VBInternal._DClass dispinterface cFuncs:0 cImplTypes:1 {hidden nonextensible dispatchable} {FCFB3D2B-A0FA-1068-A738-08002B3371B5}

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(6)VBAProject._CPolymorphicClass 

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ISnafu interface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 
   ^:VBInternal._DClass dispinterface cFuncs:0 cImplTypes:1 {hidden nonextensible dispatchable} {FCFB3D2B-A0FA-1068-A738-08002B3371B5}

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(8)VBAProject._ISnafu 

We can also see that the function count now cross-tallies. So the Excel._Workbook base interface has 263 methods, we added 2 user methods to give a total of 265 which is the number accessible via the VBAProject._ThisWorkbook dispinterface. This very satisfactorily ties the numbers up.

One problem I have spotted is how the type information for the CPolymorphicClass does not indicate that it implements the ISnafu interface. This is disappointing as it looks like an incomplete implementation.

Source Code

So the reporting program is written in Python but we call it from Excel VBA using the Python COM gateway class pattern, so there are two listings, the Python code and a small amount of Excel VBA to call into the Python.

Python code

To make the COM registries this must be run either (i) once from the command line with administrator rights or (ii) from Visual Studio which if required will ask for an elevation to admin rights. I tend to use the latter method.

import pythoncom

class ComRegistryEx(object):
    _reg_clsid_ = "{FD538AF6-6B9C-4E53-8013-93D7466DF23D}"
    _reg_progid_ = 'PythonComTypes.ComRegistryEx'
    _public_methods_ = ['InterfaceNameFromIID']

    def InterfaceNameFromIID2(self, iid):
        siid = str(iid)
        try:
            thisProc = self._reg_progid_ + "." + inspect.stack()[0][3]
            # optimize for well-known
            if str(siid) == "{00020400-0000-0000-C000-000000000046}":
                return "IDispatch", True
            else:
                iidKey = winreg.OpenKey(winreg.HKEY_CLASSES_ROOT,"Interface\\" + siid)
                iidKeyDefault = winreg.QueryValueEx(iidKey,"")
                baseName = iidKeyDefault[0]
                winreg.CloseKey(iidKey)
                return baseName, True
        except Exception as ex:
            return None,False


class SharedLog(object):

    def __init__(self):
        self.LogContents = ""

    def Log(self,s):
        self.LogContents += s

    def ClearLog(self):
        self.LogContents = ""

    def GetLogContents(self):
        return self.LogContents


class PythonVBATypeLibraryAnatomy(object):
    _reg_clsid_ = "{6653C3BA-0484-465C-BE48-DF9BEE1BDE11}"
    _reg_progid_ = 'PythonInVBA.PythonVBATypeLibraryAnatomy'
    _public_methods_ = ['ClearLog','ReportAnatomy','GetLogContents'] 
    #_public_attrs_ = ['Log']
    #_readonly_attrs_ = ['Log']

    def __init__(self):
        self.sharedLog = SharedLog()

    def Log(self,s):
        self.sharedLog.Log(s)

    def ClearLog(self):
        self.sharedLog.ClearLog()
        
    def GetLogContents(self):
        return self.sharedLog.GetLogContents()


    def GetTypeLibrary(self, o):
        try:
            pt = str(type(o))
            if pt == "<class 'win32com.client.CDispatch'>":
                ti = o._lazydata_[0]
            elif pt == "<class 'PyIDispatch'>" :
                ti = o.GetTypeInfo()
            else:
                self.Log ( "called with type " + pt + " no attempt to acquire typeinfo\n" )
                return None

            self.Log ( "Acquired typeinfo:" + ti.GetDocumentation(-1)[0] + "\n" )
            typelib = ti.GetContainingTypeLib()[0]
            self.Log ( "Acquired containing typelib:" + typelib.GetDocumentation(-1)[0] + "\n" )

            return typelib

        except Exception as e:
            self.Log ("Error: " + str(e) + "\n")

    def ReportAnatomy(self, o):
        try:
            typelib = self.GetTypeLibrary(o)
            report = ""
            for index in range(0, typelib.GetTypeInfoCount()):
                
                ti = typelib.GetTypeInfo(index)
                typeAndTa = TypInfoAndTypeAttribute(ti,typelib, index, self.sharedLog)
                if typeAndTa.ta.typekind >= 3 and typeAndTa.ta.typekind <= 5:
                    
                    subreport = typeAndTa.Report("  ")
                    self.Log ( "acquired subreport for " + str(index) + "\n")
                    if subreport is not None:
                        report+=subreport+ " \n\n"

                    else:
                        self.Log ( "subreport is None:\n")

            return report

        except Exception as e:
            self.Log ( "[PythonVBATypeLibraryAnatomy.ReportAnatomy]Error: " + str(e) + "\n" )

class TypInfoAndTypeAttribute(object):

    def ClearLog(self):
        self.sharedLog.ClearLog()

    def Log(self,s):
        self.sharedLog.Log(s)


    def __init__(self,  ti,typelib, index, log):
        
        try:
            self.sharedLog = log 
            self.ti = ti
            self.identifier = ti.GetDocumentation(-1)[0]
            self.ta = ti.GetTypeAttr()
            self.typelib = typelib
            self.index = index
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.__init__]Error: " + str(e) + "\n" )

    def ReportTypeFlags(self):
        try:
            report=""
            if ((self.ta.wTypeFlags & 1) == 1) : report +=" appobject"   #TYPEFLAG_FAPPOBJECT
            if ((self.ta.wTypeFlags & 2) == 2) : report +=" cancreate"   #TYPEFLAG_FCANCREATE
            if ((self.ta.wTypeFlags & 4) == 4) : report +=" licensed"    #TYPEFLAG_FLICENSED
            if ((self.ta.wTypeFlags & 8) == 8) : report +=" predeclid"   #TYPEFLAG_FPREDECLID
            if ((self.ta.wTypeFlags & 16) == 16) : report +=" hidden"    #TYPEFLAG_FHIDDEN
            if ((self.ta.wTypeFlags & 32) == 32) : report +=" control"   #TYPEFLAG_FCONTROL
            if ((self.ta.wTypeFlags & 64) == 64) : report +=" dual"      #TYPEFLAG_FDUAL
            if ((self.ta.wTypeFlags & 128) == 128) : report +=" nonextensible" #TYPEFLAG_FNONEXTENSIBLE
            if ((self.ta.wTypeFlags & 256) == 256) | ((self.ta.wTypeFlags & 64) == 64) : report +=" oleautomation" #TYPEFLAG_FOLEAUTOMATION,TYPEFLAG_FDUAL
            if ((self.ta.wTypeFlags & 512) == 512) : report +=" restricted"       #TYPEFLAG_FRESTRICTED
            if ((self.ta.wTypeFlags & 1024) == 1024) : report +=" aggregatable"   #TYPEFLAG_FAGGREGATABLE
            if ((self.ta.wTypeFlags & 2048) == 2048) : report +=" replaceable"     #TYPEFLAG_FREPLACEABLE
            if ((self.ta.wTypeFlags & 4096) == 4096) : report +=" dispatchable"    #TYPEFLAG_FDISPATCHABLE = 0x1000,
            if ((self.ta.wTypeFlags & 8192) == 8192) : report +=" reversebind"    #TYPEFLAG_FREVERSEBIND = 0x2000,
            if ((self.ta.wTypeFlags & 16384) == 16384) : report +=" proxy"        #TYPEFLAG_FPROXY
            return "{" + report.strip() + "}"
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportTypeFlags]Error: " + str(e) + "\n" )


    def ReportHref0(self, indent):
        try:
            report = "\n" + indent +  " ^:"
            try:
                tiRefType = self.ti.GetRefTypeInfo(0)
            except Exception as e:
                return "" 
            typelib= tiRefType.GetContainingTypeLib()[0]
            refTypInfo = TypInfoAndTypeAttribute(tiRefType,typelib,-1, self.sharedLog)
            subreport = refTypInfo.Report(indent + "  ", False) 
            if subreport is not None and not subreport=="":
                return report + subreport
            else:
                return ""
            

        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportHref0]Error: " + str(e) + "\n" )

    def ReportImplTypes(self, indent, recurse):
        try:
            report=""
            if recurse:

                start = -1 if self.ta.typekind==4 else 0
                children = self.ta.cImplTypes - start 
                if (children>0):
                    
                    for index in range(start, self.ta.cImplTypes):
                        strIndex = (" " + str(index))[-2:]
                        hRefType = None
                        try:
                            hRefType = self.ti.GetRefTypeOfImplType(index)
                            
                            tiRefType = self.ti.GetRefTypeInfo(hRefType)
                            typelib= tiRefType.GetContainingTypeLib()[0]
                            refTypInfo = TypInfoAndTypeAttribute(tiRefType,typelib,-1, self.sharedLog)
                            subreport = refTypInfo.Report(indent + "  ") 
                            if subreport is not None and not subreport == "":
                                report+= "\n" + indent + strIndex + ":(" + str(hRefType) + ")" + subreport
                            else:
                                report=""
                            

                        except Exception as e:
                            if (e.strerror=="Element not found."):
                                report+= "\n" + indent +"{no more}"
                            else:
                                self.Log ( "[TypInfoAndTypeAttribute.ReportImplTypes]Unexpected error: " + str(e) + "\n" )
                                
                        
            else:
                report= "" 
            return report
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportImplTypes]Error: " + str(e) + "\n" )


    def ReportFullIdentifier(self):
        try:
            libname = self.typelib.GetDocumentation(-1)[0]
            return libname + "." + self.ti.GetDocumentation(-1)[0]

        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportFullIdentifier]Error: " + str(e) + "\n" )
       

    def ReportIid(self):
        try:
            cex = ComRegistryEx()
            interfaceName2, ok = cex.InterfaceNameFromIID2(self.ta.iid)
            if ok:
                return str(self.ta.iid) + " (" + interfaceName2 + ")"
            else:
                return str(self.ta.iid)  #+ " (not well known)"
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportIid]Error: " + str(e) + "\n" )
        


    def Report(self,indent, recurse = True):
        try:
            siid = str(self.ta.iid)
            if siid == "{00000000-0000-0000-0000-000000000000}" or siid == "{00000000-0000-0000-C000-000000000046}" : #or siid=="{00020400-0000-0000-C000-000000000046}":
                return ""
            strindex = "" if self.index==-1 else str(self.index) + ". "
            strTaTypekind = "coclass" if self.ta.typekind == 5 else "dispinterface" if self.ta.typekind == 4 else "interface"
            report = strindex + (self.ReportFullIdentifier() + " " + strTaTypekind  + " cFuncs:" + str(self.ta.cFuncs)  
                + " cImplTypes:" + str(self.ta.cImplTypes) + " " + self.ReportTypeFlags() + " "  )
            report = report + self.ReportIid()
            if recurse:
                report = report + self.ReportImplTypes(indent, recurse)
                href0 = self.ReportHref0(indent)
                if href0 is not None:
                    report = report + href0
                else:
                    pass
            return report
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.Report]Error: " + str(e) + "\n" )


def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(PythonVBATypeLibraryAnatomy)


if __name__ == '__main__':
    RegisterThis()
    print("End of execution")



VBA client code

Sub Test()
    Dim oMyClass As CMyClass
    Set oMyClass = New CMyClass

    Dim objAnatomy As Object
    Set objAnatomy = CreateObject("PythonInVBA.PythonVBATypeLibraryAnatomy")
    
    Dim sReport
    sReport = objAnatomy.ReportAnatomy(oMyClass)
    If Not IsNull(sReport) Then
        Debug.Print sReport
    Else
        Debug.Print objAnatomy.GetLogContents
    End If
    
    Stop
End Sub


Tuesday, 21 May 2019

VBA - Reflection - use Python to write your enumeration helper functions

This is second blog post demonstrating how we can use Python code to leverage a C++ reflection API with respect to a VBA project and thus confer the capabilities of reflection to a VBA programmer where no native VBA functionality exists. In other words, reflection is not normally available to a VBA developer but with some clever code we can fix that. The use case this time is converting enumerations to strings (and back).

Click here for separate Youtube window

So in the previous post I highlighted how there is no in built VBA language feature to give the string equivalent of an enumeration value; and that one had to write a helper function. But, the helper function has to be kept synchronised which can be a little painful. Luckily, we can use some more Python reflection code to help with this.

You are strongly advised to first read the prior article on Python reflection where a simpler version of the diagram below is introduced. In this post, we continue to flesh out our diagram with more hyperlinks for methods and structures we're going to use. New on this diagram is the ITypeLib interface (rightmost box). One can acquire a reference to a class's containing type library (VBA project) via the class's ITypeInfo interface by calling ITypeInfo::GetContainingTypeLib.

Being able to acquire the containing type library (VBA project) is an important advance. In the prior reflection blog post we got run-time type information (RTTI) for a single VBA class instance. But now we have the capability to interrogate the whole type library (VBA project). In this post I will give code which will find all the enumerations and write some helper functions to convert enumeration values to and from strings. I'm sure, I will blog other use cases that will make use of 'type-library-wide' information.

Another addition to the diagram below is the link to the VARDESC structure. The documentation for that structure is unwelcoming (to a VBA programmer at least), don't worry that documentation is typically for C++ programmers. We will be using a Python layer called pythoncom authored by Tim Golden. The Python layer is beautiful to work with. Thanks Tim!

AddRef IUnknown QueryInterface Release GetTypeInfoCount IDispatch GetTypeInfo GetIDsOfNames Invoke User-defined Foo Bar Baz AddressOfMember CreateInstance GetContainingTypeLib GetDllEntry GetDocumentation GetFuncDesc => ITypeInfo GetIDsOfNames GetImplTypeFlags GetMops GetNames GetRefTypeInfo GetRefTypeOfImplType GetTypeAttr GetTypeComp GetVarDesc Invoke ReleaseFuncDesc ReleaseTypeAttr ReleaseVarDesc FindName GetDocumentation => ITypeLib GetLibAttr GetTypeComp GetTypeInfo => FUNCDESC GetTypeInfoCount GetTypeInfoOfGuid GetTypeInfoType IsName ReleaseTLibAttr => TYPEATTR => VARDESC

Python Reflection code to query a Type Library (VBA Project) for all enumerations

So we are in a position to give the strategy for listing all the enumerations in a type library (VBA Project) given a VBA class instance from that type library.

  1. Get the IDispatch interface pointer for given VBA class
  2. Get the class's ITypeInfo interface pointer by calling IDispatch::GetTypeInfo
  3. Get the type library's (VBA Project's) ITypeLib interface pointer by calling ITypeInfo::GetContainingTypeLib
  4. Get the total count of types of the type library (VBA Project) by calling ITypeLib::GetTypeInfoCount to set up a For loop
  5. Use a For loop to iterate over all the types in the type library (VBA Project)
  6. On each iteration call ITypeLib::GetTypeInfo to get the ITypeInfo interface pointer for each type
  7. Test the type's Typekind to see if it an enumeration
  8. For each enumeration run our code to generate some VBA enumeration helpers function

PythonVBAEnumHelper.py, houses the Python COM Gateway class

So this is the Python code. It needs to be run at least once from a command line with administrator rights so that the registry can be updated. Once registered then simple use VBA.CreateObject("PythonInVBA.PythonVBAEnumHelper") to instantiate this Python class and then call the WriteMyEnumHelpers method.

import pythoncom

class PythonVBAEnumHelper(object):
    _reg_clsid_ = "{232D07E5-4BCE-4FB9-93DC-2F6B58B809F7}"
    _reg_progid_ = 'PythonInVBA.PythonVBAEnumHelper'
    _public_methods_ = ['ClearLog','ReadEnums','ReadEnum','WriteMyEnumHelpers','WriteMyEnumHelper'] 
    _public_attrs_ = ['Log']
    _readonly_attrs_ = ['Log']

    def __init__(self):
        self.Log = ""

    def ClearLog(self):
        self.Log = ""

    def GetTypeLibrary(self, o):
        try:
            pt = str(type(o))
            if pt == "<class 'win32com.client.CDispatch'>":
                ti = o._lazydata_[0]
            elif pt == "<class 'PyIDispatch'>" :
                ti = o.GetTypeInfo()
            else:
                self.Log += "called with type " + pt + " no attempt to acquire typeinfo\n"
                return None

            self.Log += "Acquired typeinfo:" + ti.GetDocumentation(-1)[0] + "\n"
            typelib = ti.GetContainingTypeLib()[0]
            self.Log += "Acquired containing typelib:" + typelib.GetDocumentation(-1)[0] + "\n"

            return typelib

        except Exception as e:
            self.Log += "Error: " + str(e) + "\n"


    def WriteMyEnumHelpers(self,o):
        try:
            helpers = []
            enums = self.ReadEnums(o,True)
            if not (enums is None):
                for enum in enums:
                    helper = self.WriteMyEnumHelper(enum)

                    if not (helper is None):
                        helpers.append(helper)

                return list(helpers)

        except Exception as e:
            self.Log += "Error: " + str(e) + "\n"

    def WriteMyEnumHelper(self,enum):
        try:
            if not (enum is None):

                vbaStringToEnumFuncName = enum[0] + "StringToEnum"
                vbaStringToEnumFuncSrc = "Public Function " + vbaStringToEnumFuncName + "(s As String) As " + enum[0] + "\n\t" + vbaStringToEnumFuncName + " = "

                vbaEnumToStringFuncName = enum[0] + "EnumToString"
                vbaEnumToStringFuncSrc = "Public Function " + vbaEnumToStringFuncName + "(e As " + enum[0] + ") As String\n\t" + vbaEnumToStringFuncName + " = "
                
                stringToEnumSwitch = ""
                enumToStringSwitch = ""

                srcArray = ""
                for enumMem in enum[2]:
                    if (stringToEnumSwitch != ""):
                        stringToEnumSwitch+=", "
                        enumToStringSwitch+=", "

                    stringToEnumSwitch+= "s = \"" + enumMem[0] + "\", " + str(enumMem[1])
                    enumToStringSwitch+= "e = " + str(enumMem[1]) + ", \"" + enumMem[0] + "\""

                vbaEnumToStringFuncSrc+=" Switch(" + enumToStringSwitch + ")\nEnd Function\n"
                vbaStringToEnumFuncSrc+=" Switch(" + stringToEnumSwitch + ")\nEnd Function\n"

                return (vbaEnumToStringFuncSrc + vbaStringToEnumFuncSrc)
            else:
                return "Something went wrong"
        except Exception as e:
            self.Log += "Error: " + str(e) + "\n"



    def ReadEnums(self, o, readMembers):
        try:
            typelib = self.GetTypeLibrary(o)
            if not (typelib is None):

                enums = [[]]

                for index in range(0, typelib.GetTypeInfoCount()):
                    ti = typelib.GetTypeInfo(index)
                    ta = ti.GetTypeAttr()
                    tk = ta.typekind
                    if tk == 0:  # 0=ENUMERATION
                        self.Log += "Found enum:" + ti.GetDocumentation(-1)[0] + "\n"
                        members = None
                        if (readMembers):
                            members = self.ReadEnum(o,index)
                        tup = (ti.GetDocumentation(-1)[0],index, members)
                        enums.append(tup)

                return enums

        except Exception as e:
            self.Log += "Error: " + str(e) + "\n"

    def ReadEnum(self, o, index):
        try:
            typelib = self.GetTypeLibrary(o)
            
            if not (typelib is None):
                ti = typelib.GetTypeInfo(index)
                ta = ti.GetTypeAttr()
                count = ta.cVars
                enumMems = []
                self.Log += "Enum count:" + str(count) + "n"
                for memberIndex in range(0, count):
                    varDesc = ti.GetVarDesc(memberIndex)
                    enumMems.append((ti.GetDocumentation(varDesc.memid)[0],varDesc.value))

                return list(enumMems)

        except Exception as e:
            self.Log += "Error: " + str(e) + "\n"


def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(PythonVBAEnumHelper)


if __name__ == '__main__':
    RegisterThis()
    print("End of execution")

VBA classes

I have contrived to split the enums over two classes. This is to demonstrate that the Python code can interrogate all Instancing '2 - PublicNotCreatable' classes in a type library (VBA Project) given just a single class instances. So forgive me if this looks a little odd. Also, do please note that enums defined is either a (i) standard module or (ii) a class with Instancing '1 - Private' will not be found. So you'll need two separate classes, Enums and MoreEnums both with Instancing '2 - PublicNotCreatable'.

The Enums VBA class

Option Explicit
'* Instancing must be set to '2 - PublicNotCreatable'

Public Enum Cars
    BMW
    Ford
    Lotus
    'Ferrari
End Enum

The MoreEnums VBA class

Option Explicit
'* Instancing must be set to '2 - PublicNotCreatable'

Public Enum MyColor
    Red = 1
    Green
    Blue
    'Yellow
    'Purple
End Enum

The VBA Client code

So the Python code does the clever stuff with reflection but we still need some VBA client code to call into the Python COM server.

Option Explicit

Private Function WriteEnumsHelpers(ByVal oAnyPublic2VBAClass As Object)
    
    Static oHelper As Object
    If oHelper Is Nothing Then Set oHelper = VBA.CreateObject("PythonInVBA.PythonVBAEnumHelper")
    oHelper.ClearLog
    If oAnyPublic2VBAClass Is Nothing Then Err.Raise vbObjectError, "", "#Null oAnyPublic2VBAClass!"

    On Error GoTo PythonComInteropErrorHandler
    WriteEnumsHelpers = oHelper.WriteMyEnumHelpers(oAnyPublic2VBAClass)
    'Debug.Print oHelper.Log
    
    Exit Function
PythonComInteropErrorHandler:
    If Err.Number = 98 Then
        Err.Raise vbObject, "", "#oVBAClass of type '" & TypeName(oAnyPublic2VBAClass) & "' must have Instancing '2 - PublicNotCreatable'!"
    Else
        Debug.Print Err.Description, Hex$(Err.Number), Err.Source
        Debug.Print "Log:" & oHelper.Log
    End If

End Function

Private Sub TestWriteEnumsHelpers()

    Dim oAnyPublic2VBAClass As Object
    Set oAnyPublic2VBAClass = New Enums

    Debug.Print VBA.Join(WriteEnumsHelpers(oAnyPublic2VBAClass), vbNewLine)
    
End Sub

Sample output

So the Python code actually generates VBA code for copying and pasting into the VBA project to help with your enumeration to string (and back again) logic.

Public Function CarsEnumToString(e As Cars) As String
    CarsEnumToString =  Switch(e = 0, "BMW", e = 1, "Ford", e = 2, "Lotus")
End Function
Public Function CarsStringToEnum(s As String) As Cars
    CarsStringToEnum =  Switch(s = "BMW", 0, s = "Ford", 1, s = "Lotus", 2)
End Function

Public Function MyColorEnumToString(e As MyColor) As String
    MyColorEnumToString =  Switch(e = 1, "Red", e = 2, "Green", e = 3, "Blue")
End Function
Public Function MyColorStringToEnum(s As String) As MyColor
    MyColorStringToEnum =  Switch(s = "Red", 1, s = "Green", 2, s = "Blue", 3)
End Function

Monday, 13 May 2019

VBA - Reflection, with help from Python

In a previous post this month, I wrote that VBA does not have reflection that allows some fancy dependency injection mechanism. This is strictly true of VBA itself but VBA is a COM artefact and reflection interfaces are available as part of the venerable COM specification. Luckily, with the help of some Python we can call some of these reflection interfaces on a VBA class.

Click here for separate Youtube window

WARNING - No warranty

WARNING: what follows is a little known technique which I have not run in a production environment; so use at your risk. No warranty is given for any code in this blog post, nor for any blog post. But do let us know how you get on if you chose to use it by commenting below.

The high-level use-case

In this post I'll show enough Python reflection code to drive a better dependency injection mechanism. The high level logic is easy enough to express: all I need is to check a VBA class instance for a certain method named "InjectDependencies" and if found return a list of argument names which will determine what to inject. Seems simple enough but it requires delving into COM reflection interfaces which are typically unknown to a VBA developer.

Strategy - acquiring ITypeInfo from an IDispatch method and calling ITypeInfo methods

In the diagram below the left hand box shows the virtual function table of a VBA class, the class only has three user defined methods, Foo, Bar and Baz but as it is a COM class it also has an implementation of IUnknown. Also because VBA classes can be late bound we know they support IDispatch, the methods of which come after the methods of IUnknown. Then come the user-defined methods, so Foo is in fact the 8th method in this virtual function table.

I want to attract your attention to the IDispatch methods. Maybe you're already familiar with the IDispatch methods GetIDsOfNames and Invoke; these implement late binding. Less well known, I would argue, are the other two IDispatch methods GetTypeInfoCount and GetTypeInfo but I believe these methods deserve high praise and more attention as they return run time type information (RTTI). In fact, I believe these methods are what allow rich reports on a late bound object's properties in the Locals or Watch windows.

In fact, GetTypeInfoCount is just a guard which returns 0 or 1. The real method is GetTypeInfo which returns a pointer to ITypeInfo. Our code will acquire a pointer to ITypeInfo by calling IDispatch::GetTypeInfo.

The Dual Interface and the need to hop from one ITypeInfo to another

If you have worked with the C# reflection classes you will probably smirk at the ITypeInfo interfaces particularly in this next case. A COM class can have dual interface meaning it can be accessed either via IDispatch or through its virtual function table (vtable) interface. Thus, dual interfaces require two separate ITypeInfo interface instances. IDispatch::GetTypeInfo returns a Dispatch ITypeInfo interface instance but we hop to ITypeInfo for the vtable interface instance with a call to GetRefTypeOfImplType and then GetRefTypeInfo. Please don't ask me to defend this API design.

Getting the TypeAttr structure

There is plenty of information on the TypeAttr structure which is acquired by calling ITypeInfo::GetTypeAttr. The Python library will handle releasing the structure's memory. On the TypeAttr structure, we are interested in cFuncs which is the count of functions (aka methods).

Looping through function descriptions and then acquiring parameter names

Knowing the count of functions/methods we can loop through and for each method acquire the function description, FUNCDESC, structure. (Again, the Python layer will release the structure for us.) We call GetDocumentation to examine the method name (first element on the returned tuple). If we find "InjectDependencies" then we take note of the index number; later we call GetNames to return the list of arguments.

AddRef IUnknown QueryInterface Release GetTypeInfoCount IDispatch GetTypeInfo GetIDsOfNames Invoke User-defined Foo Bar Baz AddressOfMember CreateInstance GetContainingTypeLib GetDllEntry GetDocumentation GetFuncDesc => ITypeInfo GetIDsOfNames GetImplTypeFlags GetMops GetNames GetRefTypeInfo GetRefTypeOfImplType GetTypeAttr GetTypeComp GetVarDesc Invoke ReleaseFuncDesc ReleaseTypeAttr ReleaseVarDesc => FUNCDESC => TYPEATTR

The Python Com Server

So what follows is a Python COM Server aka gateway class, I have placed many examples of these on this blog. But for those new to this, this will implement a COM server that is create-able from VBA using CreateObject(). In the class below the code maintains a log because it can be quite difficult to communicate what is going on without a log.

The strategy outlined above is implemented in ReadParams() which takes a single parameter (the self keyword is what holds the state of a a Python class instance), o which should be a VBA class instance. Please pass a real VBA class and not a document class such as ThisWorkbook or Sheet1. Also for the VBA class the Instancing needs to be '2 - PublicNotCreatable' for reasons I have yet to confirm.

The opening lines of ReadParams() are defensive type checking. The key call is GetTypeInfo() which returns a pointer to ITypeInfo. If you know the strategy, the rest of the code should be easy to follow.

If you have written .NET reflection code in C# then you are lucky, it is very intuitive and easy to understand. The COM reflection interfaces are very far from intuitive, IMHO; especially if you are writing in C++. The COM reflection API can be quite painful. So be thankful that some Python contributors (Tim Golden et al.) have added a layer to insulate you from the C++ complexities. For more information here is the Python documentation.

Upon re-reading my code, I think a few lines could be taken out to make it tighter, perhaps quit the loop early if a method match is found.

Finally, on a COM interop note, Python tuples need to be converted to lists for passing back to the calling VBA, where they are marshalled to a Variant array.

import pythoncom

class PythonDependencyInjectionHelper(object):
    _reg_clsid_ = "{2AFE4143-AC58-4D1F-A172-9D20C917D13A}"
    _reg_progid_ = 'PythonInVBA.PythonDependencyInjectionHelper'
    _public_methods_ = ['ReadParams','ClearLog'] 
    _public_attrs_ = ['Log']
    _readonly_attrs_ = ['Log']

    def __init__(self):
        self.Log = ""

    def ClearLog(self):
        self.Log = ""

    def ReadParams(self, o):
        try:
            pt = str(type(o))
            if pt == "<class 'win32com.client.CDispatch'>":
                ti = o._lazydata_[0]
            elif pt == "<class 'PyIDispatch'>" :
                ti = o.GetTypeInfo()
            else:
                self.Log += "called with type " + pt + " no attempt to acquire typeinfo\n"
                return None

            self.Log += "Acquired typeinfo:" + ti.GetDocumentation(-1)[0] + "\n"

            ta = ti.GetTypeAttr()
            tk = ta.typekind
            if tk == 4:

                try:
                    tivt = ti.GetRefTypeInfo(ti.GetRefTypeOfImplType(-1))
                    tavt = tivt.GetTypeAttr()
                    
                except Exception as ex:
                    raise Exception("Error whilst acquiring vtable interface " + str(ex))
                try:
                    idx = -1
                    for funcIdx in range(0, tavt.cFuncs):
                        fd = tivt.GetFuncDesc(funcIdx)
                        if (ti.GetDocumentation(fd.memid)[0] == "InjectDependencies"):
                            idx = funcIdx
                except Exception as ex:
                       raise Exception("Error whilst looping through functions " + str(ex))
                
                if (idx != -1):
                    fd = tivt.GetFuncDesc(idx)
                    return list(tivt.GetNames(fd.memid)[1:])

        except Exception as e:
            self.Log += "Error: " + str(e) + "\n"


def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(PythonDependencyInjectionHelper)


if __name__ == '__main__':
    RegisterThis()
    print("End of execution")

The TaxCalculator business logic class

Lets give some client VBA code, enough to drive the demo so I have a business logic class called TaxCalculator which has a method called InjectDependencies() which has two arguments oLogger and oIdentity. It has some simple business logic but that's not the real focus, the real focus is the injection of dependencies.

Option Explicit

Private mobjLogger As Object
Private mobjIdentity As Object

Public Sub InjectDependencies(oLogger, oIdentity)
    Set mobjLogger = oLogger
    Set mobjIdentity = oIdentity
End Sub

Public Function CalculateTax(ByVal lAmount As Long) As Long
    If mobjIdentity.HasPermission("Taxcalc") Then
        CalculateTax = lAmount * 0.2
        mobjLogger.Log "Authorised, Calculated tax at 20%"
    Else
        mobjLogger.Log "Not authorised to run this"
    End If
End Function

The Calling VBA Code

Private Function ReadDependencies(ByVal oVBAClass As Object) As Variant

    ReadDependencies = CreateObject("Scripting.Dictionary").Keys  '# sets a default return value for error cases
    Static oHelper As Object
    If oHelper Is Nothing Then Set oHelper = VBA.CreateObject("PythonInVBA.PythonDependencyInjectionHelper")
    oHelper.ClearLog
    If oVBAClass Is Nothing Then Err.Raise vbObjectError, "", "#Null oVBAClass!"

    On Error GoTo PythonComInteropErrorHandler
    Dim vDependencies
    vDependencies = oHelper.ReadParams(oVBAClass)
    If Not IsNull(vDependencies) Then ReadDependencies = vDependencies
    
    
    Exit Function
PythonComInteropErrorHandler:
    If Err.Number = 98 Then
        Err.Raise vbObject, "", "#oVBAClass of type '" & TypeName(oVBAClass) & "' must have Instancing '2 - PublicNotCreatable'!"
    Else
        Debug.Print Err.Description, Hex$(Err.Number), Err.Source
        Debug.Print "Log:" & oHelper.Log
    End If

End Function

Private Sub TestReadDependencies()

    Dim objVBAClass As Object
    Set objVBAClass = New TaxCalculator

    Dim vDependencies
    vDependencies = ReadDependencies(objVBAClass)

    Debug.Print Join(vDependencies, vbNewLine)
End Sub