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


No comments:

Post a Comment