Public Enum Reg_HKey_Area 'Constants for specifying areas
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum
Const ERROR_NONE = 0 'Function results (if specified in the function)
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
Const ERROR_INSUFFICIENT_BUFFER = 122
Const ERROR_KEY_DELETED = 1018
Const ERROR_REGISTRY_CORRUPT = 1015
Public Enum Reg_Data_Type 'Constants for specifying data types
Reg_String = &O1
Reg_Dword = &O4
End Enum
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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 RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Function Reg_SetKeyValue(KeyArea As Reg_HKey_Area, sKeyName As String, sValueName As String, vValue As Variant, Optional lValueType As Reg_Data_Type)
'Sets a specified value in the registry (may or may not exist already).
'NB: This will only work if the KEY exists. To ensure it does
' you can simply call Reg_CreateNewKey (which creates it if
' necessary) or Reg_CheckKeyExists.
'Returns codes as listed in DECLARATIONS (ie: 0=error_none = no error)
Dim lRetVal As Long, hKey As Long
'try to detect type!
If lValueType <> Reg_String And lValueType <> Reg_Dword Then
lValueType = Reg_String
If (IsNumeric(vValue)) Then
If CInt(vValue) = vValue Then lValueType = Reg_Dword
End If
End If
'open the specified key
lRetVal = RegOpenKeyEx(KeyArea, sKeyName, 0, KEY_ALL_ACCESS, hKey)
If lRetVal <> ERROR_NONE Then Reg_SetKeyValue = lRetVal: Exit Function
Select Case lValueType 'set the value
Case Reg_String: Reg_SetKeyValue = RegSetValueExString(hKey, sValueName, 0&, Reg_String, CStr(vValue & Chr$(0)), CLng(Len(vValue) + 1))
Case Reg_Dword: Reg_SetKeyValue = RegSetValueExLong(hKey, sValueName, 0&, Reg_Dword, CLng(vValue), 4)
End Select
RegCloseKey (hKey) 'close the key
End Function
Reply With Quote