Get the Class Name from a ActiveX Class when use CreateObject
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.
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 LongPrivate Declare
Function RegCloseKey Lib "advapi32.dll" (ByVal hKey
As Long)
As LongPrivate 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
Private Const BUFFER_SIZE = 1024
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 IfEnd FunctionPrivate 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
If RegOpenKeyEx(HKEY_CLASSES_ROOT, strActiveXClass & "\CLSID", 0, KEY_READ, hKeyCLSID) = ERROR_SUCCESS
Then
If RegQueryValueEx(hKeyCLSID, "", 0, REG_SZ, ByVal strBuffer, BUFFER_SIZE) = ERROR_SUCCESS
Then strCLSID = TrimZero(strBuffer)
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 RegQueryValueEx(hKeyClassFile, "", 0, REG_SZ, ByVal strBuffer, BUFFER_SIZE) = ERROR_SUCCESS
Then MsgBox "The
class filename is " & TrimZero(strBuffer)
Else blnError =
True End If
RegCloseKey hKeyClassFile
Else blnError =
True End If Else blnError =
True End If
RegCloseKey hKeyCLSID
Else blnError =
True End If If blnError
Then MsgBox "The " & strActiveXClass & " class doesn't exist in your registry", vbOKOnly Or vbExclamation
End IfEnd SubPrivate Sub cmdGetFilename_Click()
GetFilenameFromClass txtClass.Text
End Sub