Getting the filename of an ActiveX class name

Submitted by:Andery Smith

Date added:05 April, 2011

Category:Visual Basic

In some circumstances, you use the CreateObject function to create an object from an ActiveX class. The CreateObject function receives the class name as argument, and creates the object for you. In order to create the object, it loads and uses the right library or executable file that contains the interface for that object.

For Example:
set objApplication = CreateObject("Word.Application")

When you run the above code, the CreateObject will use the winword.exe in order to interact with the objects of Microsoft Word.
The following code snippet shows how to reveal the filename that will be used for a specific ActiveX class. It does it by reading the class definitions from the Registry.

Tags: activex class

Code Snippet:

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Const HKEY_CLASSES_ROOT = &H80000000

Private Const SYNCHRONIZE = &H100000
Private Const KEY_NOTIFY = &H10
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_QUERY_VALUE = &H1
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const READ_CONTROL = &H20000

Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS = 0&

Private Const REG_SZ = 1 ' Unicode nul terminated string

Private Const BUFFER_SIZE = 1024

'The following function truncate the null character from a string.
Private Function TrimZero(str As String) As String
Dim lngPos As Long

lngPos = InStr(str, Chr$(0))
If lngPos > 0 Then
TrimZero = Mid$(str, 1, lngPos - 1)
Else
TrimZero = str
End If
End Function

Private Sub GetFilenameFromClass(strActiveXClass As String)
Dim hKeyCLSID As Long
Dim hKeyClassFile As Long
Dim strCLSID As String
Dim strBuffer As String * BUFFER_SIZE
Dim blnError As Boolean
Dim blnFound As Boolean

'Find the class name in the Registry, under the HKEY_CLASSES_ROOT branch.
If RegOpenKeyEx(HKEY_CLASSES_ROOT, strActiveXClass & "\CLSID", 0, KEY_READ, hKeyCLSID) = ERROR_SUCCESS Then
'If we find the right key, read the CLSID value.
If RegQueryValueEx(hKeyCLSID, "", 0, REG_SZ, ByVal strBuffer, BUFFER_SIZE) = ERROR_SUCCESS Then
strCLSID = TrimZero(strBuffer)
'find the key containing the class filename:
If RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID\" & strCLSID & "\InprocServer32", 0, KEY_READ, hKeyClassFile) = ERROR_SUCCESS Then
blnFound = True
ElseIf RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID\" & strCLSID & "\LocalServer32", 0, KEY_READ, hKeyClassFile) = ERROR_SUCCESS Then
blnFound = True
End If

If blnFound Then
'If we find the right key, read the value:
If RegQueryValueEx(hKeyClassFile, "", 0, REG_SZ, ByVal strBuffer, BUFFER_SIZE) = ERROR_SUCCESS Then
MsgBox "The class filename is " & TrimZero(strBuffer)
Else
blnError = True
End If

'Close the key handle
RegCloseKey hKeyClassFile
Else
blnError = True
End If
Else
blnError = True
End If

'Close the key handle
RegCloseKey hKeyCLSID
Else
blnError = True
End If

If blnError Then
MsgBox "The " & strActiveXClass & " class doesn't exist in your registry", vbOKOnly Or vbExclamation
End If
End Sub

Private Sub cmdGetFilename_Click()
GetFilenameFromClass txtClass.Text
End Sub
 
 

Comments