SetRegistryValue
"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 RegSetValueEx Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, _
ByVal cbData As Long) As Long
Const KEY_WRITE = &H20006
Const REG_SZ = 1
Const REG_BINARY = 3
Const REG_DWORD = 4
' Zapíše nebo vytvoří hodnotu v Registru
' vrací True pokud je operace úspěšná
Function SetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String, value As Variant) As Boolean
Dim handle As Long
Dim lngValue As Long
Dim strValue As String
Dim binValue() As Byte
Dim length As Long
Dim retVal As Long
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then
Exit Function
End If
Select Case VarType(value)
Case vbInteger, vbLong
lngValue = value
retVal = RegSetValueEx(handle, ValueName, 0, _
REG_DWORD, lngValue, 4)
Case vbString
strValue = value
retVal = RegSetValueEx(handle, ValueName, 0, _
REG_SZ, ByVal strValue, Len(strValue))
Case vbArray + vbByte
binValue = value
length = UBound(binValue) - LBound(binValue) + 1
retVal = RegSetValueEx(handle, ValueName, 0, _
REG_BINARY, binValue(LBound(binValue)), length)
Case Else
RegCloseKey handle
Err.Raise 1001, , "Nepodporovaný typ hodnoty"
End Select
RegCloseKey handle
SetRegistryValue = (retVal = 0)
End Function