Showing posts with label OLEVIEW. Show all posts
Showing posts with label OLEVIEW. Show all posts

Thursday, 27 September 2018

VBA - .NET Interop - use .NET Reflection in VBA

In absence of missing Intellisense use .NET Reflection in VBA to list methods of .NET classes exposed as COM classes

In the previous post, I showed code that can scan the registry for .NET classes exposed as COM classes that are creatable and reflectable, the latter is required because the Intellisense is not working for these objects (a mystery I will solve later, I promise). In this post I give code that can (partially) call .NET Reflection logic.

Missing (VBA) Intellisense for System.Collection.* classes

In the last post I discovered 5 collection .NET classes I want to experiment with, all of them in the System.Collections.* namespace. They are Queue, Stack, SortedList, ArrayList & HashTable . The lack of Intellisense can be really hampering, I know there is online documentation (the preceding list is hyperlinked to the docs) but I'd like to get a grip with what I have to hand. Luckily, even from VBA, we can (partially) call the .Net reflection logic.

But .NET objects have a GetType() method

The secret is the .Net's Type class which we can get for a .NET exposed COM class instance by calling GetType. The Type class can report on its methods by calling Type.GetMethods(). Each method can reports its number of parameters, though the parameter type is oddly not available (an oversight or perhaps I have yet to understand how it works). Each method can report the type of the return value (which makes the missing parameter type info even more odd).

That the parameter type information is missing is why I call this partially calling reflection.

The problem of Overloads

Putting missing parameter information to one side, the count of parameters is useful in itself because there is an issue with calling overloads from VBA. .Net happily accepts overloads, that is to say, methods with the same number of parameters and the same method name but which differ by the type of the parameters. Overloads are not allowed in COM interfaces and this is one reason why the Intellisense is missing (there is yet another reason about which I will post later, I promise).

So how can VBA, a COM client, call various .Net overloads? The answer is that by convention where an overload occurs one appends a suffix to differentiate. So compare foo(Int32 x) with foo_2(Double x).

All this means we can write code to give a picture of what methods a .Net class will accept. The source code is given below, in advance I give the output of the (partial) reflection on the Queue class which is better than the IDL from OLEView (see Appendix A at the bottom).

'                   Int32 get_Count()
'                 Boolean get_IsSynchronized()
'                  Object get_SyncRoot()
'                  Object Clone()
'                    Void Clear()
'                    Void CopyTo(?,?)
'                    Void Enqueue(?)
'             IEnumerator GetEnumerator()
'                  Object Dequeue()
'                  Object Peek()
'                   Queue Synchronized(?)
'                 Boolean Contains(?)
'                Object[] ToArray()
'                    Void TrimToSize()
'                  String ToString()
'                 Boolean Equals(?)
'                   Int32 GetHashCode()
'                    Type GetType()

The source code listing

The following uses a Scripting.Dictionary and so requires a Tools->Reference to Microsoft Scripting Runtime.

The source has comments to document what is going on so I'll not replicate them here. Instead, to give a brief overview I needed one SortedList to keep track of unique methods so I can spot when to use a suffix and I needed a second SortedList to sort the methods into a nice sorted order. I wanted to keep information together so I defined a type and created an array of those types. Enjoy!

Option Explicit

'Tools -> References -> mscorlib.dll

Private Type udtMethodInfo
    '*
    '* package all the working variables into a type
    '*
    DotNetName As String
    ReturnType As String
    HasReturnType As Boolean
    Params As String
    ComName As String '* can be suffixed to differentiate
    ComNameAndParams As String
    ReportLine As String '* nice pretty format
End Type

'*
'* give ourselves an array of types so we can report
'*
Private mauMethods() As udtMethodInfo

Sub Test()
    Dim obj As Object
    '* Component needs to have Category ID (CATID) of {62C8FE65-4EBB-45E7-B440-6E39B2CDBF29}  .NET Cateogry
    '* ComputerHKEY_CLASSES_ROOTComponent Categories{62C8FE65-4EBB-45e7-B440-6E39B2CDBF29}
    
    Dim sProgId As String
    'sProgId = "System.Collections.ArrayList"
    'sProgId = "System.Collections.Stack"
    'sProgId = "System.Collections.HashTable"
    'sProgId = "System.Collections.SortedList"
    sProgId = "System.Collections.Queue"
    
    DotNetReflection sProgId
End Sub

Sub DotNetReflection(Optional ByVal sProgId As String = "System.Collections.Queue")
    '*
    '* Create a .NET object that is exposed to COM,
    '* Get the .NET Type object which gives reflections,
    '* then print out the interface of methods
    '* because sadly no Intellisense (even if early bound to mscorlib.dll!)
    '*
    
    Dim objDotNet As Object
    Set objDotNet = VBA.CreateObject(sProgId)
    
    Dim sortedUniqueMethods As Object  '* this tracks uniqueness
    Set sortedUniqueMethods = CreateObject("System.Collections.SortedList")

    Dim sortedCOMNamesAndParams As Object  '* this sorts for the final listing
    Set sortedCOMNamesAndParams = CreateObject("System.Collections.SortedList")

    Dim typ As mscorlib.Type
    Set typ = objDotNet.GetType()
    
    Dim mi() As mscorlib.MethodInfo
    mi = typ.GetMethods_2()       <--- good example of a suffixed overload!!!
    
    ReDim mauMethods(0 To UBound(mi)) As udtMethodInfo

    Dim idx As Integer
    For idx = 0 To UBound(mi)
    
        Dim miLoop As MethodInfo
        Set miLoop = mi(idx)
        
        mauMethods(idx).DotNetName = miLoop.Name
        mauMethods(idx).ReturnType = miLoop.ReturnType.Name
        mauMethods(idx).HasReturnType = (mauMethods(idx).ReturnType <> "Void")
        
        mauMethods(idx).Params = ListParameters(miLoop)
    
        Call FindUniqueMethodName(sortedUniqueMethods, sortedCOMNamesAndParams, mauMethods(idx), idx)
        
    Next
    
    '*
    '* so we have all the information in the array, mauMethods(lLookup).  But, instead of printing in arrival sequence
    '* we want to print alphabetical order that's why we have sortedCOMNamesAndParams
    '*
    Dim objValueList As Object
    Set objValueList = sortedCOMNamesAndParams.GetValueList()
    
    Dim lLoop As Long
    For idx = 0 To sortedCOMNamesAndParams.Count - 1
        Dim lLookup As Long
        lLookup = objValueList(idx)
        
        Debug.Print "'" & mauMethods(lLookup).ReportLine
    Next

End Sub

Sub FindUniqueMethodName(ByVal sortedUniqueMethods As Object, ByVal sortedCOMNamesAndParams As Object, _
    ByRef puMethod As udtMethodInfo, ByVal idx As Long)
    
    Dim sSig As String
    sSig = Signature2(puMethod.DotNetName, puMethod)
    
    If Not sortedUniqueMethods.ContainsKey(sSig) Then
        '*
        '* no clash, no overload, easy
        '*
        puMethod.ComName = puMethod.DotNetName
    Else

        '*
        '* we have an overload so now loop through adding suffix until unique
        '*
        Dim lLoop As Long
        For lLoop = 2 To 255
            Dim sSuffixedName As String
            sSuffixedName = puMethod.DotNetName & "_" & CStr(lLoop)
            
            sSig = Signature2(sSuffixedName, puMethod)
            If Not sortedUniqueMethods.ContainsKey(sSig) Then
                puMethod.ComName = sSuffixedName
                
                Exit For '* found one so can quit loop
            End If
        Next lLoop
    
    End If
    
    puMethod.ComNameAndParams = puMethod.ComName & puMethod.Params
    puMethod.ReportLine = PadSpacesRightAlign(puMethod.ReturnType, 24) & " " & puMethod.ComNameAndParams
    
    sortedUniqueMethods.Add sSig, idx
    sortedCOMNamesAndParams.Add puMethod.ComNameAndParams, idx
   
End Sub

Function Signature2(ByVal sName As String, ByRef puMethod As udtMethodInfo) As String
    '*
    '* concatenate attributes to help establish uniqueness or overload
    '*
    Signature2 = CStr(puMethod.HasReturnType) & " " & sName & " " & puMethod.Params
End Function

Function ListParameters(mi As MethodInfo) As String
    '*
    '* sadly, yet to figure out how to get the ParamterType TODO fix that
    '*
    Dim paramInfo() As mscorlib.ParameterInfo
    paramInfo() = mi.GetParameters()
    
    Dim lParamCount As Long
    lParamCount = UBound(paramInfo()) - LBound(paramInfo()) + 1

    Dim sReturn As String

    Dim lParamLoop As Long
    For lParamLoop = LBound(paramInfo()) To UBound(paramInfo())
        
        sReturn = sReturn & VBA.IIf(Len(sReturn) > 0, ",", "") & "?"
    
    Next lParamLoop
    
    ListParameters = "(" & sReturn & ")"

End Function

Function PadSpacesRightAlign(s, n) As String
    '*
    '* this helps align the method listing
    '*
    Dim lLen As Long
    lLen = Len(s)
    Dim n2 As Long
    If lLen > n Then n2 = lLen Else n2 = n
    PadSpacesRightAlign = Right(String(n2, " ") & s, n2)
End Function

Appendix A - Queue Class IDL shows no methods

OLEVIWEW.exe is usually the most revealing when looking for interface definitions, but even here the Queue class's IDL shows no clues as to what methods it supports and that is why there is no VBA Intellisense...

    [ uuid(7F976B72-4B71-3858-BEE8-8E3A3189A651), version(1.0), custom(0F21F359-AB84-41E8-9A78-36D110E6D2F9, "System.Collections.Queue") ]
    coclass Queue {
        [default] interface _Queue;
        interface _Object;
        interface ICollection;
        interface IEnumerable;
        interface ICloneable;
    };

    [ odl, uuid(3A7D3CA4-B7D1-3A2A-800C-8FC2ACFCBDA4), 
      hidden, dual, oleautomation, custom(0F21F359-AB84-41E8-9A78-36D110E6D2F9, "System.Collections.Queue") ]
    interface _Queue : IDispatch {
    };

Monday, 24 September 2018

VBA - .NET - Registry - Finding .NET objects creatable and reflectable from VBA

In this post, I give code that replicates a feature of OLEVIEW.exe (downloadable from the Windows Platform SDK). There are thousands of COM classes registered and it is nice to have categorisation system. In the screenshot below on the left one can see the categories, the top left is the .NET Category (circled in red), there are many other categories but for the moment I am interested in COM/.NET Interoperability.

OLEVIEW screenshot showing Component Categories

If one clicks on the .NET category icons that one gets a long list of .NET classes. I want to focus on two blocks both from the .NET namespace, System.Collections and System.Text. In the screenshot on the right hand side one can see the two blocks given as fragments (I have rubbed out surrounding entries).

How Component Category details are registered

Components belong to a category if they have extra keys in the registry. Under the CLSID entry, there needs to be an 'Implemented Categories' key, under which there needs to be a key for each category the class belongs to. The details of categories are registered separately and given a category ID (CATID) which is a GUID just like CLSID. Perhaps a registry export can clarify, the following is the registry details for a System.Collections.SortedList

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\CLSID\{026CC6D7-34B2-33D5-B551-CA31EB6CE345}]
@="System.Collections.SortedList"

[HKEY_CLASSES_ROOT\CLSID\{026CC6D7-34B2-33D5-B551-CA31EB6CE345}\Implemented Categories]

[HKEY_CLASSES_ROOT\CLSID\{026CC6D7-34B2-33D5-B551-CA31EB6CE345}\Implemented Categories\{62C8FE65-4EBB-45E7-B440-6E39B2CDBF29}]

[HKEY_CLASSES_ROOT\CLSID\{026CC6D7-34B2-33D5-B551-CA31EB6CE345}\InprocServer32]
@="C:\\Windows\\System32\\mscoree.dll"
"Assembly"="mscorlib, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"
"Class"="System.Collections.SortedList"
"ThreadingModel"="Both"

[HKEY_CLASSES_ROOT\CLSID\{026CC6D7-34B2-33D5-B551-CA31EB6CE345}\ProgId]
@="System.Collections.SortedList"

As I said the details, in this case the friendly text name, is stored elsewhere under HKCR\Component Categories\ here, specifically, is the NET Category ID...

[HKEY_CLASSES_ROOT\Component Categories\{62C8FE65-4EBB-45e7-B440-6E39B2CDBF29}]
"0"=".NET Category"
"409"=".NET Category"

Talk-through of code to find .NET category COM classes, filtered to be VBA creatable and reflectable

I want to investigate what .NET classes exposed as COM classes can be created in VBA so I can use them instead of say Scriping.Dictionary. I also want to interrogate them for their methods, so I want them to be reflectable. I wrote some code but the resultant list was very long so I narrowed it down further, many of the NET classes exposed as COM classes are in fact Exception classes or Attribute classes and I could not imagine VBA code creating one of these so I filtered them. Then the list was still too long (at least for a blog) so I narrowed it down to the System.Collections.* namespace and the System.Text.* namespace. You can amend the code and lift those restrictions to see a bigger list BUT AT YOUR OWN RISK.

The code is peppered with comments so I'll try not to replicate those. Instead I will summarise the logic, it will sweep the registry looking for CLSIDs, i.e. registered COM classes, then for each CLSID it looks for the .NET Category CatID. If a .NET Category class is found the code then attempts to instantiate the class with VBA.CreateObject, if that fails the class is pretty much useless to a VBA developer (though I suppose we could be passed one out of a .NET assembly). Further because the Intellisense is not working for these classes (something I will return to) I want to be able to interrogate the class using .NET reflection, this means the GetType method must be implemented. If all those filters are passed then it gets added to a list. The collated list is pasted to a column on a worksheet (Sheet1, warning will overwrite!). My (tabulated) list looks as follows

.NET classes exposed as COM classes that are creatable and reflectable

System.Collections.ArrayList System.Collections.Queue System.Text.StringBuilder
System.Collections.CaseInsensitiveComparer System.Collections.SortedList System.Text.UnicodeEncoding
System.Collections.CaseInsensitiveHashCodeProvider System.Collections.Stack System.Text.UTF7Encoding
System.Collections.Hashtable System.Text.ASCIIEncoding System.Text.UTF8Encoding

The program listing

This code will needs a Tools->Reference to the .net run time mscorlib.dll.

Option Explicit
Option Private Module

'https://msdn.microsoft.com/en-us/library/aa390387(v=vs.85).aspx
Private Const HKCR = &H80000000

Private Const msDotNetCategoryID As String = "{62C8FE65-4EBB-45E7-B440-6E39B2CDBF29}"

Private Sub FindDotNotComEnabledObjects()

    Dim oWMIReg As Object
    Set oWMIReg = GetStdRegProv

    Debug.Assert TypeName(oWMIReg) = "SWbemObjectEx"

    Dim sKeyPath As String
    sKeyPath = "CLSID"

    '*
    '* Get a list of all keys under CLSID
    '*
    Dim vClsIds As Variant
    Call oWMIReg.EnumKey(HKCR, sKeyPath, vClsIds)

    Dim objSortedList As Object ' mscorlib.SortedList
    Set objSortedList = CreateObject("System.Collections.SortedList") 'New mscorlib.SortedList

    Dim vClsIdLoop As Variant
    For Each vClsIdLoop In vClsIds
        Dim sProgId As String
        
        If ProbeForImplementedCategory(vClsIdLoop, msDotNetCategoryID, sProgId) Then
            '*
            '* select in progids belonging to .NET collections and text processing
            '* i.e. namespaces that are prefixed System.Collection.* or System.Text.*
            '*
            If Left(sProgId, 11) = "System.Text" Or Left(sProgId, 18) = "System.Collections" Then
            
                '*
                '* select out Exceptions and Attributes
                '*
                If Right(sProgId, 9) <> "Exception" And Right(sProgId, 9) <> "Attribute" Then
                
                    '*
                    '* only interested in those creatable from VBA and have implemented System.Object.GetType
                    '*
                    Dim bHasGetType As Boolean
                    If CreatableProgId(sProgId, bHasGetType) Then
                    
                        objSortedList.Add sProgId, 0
                    End If
                End If
            End If

        End If
    Next vClsIdLoop

    '*
    '* paste the filtered results to the worksheet
    '*
    Dim oKeys As Object
    Set oKeys = CreateObject("System.Collections.ArrayList")
    oKeys.AddRange objSortedList.GetKeyList()
    Sheet1.Cells(1, 1).Resize(objSortedList.Count, 1).Value2 = Application.Transpose(oKeys.ToArray)

    'Stop
End Sub

Private Function GetStdRegProv() As Object
    '*
    '* Placing separately faciliates unit tests
    '*
    Static oWMIReg As Object
    If oWMIReg Is Nothing Then
        Set oWMIReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\.rootdefault:StdRegProv")
    End If
    Set GetStdRegProv = oWMIReg
End Function

Private Function CreatableProgId(ByVal sProgId As String, ByRef pbHasGetType As Boolean) As Boolean
    '*
    '* Two Error Handlers in this procedure (because I was interested in the different error numbers)
    '* nevertheless there are two hoops to jump through
    '* (1) create the object (2) get the Type
    '*
    On Error GoTo CreateObjectErrHand

    Dim obj As Object
    Set obj = VBA.CreateObject(sProgId)
    CreatableProgId = True

    On Error GoTo GetTypeErrHand
    '*Tools->References->mscorlib
    Dim objType As mscorlib.Type
    Set objType = obj.GetType
    pbHasGetType = True

SingleExit:
    Exit Function
CreateObjectErrHand:
    Debug.Assert Err.Number = 424 Or Err.Number = 429 Or Err.Number = &H80070002 Or Err.Number = &H80131040 Or Err.Number = &H80131522
    GoTo SingleExit

GetTypeErrHand:

    Debug.Assert Err.Number = 438 Or Err.Number = 424
    GoTo SingleExit

End Function

Private Sub UnitTestProbeForImplementedCategory()
    Dim sProgId As String
    Debug.Print ProbeForImplementedCategory("{026CC6D7-34B2-33D5-B551-CA31EB6CE345}", msDotNetCategoryID, sProgId)
End Sub

Private Function ProbeForImplementedCategory(ByVal sClsId As String, ByVal sCatId As String, ByRef psProgId As String) As Boolean
    
    '*
    '* For a given CLSID we probe subkeys looking for Implemented Categories
    '*

    Dim sPath As String
    sPath = "CLSID" & sClsId & "Implemented Categories"

    Dim oWMIReg As Object
    Set oWMIReg = GetStdRegProv

    '*
    '* get list of subkeys (totalling typically 0,1 or 2), they will be CatIDs
    '*
    Dim vCatIds As Variant
    Call oWMIReg.EnumKey(HKCR, sPath, vCatIds)

    If Not IsNull(vCatIds) Then
        'Stop
        Dim vCatIdLoop As Variant
        For Each vCatIdLoop In vCatIds
            DoEvents
            If StrComp(vCatIdLoop, sCatId, vbTextCompare) = 0 Then

                psProgId = GetRegString("CLSID" & sClsId & "ProgId", "")

                ProbeForImplementedCategory = True
                GoTo SingleExit
            End If
        Next vCatIdLoop
    End If
SingleExit:

End Function

'**********************************************************************************
'* Syntactic sugar to compact code
'**********************************************************************************
Private Function GetRegString(ByVal sPath As String, sValue As String) As String
    Dim sRet As String

    GetStdRegProv.GetStringValue HKCR, sPath, sValue, sRet
    GetRegString = sRet
End Function