Solved: How do i store a REG_MULTI_SZ value to the registry?

hes

Here is an example

http://www.vbbox.com/codebox/code/src/cregistry.cls

danelroisman

ASKER

Example?? Of what????

chris_matthews

BUNG THE FOLOWING CODE INTO A MODULE

' API declares
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 RegQueryValueExString 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
Private 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
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

' constants
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const ERROR_BADKEY = 1010&
Private Const REG_SZ = 1
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Public Const KEY_PATH = "Software\CBSL\QuickIndexer"

Private Function openKey(Optional bCurrentUser As Boolean = True, Optional strPath As String = "") As Long
Dim lKey As Long
Dim lReturn As Long
Dim hKey As Long ' handle to the open reg

' choose whether it's local machine or current user
If bCurrentUser Then
lKey = HKEY_CURRENT_USER
Else
lKey = HKEY_LOCAL_MACHINE
End If

' open the key
lReturn = RegOpenKeyEx(lKey, KEY_PATH & strPath, 0, KEY_ALL_ACCESS, hKey)

' if not success then try and create
If lReturn <> 0 Then
RegCreateKeyEx lKey, KEY_PATH & strPath, 0&, vbNullString, 0, KEY_ALL_ACCESS, 0&, hKey, lReturn
End If

' return the handle
openKey = hKey
End Function

'Gets a string from the registry
Public Function getString(sTag As String, sDefault As String, Optional bCurrentUser As Boolean = True, Optional strPath As String = "") As String
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim sValue As String
Dim lValueLen As Long

' create space for result
sValue = String$(256, " ")
lValueLen = Len(sValue)

' open key and query value
hKey = openKey(bCurrentUser, strPath)
lRetVal = RegQueryValueExString(hKey, sTag, 0&, REG_SZ, sValue, lValueLen)

' check result to see if it exists...
If lRetVal <> 0 Then
getString = sDefault
Else
If lValueLen > 0 Then
getString = CStr(Left$(sValue, lValueLen - 1))
Else
getString = ""
End If
End If

' close key
RegCloseKey (hKey)
End Function

'Puts a string into the registry
Public Sub putString(sTag As String, sValue As String, Optional bCurrentUser As Boolean = True, Optional strPath As String = "")
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key

' open the specified key
hKey = openKey(bCurrentUser, strPath)

' write value
lRetVal = RegSetValueExString(hKey, sTag, 0&, REG_SZ, sValue, Len(sValue))

' close key
RegCloseKey (hKey)
End Sub

THEN CALL THE FUNCTIONS AS SHOWN BELOW:-

'set end value to true or false puts it into local or user in reg
modGeneral.putString ("NameInReg",StringToSave,TRUE)

StringFromReg= modGeneral.getString("NameInReg,"",TRUE)

hope that helps

Chris

danelroisman

ASKER

Ok, but what about a REG_MULTI_SZ type? (Not REG_SZ !!!)
:))

twalgrave

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!

No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in Community Support that this question is:
- PAQ/refund
Please leave any comments here within the
next seven days.

miguelito92

The following VB Module allows you to Read and Write REG_MULTI_SZ registry values.

Example:

Dim aStrings() As String
Dim lngRet As Long, lngIndex As Long

Redim aStrings(0 to 2)

aStrings(0) = "String1"
aStrings(1) = "String2"
aStrings(2) = "String3"

'---> Write the Multi String Value
lngRet = SetValue(HKEY_LOCAL_MACHINE, "Software\MyApp", "MultiStringValue", aStrings)

'---> Read the Multi String Value
aStrings = GetValue(HKEY_LOCAL_MACHINE, "Software\MyApp", "MultiStringValue", Split(""))

For lngIndex = 0 To UBound(aStrings)

Debug.Print aStrings(lngIndex)

Next

'--------------------------------------------------------
'----------------Registry Functions----------------------
'--------------------------------------------------------
Option Explicit

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 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 Any) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueExStr Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegQueryValueExByte Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
Private 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 Any) As Long
Private 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, ByVal lpData As Long, ByVal lpcbData As Long) As Long

Public Enum HKEY_ROOT
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum

Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK
Const ERROR_SUCCESS = 0&
Const ERROR_NO_MORE_ITEMS = 259
Const ERROR_MORE_DATA = 234

Const REG_NONE = 0
Const REG_EXPAND_SZ = 2
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6

Public Enum ENUM_TYPES
REG_ALL = 0
REG_BINARY = 3
REG_DWORD = 4
REG_SZ = 1
REG_MULTI_SZ = 7
End Enum

Const REG_OPTION_NON_VOLATILE = &H0

Public Function KeyExists(ByVal Root As HKEY_ROOT, ByVal Key As String) As Boolean
Dim lngResult As Long, hKey As Long

lngResult = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey)

If lngResult = ERROR_SUCCESS Then

Call RegCloseKey(hKey)
KeyExists = True

Else

KeyExists = False

End If

End Function

Public Function CreateKey(ByVal Root As HKEY_ROOT, ByVal Key As String) As Long
Dim lngResult As Long, hKey As Long, lngBack As Long

lngResult = RegCreateKeyEx(Root, Key, 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, lngBack)

CreateKey = lngResult

If lngResult = ERROR_SUCCESS Then lngResult = RegFlushKey(hKey)

If lngResult = ERROR_SUCCESS Then Call RegCloseKey(hKey)

End Function

Public Function DeleteKey(ByVal Root As HKEY_ROOT, ByVal Key As String) As Long

DeleteKey = RegDeleteKey(Root, Key)

End Function

Public Function EnumKeys(ByVal Root As HKEY_ROOT, ByVal Key As String) As String()
Dim lngRet As Long, hKey As Long, lngPos As Long
Dim lngBuffSize As Long, lngIndex As Long, lngKeyCount As Long
Dim strBuffer As String
Dim aKeys() As String

On Error GoTo Error

lngKeyCount = 0
ReDim aKeys(0 To 0)

lngIndex = 0

lngRet = RegOpenKeyEx(Root, Key, 0, KEY_ENUMERATE_SUB_KEYS, hKey)

Do While lngRet = ERROR_SUCCESS

strBuffer = String(255, 0)
lngBuffSize = Len(strBuffer)

lngRet = RegEnumKey(hKey, lngIndex, strBuffer, lngBuffSize)

If (lngRet = ERROR_SUCCESS) Then

lngKeyCount = lngKeyCount + 1

ReDim Preserve aKeys(0 To lngKeyCount) As String

lngPos = InStr(strBuffer, Chr$(0))

If (lngPos > 0) Then

aKeys(lngKeyCount) = Left(strBuffer, lngPos - 1)

Else

aKeys(lngKeyCount) = Left(strBuffer, lngBuffSize)

End If

End If

lngIndex = lngIndex + 1

Loop

If (hKey <> 0) Then RegCloseKey hKey

EnumKeys = aKeys

Exit Function

Error:

If (hKey <> 0) Then RegCloseKey hKey

Exit Function

End Function

Public Function SetValue(Root As HKEY_ROOT, Key As String, ValueName As String, Value As Variant) As Long
Dim Result As Long, hKey As Long, lngValue As Long, lngRet As Long
Dim FoundNullChars As Boolean
Dim strValue As String
Dim aTemp() As Byte

If Not KeyExists(Root, Key) Then

lngRet = CreateKey(Root, Key)

If lngRet <> 0 Then

SetValue = lngRet

GoTo Error

End If

End If

Result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey)

If Result = ERROR_SUCCESS Then

Select Case VarType(Value)
Case vbInteger, vbLong

lngValue = CLng(Value)

Result = RegSetValueExLong(hKey, ValueName, 0, REG_DWORD, lngValue, 4)

Case vbArray + vbByte

aTemp = Value

Result = RegSetValueExByte(hKey, ValueName, 0, REG_BINARY, aTemp(0), UBound(aTemp) + 1)

Case vbArray + vbString

strValue = Join(Value, Chr(0)) & Chr(0)

Result = RegSetValueExStr(hKey, ValueName, 0, REG_MULTI_SZ, strValue, Len(strValue) + 1)

Case vbString

strValue = CStr(Value)

Result = RegSetValueExStr(hKey, ValueName, 0, REG_SZ, strValue, Len(strValue) + 1)

End Select

Result = RegCloseKey(hKey)

End If

SetValue = Result

Error:
End Function

Public Function GetValue(Root As HKEY_ROOT, Key As String, ValueName As String, Default As Variant) As Variant
Dim lngRet As Long, hKey As Long, dwType As Long, lngValue As Long, lngLength As Long
Dim strBuffer As String
Dim aString() As String, aByte() As Byte

lngRet = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey)

If lngRet = ERROR_SUCCESS Then

lngRet = RegQueryValueEx(hKey, ValueName, 0&, dwType, ByVal 0&, lngLength)

If lngRet = ERROR_SUCCESS Then

Select Case dwType
Case REG_BINARY

ReDim aByte(0 To lngLength - 1)

lngRet = RegQueryValueExByte(hKey, ValueName, 0&, dwType, aByte(0), lngLength)

If lngRet = ERROR_SUCCESS Then

GetValue = aByte

Else

GetValue = Default

End If

Case REG_SZ

strBuffer = Space(lngLength + 1)

lngRet = RegQueryValueEx(hKey, ValueName, 0&, dwType, ByVal strBuffer, lngLength)

If lngRet = ERROR_SUCCESS Then

If InStr(1, strBuffer, Chr(0)) <> 0 Then

strBuffer = Left(strBuffer, InStr(1, strBuffer, Chr(0)) - 1)

End If

GetValue = strBuffer

Else

GetValue = Default

End If

Case REG_DWORD

lngRet = RegQueryValueEx(hKey, ValueName, 0&, dwType, lngValue, lngLength)

If lngRet = ERROR_SUCCESS Then

GetValue = lngValue

Else

GetValue = Default

End If

Case REG_MULTI_SZ

strBuffer = Space(lngLength + 1)

lngRet = RegQueryValueEx(hKey, ValueName, 0&, dwType, ByVal strBuffer, lngLength)

strBuffer = Left(strBuffer, InStr(1, strBuffer, Chr(0) & Chr(0)) - 1)

aString = Split(strBuffer, Chr(0))

If lngRet = ERROR_SUCCESS Then

GetValue = aString

Else

GetValue = Default

End If

End Select

Else

GetValue = Default

End If

End If

If lngRet = ERROR_SUCCESS Then lngRet = RegCloseKey(hKey)

End Function

Public Function DeleteValue(ByVal Root As HKEY_ROOT, ByVal Key As String, ByVal ValueName As String) As Long
Dim lngRet As Long, hKey As Long

lngRet = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey)

If lngRet = ERROR_SUCCESS Then

lngRet = RegDeleteValue(hKey, ValueName)
lngRet = RegCloseKey(hKey)

End If

DeleteValue = lngRet

End Function

Public Function EnumValues(Root As HKEY_ROOT, Key As String, DataType As ENUM_TYPES) As String()
Dim lngRet As Long, hKey As Long, lngIndex As Long, lngDummy As Long, lngMaxName As Long
Dim lngValueType As Long, lngValueCount As Long
Dim curLastWriteTime As Currency
Dim strBuffer As String
Dim aValueNames() As String

On Error GoTo Error

lngValueCount = 0
ReDim aValueNames(0 To 0)

lngIndex = 0

lngRet = RegOpenKeyEx(Root, Key, 0, KEY_QUERY_VALUE, hKey)

If lngRet = ERROR_SUCCESS Then

lngRet = RegQueryInfoKey(hKey, "", lngDummy, 0, lngDummy, lngDummy, lngDummy, lngDummy, lngMaxName, lngDummy, lngDummy, curLastWriteTime)

If lngRet = 0 Then

Do

lngValueType = 0
lngMaxName = 255
strBuffer = String(lngMaxName, 0)

lngRet = RegEnumValue(hKey, lngIndex, strBuffer, lngMaxName, 0&, lngValueType, 0&, 0&)

If lngRet = ERROR_SUCCESS And (lngValueType = DataType Or DataType = 0) Then

strBuffer = Left(strBuffer, lngMaxName)

lngValueCount = lngValueCount + 1
ReDim Preserve aValueNames(0 To lngValueCount)
aValueNames(lngValueCount) = strBuffer

End If

lngIndex = lngIndex + 1

Loop While lngRet = ERROR_MORE_DATA Or lngRet = 0

End If

End If

If hKey <> 0 Then RegCloseKey hKey

EnumValues = aValueNames

Exit Function

Error:

If hKey <> 0 Then RegCloseKey hKey

End Function