[13] | 1 | Attribute VB_Name = "RegkeyModule" |
---|
| 2 | Option Explicit |
---|
| 3 | |
---|
| 4 | Public Const HKEY_CLASSES_ROOT = &H80000000 |
---|
| 5 | Public Const HKEY_CURRENT_CONFIG = &H80000005 |
---|
| 6 | Public Const HKEY_CURRENT_USER = &H80000001 |
---|
| 7 | Public Const HKEY_LOCAL_MACHINE = &H80000002 |
---|
| 8 | Public Const HKEY_USERS = &H80000003 |
---|
| 9 | |
---|
| 10 | Public 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 |
---|
| 11 | Public 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 |
---|
| 12 | Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long |
---|
| 13 | |
---|
| 14 | Public Const ERROR_SUCCESS = 0& |
---|
| 15 | |
---|
| 16 | Public Const STANDARD_RIGHTS_ALL = &H1F0000 |
---|
| 17 | Public Const KEY_QUERY_VALUE = &H1 |
---|
| 18 | Public Const KEY_SET_VALUE = &H2 |
---|
| 19 | Public Const KEY_CREATE_SUB_KEY = &H4 |
---|
| 20 | Public Const KEY_ENUMERATE_SUB_KEYS = &H8 |
---|
| 21 | Public Const KEY_NOTIFY = &H10 |
---|
| 22 | Public Const KEY_CREATE_LINK = &H20 |
---|
| 23 | Public Const SYNCHRONIZE = &H100000 |
---|
| 24 | Public Const KEY_ALL_ACCESS = _ |
---|
| 25 | ((STANDARD_RIGHTS_ALL Or _ |
---|
| 26 | KEY_QUERY_VALUE Or _ |
---|
| 27 | KEY_SET_VALUE Or _ |
---|
| 28 | KEY_CREATE_SUB_KEY Or _ |
---|
| 29 | KEY_ENUMERATE_SUB_KEYS Or _ |
---|
| 30 | KEY_NOTIFY Or KEY_CREATE_LINK) And _ |
---|
| 31 | (Not SYNCHRONIZE)) |
---|
| 32 | |
---|
| 33 | ' Return a registry key value. |
---|
| 34 | Public Function GetRegKeyValue(ByVal root As Long, ByVal key_name As String, ByVal subkey_name As String) As String |
---|
| 35 | Dim hKey As Long |
---|
| 36 | Dim value As String |
---|
| 37 | Dim length As Long |
---|
| 38 | Dim value_type As Long |
---|
| 39 | GetRegKeyValue = "" |
---|
| 40 | ' Open the key. |
---|
| 41 | If RegOpenKeyEx(root, key_name, _ |
---|
| 42 | 0&, KEY_QUERY_VALUE, hKey) <> ERROR_SUCCESS _ |
---|
| 43 | Then |
---|
| 44 | 'MsgBox "Error opening key." |
---|
| 45 | Exit Function |
---|
| 46 | End If |
---|
| 47 | |
---|
| 48 | ' Get the subkey's size. |
---|
| 49 | If RegQueryValueEx(hKey, subkey_name, _ |
---|
| 50 | 0&, value_type, ByVal 0&, length) _ |
---|
| 51 | <> ERROR_SUCCESS _ |
---|
| 52 | Then |
---|
| 53 | 'MsgBox "Error getting subkey length." |
---|
| 54 | End If |
---|
| 55 | |
---|
| 56 | ' Get the subkey's value. |
---|
| 57 | value = Space$(length) |
---|
| 58 | If RegQueryValueEx(hKey, subkey_name, _ |
---|
| 59 | 0&, value_type, ByVal value, length) _ |
---|
| 60 | <> ERROR_SUCCESS _ |
---|
| 61 | Then |
---|
| 62 | 'MsgBox "Error getting subkey value." |
---|
| 63 | Else |
---|
| 64 | ' Remove the trailing null character. |
---|
| 65 | GetRegKeyValue = Left$(value, length - 1) |
---|
| 66 | End If |
---|
| 67 | |
---|
| 68 | ' Close the key. |
---|
| 69 | If RegCloseKey(hKey) <> ERROR_SUCCESS Then |
---|
| 70 | 'MsgBox "Error closing key." |
---|
| 71 | End If |
---|
| 72 | End Function |
---|
| 73 | |
---|
| 74 | |
---|