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
No comments:
Post a Comment