VB and VBA Users Source Code: Determining if DCOM is installed
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Determining if DCOM is installed
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, July 20, 2001
Hits:
799
Category:
Networks
Article:
The following function determines if DCOM is installed on the local machine: Option Explicit 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 Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long 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 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 STANDARD_RIGHTS_ALL = &H1F0000 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 Const ERROR_SUCCESS = 0 'Purpose : Determines if DCOM (Distributed Component Object Model) is installed and enabled on the current machine. 'Inputs : N/A 'Outputs : Returns True if DCOM is available. 'Author : Andrew Baker 'Date : 13/Jul/2001 'Notes : Function DCOMInstalled() As Boolean Const HKEY_LOCAL_MACHINE = &H80000002 Dim bPresent As Boolean Dim bEnabled As Boolean Dim hKey As Long Dim lpType As Long Dim lpData Dim lResult As Long Dim lpcbData As Long 'Check to see if OLE32 supports free threading, by checking 'for the CoInitializeEx function's presence in OLE32: '1. Get a handle to the OLE32 module '2. Try to get a ProcAddress for CoInitializeEx lResult = GetProcAddress(GetModuleHandle("OLE32"), "CoInitializeEx") If lResult <> 0 Then 'OLE32 supports free threading bPresent = True Else 'OLE32 doesn 't support free threading bPresent = False End If 'Check the registry to see if DCOM is enabled lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Ole", 0, KEY_ALL_ACCESS, hKey) lpcbData = Len("EnableDCOM") '10 If lResult = ERROR_SUCCESS Then lResult = RegQueryValueEx(ByVal hKey, "EnableDCOM", 0, ByVal lpType, lpData, lpcbData) End If If lResult = ERROR_SUCCESS Then bEnabled = True RegCloseKey hKey Else bEnabled = False End If If bEnabled And bPresent Then DCOMInstalled = True Else DCOMInstalled = False End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
