Test na nainstalovaný DCOM

Postup:
V deklarační části formuláře zapište:

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

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

   DCOMEnabled = False

   Dim OLE32ModuleHandle As Long
   Dim CoInitializeExProcAddress As Long

   OLE32ModuleHandle = GetModuleHandle("OLE32")

   CoInitializeExProcAddress = GetProcAddress( _
      OLE32ModuleHandle, "CoInitializeEx")

   If CoInitializeExProcAddress = 0 Then
      DCOMEnabled = False
      Exit Function
   End If

   Dim lResult As Long
   Dim hKey As Long

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

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

   Dim cbrgch As Long
   cbrgch = Len(rgch)

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

   If (Mid$(rgch, 1, 1) = "Y" Or Mid$(rgch, 1, 1) = "y") Then
      DCOMEnabled = True
   Else
      DCOMEnabled = False
   End If

   lResult = RegCloseKey(hKey)

End Function

Na formulář přidejte tlačítko. Na událost Click tlačítka:

Private Sub Command1_Click()

   MsgBox DCOMEnabled()

End Sub
   

Zpět

Autor: The Bozena