How To Determine the Version of DCOM 95/98 Using Visual Basic (232003)

MORE INFORMATION

1. Start a new Visual Basic Standard EXE project. Form1 is created by default.
2. Add a CommandButton (Command1) to Form1.
3. Add the following code to the General Declarations section of Form1:

   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
   					

4. Run the program and click Command1. Result: If DCOM is installed on the system, the message box will display the version number.