Coding discussed in last post.
Results and conclusions in next posts
Code:
Option Explicit
Sub BonnieBonnieBoundsOfCLSIDs() ' https://www.excelfox.com/forum/showthread.php/2997-Testies-external-shared-Libraries-regedit-registry?p=25037&viewfull=1#post25037 ' KeksXP()
Rem 0
On Error GoTo OtherError
Dim Ws As Worksheet: Set Ws = Me
Let Ws.Range("A1:I1") = Array("", "TypeName(Obj)", "ProgID", "Clsid", "Version at Clsid", "TypeLib Guid", "Version at TypeLib", "Human readable name", "File")
'Me.Columns("A:I").Clear
Dim StrCom As String: Let StrCom = "."
Dim RegInfoPro As Object: Set RegInfoPro = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & StrCom & "\root\default:StdRegProv")
Dim RegHive As Long: Let RegHive = -214748364.8 * 10
Rem 1 Clsids - for Clsid output, (but also to use for the other outputs)
Dim Clsids() As Variant
RegInfoPro.EnumKey RegHive, "CLSID", Clsids() ' Computer\HKEY_CLASSES_ROOT , CLSID , here comes the big array of all ya Clsids
Dim ClsInfCnt As Long, Rw As Long: Let Rw = 1 ' This keeps track of the rows - there will likely be more than there are Clsids as we need an extra row for versions at the TypeLib place
For ClsInfCnt = LBound(Clsids()) To UBound(Clsids()) ' The main Clsid Loop =======================
Let Rw = Rw + 1 ' Every Clsid is on a new line
Let Ws.Range("A" & Rw & "") = ClsInfCnt & " " & Rw ' The first is a 0 and in the array is "CSID" after that in the array you get the { Guid thingy } format https://i.postimg.cc/mrHxggQD/Computer-HKEY-CLASSES-ROOT-CLSID.jpg
Let Ws.Range("D" & Rw & "") = Clsids(ClsInfCnt) ' The main { Clsid thingy }
Rem 3 InprocServer32 ' This seems to be the .dll or similar file
Dim IprcSvr32 As Variant
RegInfoPro.getstringvalue RegHive, "CLSID\" & Clsids(ClsInfCnt) & "\InprocServer32", "", IprcSvr32
If IsNull(IprcSvr32) Then
Let Ws.Range("I" & Rw & "") = " -"
Else
Let Ws.Range("I" & Rw & "") = IprcSvr32
End If
Rem 4 ProgID (- see Mike here https://eileenslounge.com/viewtopic.php?p=326247#p326247 ) if there is one held "at the Clsid"
Dim PrgID As Variant
RegInfoPro.getstringvalue RegHive, "CLSID\" & Clsids(ClsInfCnt) & "\ProgID", "", PrgID
If IsNull(IprcSvr32) Then
Let Ws.Range("C" & Rw & "") = " -"
Else
Let Ws.Range("C" & Rw & "") = PrgID
End If
Rem 5 Version numnber if there is one held "at the Clsid"
Dim CGVers As Variant
RegInfoPro.getstringvalue RegHive, "CLSID\" & Clsids(ClsInfCnt) & "\Version", "", CGVers
If IsNull(CGVers) Then
Let Ws.Range("E" & Rw & "") = " -"
Else
Let Ws.Range("E" & Rw & "") = "'" & CGVers
End If
Rem 6 TypeLib Guid if there is one held "at the Clsid"
Dim TypeLibGuid As Variant
RegInfoPro.getstringvalue RegHive, "CLSID\" & Clsids(ClsInfCnt) & "\TypeLib", "", TypeLibGuid
If IsNull(TypeLibGuid) Then
Let Ws.Range("F" & Rw & "") = " -"
Else ' Time to get the array of versions
Let Ws.Range("F" & Rw & "") = TypeLibGuid ' The Guid related to "human readable description" or "TypeLib human readable name" given in that little window which you use to check a external Library reference from the VB Editor , and the one to use in the .AddFromGuid
Dim Vers As Variant, CntV As Long ' Vers can be ab array or Null
'6b)
RegInfoPro.EnumKey RegHive, "TypeLib\" & TypeLibGuid, Vers
If IsNull(Vers) Then
Let Ws.Range("G" & Rw & "") = "Null versions at Computer\HKEY_CLASSES_ROOT\TypeLib"
Else
For CntV = LBound(Vers) To UBound(Vers)
Let Ws.Range("G" & Rw & "") = "'" & Vers(CntV)
Dim Description As String ' Might think about having this Variant. This is the "human readable description" or "TypeLib human readable name" given in that little window which you use to check a external Library reference from the VB Editor , and the one to use in the .AddFromGuid
RegInfoPro.getstringvalue RegHive, "TypeLib\" & TypeLibGuid & "\" & Vers(CntV), "", Description
Let Ws.Range("H" & Rw & "") = Description
If CntV < UBound(Vers) Then Let Rw = Rw + 1 ' we need an extra line for the next version
Next CntV
End If
End If
Rem 7 Try to make an object type ' Do this last as it can crash and/ or set the Devil loose
Dim LateBndObj As Object
On Error GoTo BadObjType ' I expect the next line often to error when I try to use
Set LateBndObj = CreateObject("New:" & Clsids(ClsInfCnt) & "")
On Error GoTo OtherError
Let Ws.Range("B" & Rw & "") = TypeName(LateBndObj)
BonniBanksOfLochLomond: '
Next ClsInfCnt ' The main Clsid loop =============================================================
Exit Sub
BadObjType:
Let Ws.Range("B" & Rw & "") = "Err '" & Err.Number & "': " & Err.Description
Let Ws.Range("B" & Rw & "").Font.Color = 12632256
On Error GoTo -1
On Error GoTo OtherError
GoTo BonniBanksOfLochLomond ' https://eileenslounge.com/viewtopic.php?p=326446#p326446
OtherError:
Stop
Debug.Print "Err '" & Err.Number & "': " & Err.Description & " " & ClsInfCnt & " " & Rw
Stop
Resume Next
End Sub
We have learnt now that the relevant word to use there is the "human readable description" or "TypeLib human readable name", aka the name to look for in the little window for checking a reference
, but that is perhaps not coming from directly from there, well maybe it is sort of,….
Reply With Quote
Bookmarks