' ***** HIVE Constants ***** Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Const HKEY_PERFORMANCE_DATA = &H80000004 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_DYN_DATA = &H80000006 ' Security constant Const KEY_READ = &H20019& Const KEY_ALL_ACCESS = &HF003F& ' ValueTypes Const REG_NONE = 0 Const REG_SZ = 1 Const REG_EXPAND_SZ = 2 Const REG_BINARY = 3 Const REG_DWORD = 4 Const REG_DWORD_LITTLE_ENDIAN = 4 Const REG_DWORD_BIG_ENDIAN = 5 Const REG_LINK = 6 Const REG_MULTI_SZ = 7 Const REG_RESOURCE_LIST = 8 Const REG_FULL_RESOURCE_DESCRIPTOR = 9 Const REG_RESOURCE_REQUIREMENTS_LIST = 10 'Error constant Const ERROR_SUCCESS = 0 Const ERROR_BADDB = 1 Const ERROR_BADKEY = 2 Const ERROR_CANTOPEN = 3 Const ERROR_CANTREAD = 4 Const ERROR_CANTWRITE = 5 Const ERROR_OUTOFMEMORY = 6 Const ERROR_ARENA_TRASHED = 7 Const ERROR_ACCESS_DENIED = 8 Const ERROR_INVALID_PARAMETERS = 87 Const ERROR_NO_MORE_ITEMS = 259 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 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 the lpData parameter is a String, you must pass it By Value. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 'Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" ( ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME ) As Long Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Integer, lpcbData As Long) As Long Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long ) As Long ' do we check the invoice values or can we stop now ? Dim CheckFact As String 'Note: lHive must be one of the HKEY constants Function RegGetStringValue(lHive As Long, Path As String, Key As String) As String Dim ret As Long 'returned by registry functions, should be ERROR_SUCCESS Dim lpHKey As Long 'handle to opened key Dim lpcbData As Long 'length of data in returned string Dim sBuffer As String 'buffer for string value Dim lpType As Long 'type of value read 'check if lHive is in a valid range If lHive >= HKEY_CLASSES_ROOT And lHive <= HKEY_DYN_DATA Then 'open key ret = RegOpenKeyEx(lHive, Path, 0, KEY_READ, lpHKey) If ret <> ERROR_SUCCESS Then RegGetStringValue = "" Exit Function 'No key open, so leave End If ' Set up buffer for data to be returned in. ' Adjust next value for larger buffers. lpcbData = 1024 sBuffer = Space$(lpcbData) 'now read key ret = RegQueryValueEx(lpHKey, Key, 0, lpType, sBuffer, lpcbData) If ret <> ERROR_SUCCESS Then RegGetStringValue = "" 'Simply return empty string in case of error Else RegGetStringValue = Left$(sBuffer, lpcbData - 1) End If 'always close open key ret = RegCloseKey(lpHKey) End If End Function