SetRegistryValue

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 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

Zp∞t

Autor: The Bozena