a_padwal
asked on
How to set key values
I want to change key value in registry.
I want to change dsn data source at run time. for which I have to change registry key. I know the following functions but they gave error saying ‘Type Mismatch’.
Code, which I have written
'Lresult = RegSetValueEx (HKEY_CURRENT_USER, "\ Software \ ODBC \ ODBC.INI \ BVPReg\DBQ", 0&, REG_SZ, Text1.Text, l)
Lresult = RegSetValue (HKEY_CURRENT_USER, "\ Software \ ODBC \ ODBC.INI \ BVPReg", DBQ, REZ_SZ, Text1.Text)
I am passing following arguments
In registry key is - HEY_CURRENT_USER, "\ Software \ ODBC \ ODBC.INI \ BVPReg
Key Name - DBQ
Value Type - String
Value - “c:\test.mdb”
Can any one tell me how to use these functions?
I want to change dsn data source at run time. for which I have to change registry key. I know the following functions but they gave error saying ‘Type Mismatch’.
Code, which I have written
'Lresult = RegSetValueEx (HKEY_CURRENT_USER, "\ Software \ ODBC \ ODBC.INI \ BVPReg\DBQ", 0&, REG_SZ, Text1.Text, l)
Lresult = RegSetValue (HKEY_CURRENT_USER, "\ Software \ ODBC \ ODBC.INI \ BVPReg", DBQ, REZ_SZ, Text1.Text)
I am passing following arguments
In registry key is - HEY_CURRENT_USER, "\ Software \ ODBC \ ODBC.INI \ BVPReg
Key Name - DBQ
Value Type - String
Value - “c:\test.mdb”
Can any one tell me how to use these functions?
egsemsem, did you even read his question or did you just see "registry" and then pull some code from the net?
a_padwal,
Try this, I use it all the time. It should work for you.
It makes sure you have access to the key before you try to change it. I have never had any problems.
If you have any problems post.
Cheers,
Ed.
-------------------------- ---------- ---------- ---------- --------
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const REG_TYPE_STRING As Long = 1
Public Const REG_TYPE_DWORD As Long = 1
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Private Const HKEY_CLASSES_ROOT_NAME = "HKEY_CLASSES_ROOT"
Private Const HKEY_CURRENT_USER_NAME = "HKEY_CURRENT_USER"
Private Const HKEY_LOCAL_MACHINE_NAME = "HKEY_LOCAL_MACHINE"
Private Const HKEY_USERS_NAME = "HKEY_USERS"
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0
Public Type tReturnValues
lvReturnValue As Variant
llErrorStatus As Long
End Type
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
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
'Returns 0 if the Save was successful.
Public Reg_Ret_Val As Long
Public Function SetValueKey(psRootKey As String, psKeyName As String, psValueName As String, pvValueSetting As Variant, plValueType As Long) As Long
Dim llRetVal As Long 'result of the SetValueEx function
Dim lhKey As Long 'handle of open key
Dim llRootKey As Long
'Find the root key
llRootKey = GetRootKey(psRootKey)
'set return value prior to errors
SetValueKey = ERROR_NONE
'open the specified key
llRetVal = RegOpenKeyEx(llRootKey, psKeyName, 0, KEY_ALL_ACCESS, lhKey)
If llRetVal <> 0 Then
'an error has occurred
SetValueKey = llRetVal
Exit Function
End If
'write the value
llRetVal = SetValueEx(lhKey, psValueName, plValueType, pvValueSetting)
If llRetVal <> 0 Then
'an error has occurred
SetValueKey = llRetVal
Exit Function
End If
'Close the specified key
RegCloseKey (lhKey)
End Function
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
Private Sub Command1_Click()
Reg_Ret_Val = SetValueKey("HKEY_CURRENT_ USER", "Software\ODBC\ODBC.INI\BV PReg", "DBQ", Text1.Text, REG_TYPE_STRING)
End Sub
Try this, I use it all the time. It should work for you.
It makes sure you have access to the key before you try to change it. I have never had any problems.
If you have any problems post.
Cheers,
Ed.
--------------------------
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const REG_TYPE_STRING As Long = 1
Public Const REG_TYPE_DWORD As Long = 1
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Private Const HKEY_CLASSES_ROOT_NAME = "HKEY_CLASSES_ROOT"
Private Const HKEY_CURRENT_USER_NAME = "HKEY_CURRENT_USER"
Private Const HKEY_LOCAL_MACHINE_NAME = "HKEY_LOCAL_MACHINE"
Private Const HKEY_USERS_NAME = "HKEY_USERS"
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0
Public Type tReturnValues
lvReturnValue As Variant
llErrorStatus As Long
End Type
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
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
'Returns 0 if the Save was successful.
Public Reg_Ret_Val As Long
Public Function SetValueKey(psRootKey As String, psKeyName As String, psValueName As String, pvValueSetting As Variant, plValueType As Long) As Long
Dim llRetVal As Long 'result of the SetValueEx function
Dim lhKey As Long 'handle of open key
Dim llRootKey As Long
'Find the root key
llRootKey = GetRootKey(psRootKey)
'set return value prior to errors
SetValueKey = ERROR_NONE
'open the specified key
llRetVal = RegOpenKeyEx(llRootKey, psKeyName, 0, KEY_ALL_ACCESS, lhKey)
If llRetVal <> 0 Then
'an error has occurred
SetValueKey = llRetVal
Exit Function
End If
'write the value
llRetVal = SetValueEx(lhKey, psValueName, plValueType, pvValueSetting)
If llRetVal <> 0 Then
'an error has occurred
SetValueKey = llRetVal
Exit Function
End If
'Close the specified key
RegCloseKey (lhKey)
End Function
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
Private Sub Command1_Click()
Reg_Ret_Val = SetValueKey("HKEY_CURRENT_
End Sub
The code in the original question doesn't match the API declarations correctly for "RegSetValue":
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
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
The last parameter is a Long not "Text1.Text" (ie potentially string/variant). Presumably the other variables have been declard appropriately as well (DBQ, REG_SZ).
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
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
The last parameter is a Long not "Text1.Text" (ie potentially string/variant). Presumably the other variables have been declard appropriately as well (DBQ, REG_SZ).
ASKER
Elmo
it is giving undeclare function for 'RegCloseKey (lhKey)'
it is giving undeclare function for 'RegCloseKey (lhKey)'
a_padwal,
Sorry about that. I must of fogot to add it in.
Add this in and try again.
If you have any more problems, just post.
Cheers,
Ed.
-------------------------- ---------- ----------
Declare Function RegCloseKey _
Lib "advapi32.dll" _
(ByVal hKey As Long) _
As Long
Sorry about that. I must of fogot to add it in.
Add this in and try again.
If you have any more problems, just post.
Cheers,
Ed.
--------------------------
Declare Function RegCloseKey _
Lib "advapi32.dll" _
(ByVal hKey As Long) _
As Long
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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 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
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
'close the key
RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub
Private Sub Command1_Click()
Dim strString As String
'Ask for a value
strString = InputBox("Please enter a value between 0 and 255 to be saved as a binary value in the registry.", App.Title)
If strString = "" Or Val(strString) > 255 Or Val(strString) < 0 Then
MsgBox "Invalid value entered ...", vbExclamation + vbOKOnly, App.Title
Exit Sub
End If
'Save the value to the registry
SaveStringLong HKEY_CURRENT_USER, "KPD-Team", "BinaryValue", CByte(strString)
End Sub
Private Sub Command2_Click()
'Get a string from the registry
Ret = GetString(HKEY_CURRENT_USE
If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
MsgBox "The value is " + Ret, vbOKOnly + vbInformation, App.Title
End Sub
Private Sub Command3_Click()
'Delete the setting from the registry
DelSetting HKEY_CURRENT_USER, "KPD-Team", "BinaryValue"
MsgBox "The value was deleted ...", vbInformation + vbOKOnly, App.Title
End Sub
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Command1.Caption = "Set Value"
Command2.Caption = "Get Value"
Command3.Caption = "Delete Value"
End Sub