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
|