Find an OLE server's CLSID and executable from the registry
![[OLE/Registry Information example]](/images/regole.gif)
 Download the RegOLE Demo Application (25kb)
 Updated!
10 January 1999: Modified the code to get the CLSID from the ProgID to use the OLE methods
rather than the registry. This is more reliable and takes into account the current server version.
It can be useful to find the executable which is used to implement a particular OLE
class at runtime. For example, you may just want to shell an application, in which
case if it exposes and OLE method, the most reliable methods of finding where it is
installed is to check in the registry OLE items. Or you may want to find out if a
particular OLE server is installed on a machine, or check its version.
This source code shows how to do it using the registry. This method uses my
cRegistry class to make it easy to get the registry
information.
Private Function GetInfoForOLEType( _
ByVal sType As String, _
Optional ByRef sUserName As String, _
Optional ByRef sClassID As String, _
Optional ByRef sExeName As String, _
Optional ByRef sMsg As String _
) As Boolean
Dim cR As New cRegistry
sUserName = "": sClassID = "": sExeName = ""
GetInfoForOLEType = True
sClassID = VBCLSIDFromProgID(sType)
If (sClassID = "") Then
GetInfoForOLEType = False
sMsg = "The OLE server '" & sType & "' is not registered on this system."
Else
cR.ClassKey = HKEY_CLASSES_ROOT
cR.SectionKey = "CLSID\" & sClassID
sUserName = cR.Value
cR.SectionKey = "CLSID\" & sClassID & "\LocalServer32"
sExeName = cR.Value
End If
End Function
And this is the OLE code run from VBCLSIDFromProgID:
Private Type CLSID ' same as GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal lpszProgID As Long, lpclsid As CLSID) As Long
Private Declare Function StringFromCLSID Lib "ole32.dll" (rclsid As CLSID, ByRef lppsz As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Const S_OK = 0
Public Function VBCLSIDFromProgID(ByVal sProgId As String) As String
Dim tG As CLSID
Dim sCLSID As String
Dim lR As Long
Dim lPtr As Long
Dim b() As Byte
lPtr = StrPtr(sProgId)
lR = CLSIDFromProgID(lPtr, tG)
If (lR = S_OK) Then
sCLSID = String$(255, vbNullChar)
lR = StringFromCLSID(tG, lPtr)
If (lR = S_OK) Then
ReDim b(0 To 38 * 2 - 1) As Byte
CopyMemory b(0), ByVal lPtr, 38 * 2
VBCLSIDFromProgID = b
End If
End If
End Function
Back to top
Back to Source Code Overview
|
