Option Explicit

Private Const ERROR_SUCCESS = 0&

Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CLASSES_ROOT = &H80000000

Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000

Private Const KEY_ALL_ACCESS = _
   ((STANDARD_RIGHTS_ALL Or _
     KEY_QUERY_VALUE Or _
     KEY_SET_VALUE Or _
     KEY_CREATE_SUB_KEY Or _
     KEY_ENUMERATE_SUB_KEYS Or _
     KEY_NOTIFY Or _
     KEY_CREATE_LINK _
    ) _
    And (Not SYNCHRONIZE) _
   )

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, _
    ByVal lpData As String, _
    lpcbData As Long) _
   As Long
   
' Note that if you declare the lpData
' parameter as String, you must pass it
' By Value as is done here.

Private Declare Function GetProcAddress _
   Lib "kernel32" _
   (ByVal hModule As Long, _
    ByVal lpProcName As String) _
   As Long

Private Declare Function GetModuleHandle _
   Lib "kernel32" Alias "GetModuleHandleA" _
   (ByVal lpModuleName As String) _
   As Long
   
Private Function DCOMEnabled() As Boolean
' We need to check two things
' 1- OLE32 supports free threading
' 2- DCOM is enabled in the registry
' See Inside COM, Rogerson, pp 276-277

   DCOMEnabled = False
   
' First, check to see if OLE32 supports free threading.
' You need to check for the CoInitializeEx function's
' presence in OLE32.
' 1- Get a handle to the OLE32 module
' 2- Try to get a ProcAddress for CoInitializeEx

   Dim OLE32ModuleHandle As Long
   Dim CoInitializeExProcAddress As Long
   
   OLE32ModuleHandle = GetModuleHandle("OLE32")
   Debug.Assert (Not OLE32ModuleHandle = 0)
   
   CoInitializeExProcAddress = GetProcAddress( _
           OLE32ModuleHandle, _
           "CoInitializeEx")
         
   Debug.Print "CoInitializeExProcAddress = " _
               & CoInitializeExProcAddress
               
   If CoInitializeExProcAddress = 0 Then
      DCOMEnabled = False
      Exit Function
   End If
   
' Now check the registry to see if DCOM is enabled.
   
   Dim lResult As Long
   Dim hKey As Long

   lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
                   "SOFTWARE\Microsoft\Ole", _
                   0, _
                   KEY_ALL_ACCESS, _
                   hKey)
   
   Debug.Assert (lResult = ERROR_SUCCESS)

   Dim rgch As String
   rgch = String(2, 0)
   
   Dim cbrgch As Long
   cbrgch = Len(rgch)
   
   lResult = RegQueryValueEx(hKey, "EnableDCOM", 0, 0&, rgch, cbrgch)

   Debug.Assert (lResult = ERROR_SUCCESS)

   Debug.Print "Mid$(rgch, 1) is " & Mid$(rgch, 1)

   If (Mid$(rgch, 1, 1) = "Y" Or Mid$(rgch, 1, 1) = "y") Then
      ' DCOM is Enabled
      DCOMEnabled = True
   Else
      DCOMEnabled = False
   End If
                   
   lResult = RegCloseKey(hKey)
           
End Function

Public Function GetDCOMVersion() As String
    ' Check the registry key "InstalledVersion" to see which
    ' version of DCOM is installed.

   Dim hKey As Long
   Dim lResult As Long

' First confirm that DCOM is installed
   If Not DCOMEnabled() Then
       MsgBox "Can't check version.  DCOM is not installed."
       Exit Function
   End If

' open the the proper registry key
   lResult = RegOpenKeyEx(HKEY_CLASSES_ROOT, _
         "CLSID\{bdc67890-4fc0-11d0-a805-00aa006d2ea4}\InstalledVersion", _
         0, _
         KEY_ALL_ACCESS, _
         hKey)

   If Not lResult = ERROR_SUCCESS Then
       MsgBox "Could not open registry key"
       Exit Function
   End If

   Dim rgch As String
   rgch = String(64, 0)

   Dim cbrgch As Long
   cbrgch = Len(rgch)

   lResult = RegQueryValueEx(hKey, "", 0, 0&, rgch, cbrgch)

   lResult = RegCloseKey(hKey)

   Dim temp As String

   temp = Mid$(rgch, 1, cbrgch)

   GetDCOMVersion = temp

End Function

Private Sub Command1_Click()
   MsgBox GetDCOMVersion()
End Sub