GetRegistryValue
"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 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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, source As Any, ByVal numBytes As Long)
Const KEY_READ = &H20019 ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
' SYNCHRONIZE))
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234
' NaΦte hodnotu z registru
'
' KeyName = "" je pro vrßcenφ defaultnφ hodnoty
' Podporuje DWORD, REG_SZ, REG_EXPAND_SZ, REG_BINARY a REG_MULTI_SZ
Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String, _
Optional DefaultValue As Variant) As Variant
Dim handle As Long
Dim resLong As Long
Dim resString As String
Dim resBinary() As Byte
Dim length As Long
Dim retVal As Long
Dim valueType As Long
GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
Exit Function
End If
length = 1024
ReDim resBinary(0 To length - 1) As Byte
retVal = RegQueryValueEx(handle, ValueName, 0, _
valueType, resBinary(0), length)
If retVal = ERROR_MORE_DATA Then
ReDim resBinary(0 To length - 1) As Byte
retVal = RegQueryValueEx(handle, ValueName, 0, _
valueType, resBinary(0), length)
End If
Select Case valueType
Case REG_DWORD
CopyMemory resLong, resBinary(0), 4
GetRegistryValue = resLong
Case REG_SZ, REG_EXPAND_SZ
resString = Space$(length - 1)
CopyMemory ByVal resString, resBinary(0), length - 1
GetRegistryValue = resString
Case REG_BINARY
If length <> UBound(resBinary) + 1 Then
ReDim Preserve resBinary(0 To length - 1) As Byte
End If
GetRegistryValue = resBinary()
Case REG_MULTI_SZ
resString = Space$(length - 2)
CopyMemory ByVal resString, resBinary(0), length - 2
GetRegistryValue = resString
Case Else
RegCloseKey handle
Err.Raise 1001, , "Nepodporovan² typ hodnoty"
End Select
RegCloseKey handle
End Function