VB6 writing to the registry

Hello,

I've looked around the net for registry writing and all I could find was alot of code.
 i would use savesetting but i want to write to HKLM and HKCU.

Does anyone know short syntax?

Cheers
Chris
LVL 1
RickardcAsked:
Who is Participating?
 
bochgochCommented:
Sorry, forgot about setting values.....

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

Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const KEY_QUERY_VALUE = &H1
Const regkey2 As String = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\0"
retval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, regkey2, 0, KEY_QUERY_VALUE, keyid)
retVal = SetValueEx(keyid, "1001", REG_DWORD, yourvalue)

Hope you can take it from there....
0
 
bochgochCommented:
Don't think there is a 'short' way, however, cut and paste is easy.....

WACK THIS IN YOU DECLARATIONS:
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
Long, lpcbData As Long) As Long

Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData 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 RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

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

CREATE THIS FUNCTION WHERE-EVER YOU FANCY:
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    Const REG_SZ As Long = 1
    Const REG_DWORD As Long = 4
   
    Const HKEY_CLASSES_ROOT = &H80000000
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS = &H80000003
   
    Const ERROR_NONE = 0
    Const ERROR_BADDB = 1
    Const ERROR_BADKEY = 2
    Const ERROR_CANTOPEN = 3
    Const ERROR_CANTREAD = 4
    Const ERROR_CANTWRITE = 5
    Const ERROR_OUTOFMEMORY = 6
    Const ERROR_ARENA_TRASHED = 7
    Const ERROR_ACCESS_DENIED = 8
    Const ERROR_INVALID_PARAMETERS = 87
    Const ERROR_NO_MORE_ITEMS = 259
   
    Const KEY_QUERY_VALUE = &H1
    Const KEY_SET_VALUE = &H2
    Const KEY_ALL_ACCESS = &H3F
   
    Const REG_OPTION_NON_VOLATILE = 0
   
    ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5
   
    Select Case lType
        ' For strings
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
            sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch - 1)
            Else
                vValue = Empty
            End If
        ' For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
             If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'all other data types not supported
            lrc = -1
    End Select
   
QueryValueExExit:
    QueryValueEx = lrc
    Exit Function

QueryValueExError:
    Resume QueryValueExExit
End Function

THEN CALL LIKE THIS:
    Const HKEY_LOCAL_MACHINE As Long = &H80000002
    Const KEY_QUERY_VALUE = &H1
    Const regkey2 As String = "SOFTWARE\VB and VBA Program Settings\my_prog\sqlserver"
    retval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, regkey2, 0, KEY_QUERY_VALUE, keyid)
    retval = QueryValueEx(keyid, "ServerName", Server)

Go on try it.....
0
 
RickardcAuthor Commented:
thanks,

I want to change the value of 4 keys:

HKEY_CURRENT_USER,
 "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\0" 1001 and 1004


 HKEY_LOCAL_MACHINE
 "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\0" 1001 and 1004

 HKEY_CURRENT_USER,
 "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3" 1001 and 1004

 HKEY_LOCAL_MACHINE
 "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3"  1001 and 1004

cheers
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.