vb6 write registry key and value

'---registry export text begin

Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Keyboard Layouts\E0200407]
"Ime File"="Abc.IME"
"Layout Text"="Test Message"
"Layout File"="kbdus.dll"

'----registry export text end

Hello ,

how to use vb6 code to write registry key
for example
 write key "E0200407" to
 HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Keyboard Layouts

and then write value of
[HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Keyboard Layouts\E0200407]
like below

"Ime File"="Abc.IME"
"Layout Text"="Test Message"
"Layout File"="kbdus.dll"

Thanks
dayproAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Brook BraswellApplication Development ManagerCommented:
Here is an example of code for writing to the registry.

It is used in this case for fixing a problem in Crystal Reports but you can make it what you need.
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _
    ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, ByRef phkResult As Long) As Long


Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long


Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
    ' Note that if you declare the lpData parameter as String
    ' in RegSetValueEx, you must pass it ByVal.


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


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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" ( _
    ByVal hKey As Long, ByVal lpSubKey As String) As Long


Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_WRITE = &H20006
Public Const KEY_ALL_ACCESS = &H2003F
Public Const KEY_READ = _
((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
' Registry location
Public Const gREGKEYLocation = "SOFTWARE\Business Objects\Suite 11.0\Crystal Reports\Export\PDF"

Public Const gREGKEYFonts = "ForceLargerFonts"
Public Const gREGKEYXPos = "XPos"
Public Const gREGKEYYPos = "YPos"
Public Const gREGKEYWidth = "Width"
Public Const gREGKEYHeight = "Height"
Public Const gREGKEYWindowState = "WindowState"
Public Const ERROR_SUCCESS = 0&

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
                Dim iErr As Integer
                Dim i As Long
                Dim rc As Long
                Dim hKey As Long
                Dim KeyValType As Long
                Dim tmpVal As String
                Dim KeyValSize As Long
                Dim Attempts As Single
10              iErr = 0
20              On Error GoTo PROC_ERR
30              Attempts = 0
TryAgain:
40              If Attempts > 3 Then GoTo JustForgetIt
50              rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
60              If (rc <> ERROR_SUCCESS) Then
70                 If CreateCrystalHack(KeyRoot, KeyName, SubKeyRef, KeyVal) Then
80                    Attempts = Attempts + 1
90                    GoTo TryAgain
100                Else
110                   GoTo GetKeyError
120                End If
130             End If
140             tmpVal = String$(1024, 0)
150             KeyValSize = 1024
160             rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)
170             If (rc <> ERROR_SUCCESS) Then
180                If CreateCrystalHack(KeyRoot, KeyName, SubKeyRef, KeyVal) Then
190                   Attempts = Attempts + 1
200                   GoTo TryAgain
210                Else
220                   GoTo GetKeyError
230                End If
240             End If
JustForgetIt:
250             If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
260                tmpVal = Left(tmpVal, KeyValSize - 1)
270             Else
280                tmpVal = Left(tmpVal, KeyValSize)
290             End If
300             Select Case KeyValType
                Case REG_DWORD
310                For i = Len(tmpVal) To 1 Step -1
320                   KeyVal = KeyVal + Format(Hex(Asc(Mid(tmpVal, i, 1))), "00")
330                Next
340                KeyVal = Format$("&h" + KeyVal)
350             Case REG_SZ
360                KeyVal = tmpVal
370             End Select
380             GetKeyValue = True
390             rc = RegCloseKey(hKey)
400             Exit Function
GetKeyError:
410             GetKeyValue = False
420             rc = RegCloseKey(hKey)
PROC_EXIT:
430             Exit Function
PROC_ERR:
440             If iErr > 3 Then
450                ' LOG YOUR ERROR
460                Resume PROC_EXIT
470             Else
480                iErr = iErr + 1
490                Resume
500             End If
     
End Function

Public Sub SetRegistryKeys()
           Dim iErr As Integer
10         iErr = 0
20         On Error GoTo PROC_ERR
30         Exit Sub
''''    Dim strF1Prefixes$, strF1PrefixesEnabled$
''''    'Deletes the entire key so it can re-write it. This is an easy way
''''    'to manage values that may need to be saved with less data. For
''''    'example, if an MRU list upon opening the app has 4 entries, and
''''    'when the app is closed only has three, you don't need to worry about
''''    'determining if there is one extra in the registry and deleting it.
''''
''''    DeleteRegKey gREGKEYLocation
''''
''''    'If the window is minimized, then set it to a normal size before saving.
''''    'This way it will not be opened in a minimized state.
'''''''    If frmMain.WindowState = vbMinimized Then frmMain.WindowState = vbNormal
''''
''''    'Save the windowstate to the registry
''''    SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYWindowState, frmMain.WindowState
''''
''''    'Put the window at a normal state to set
''''    '     the correct window sizes in the registry
''''    '
'''''''    frmMain.WindowState = vbNormal
''''    'Set all the window positions.
''''
''''
''''    If frmMain.Left >= 0 Then
''''        SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYXPos, frmMain.Left
''''    Else: SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYXPos, 0
''''    End If
''''
''''
''''    If frmMain.Top >= 0 Then
''''        SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYYPos, frmMain.Top
''''    Else: SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYYPos, 0
''''    End If
''''    SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYWidth, frmMain.Width
''''    SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYHeight, frmMain.Height
PROC_EXIT:
40         Exit Sub
PROC_ERR:
50         If iErr > 3 Then
60            ' LOG YOUR ERROR
70            Resume PROC_EXIT
80         Else
90            iErr = iErr + 1
100           Resume
110        End If

End Sub

Public Function CreateCrystalHack(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
                Dim iErr As Integer
                Dim iPOS As Integer
                Dim NewFolder As String
                Dim FoldersCreated As Single
                Dim hKey As Long
                Dim rc As Long
10              iErr = 0
20              On Error GoTo PROC_ERR
30              Call RegCreateKey(KeyRoot, gREGKEYLocation, hKey)
40              CreateCrystalHack = SetKeyValue(KeyRoot, gREGKEYLocation, REG_DWORD, gREGKEYFonts, 1)
'''        iPOS = InStr(1, gREGKEYLocation, "\", vbTextCompare)
'''        Debug.Print gREGKEYLocation
'''        Do While True
'''           iPOS = InStr(iPOS + 1, gREGKEYLocation, "\", vbTextCompare)
'''           If iPOS = 0 Then
'''              NewFolder = gREGKEYLocation
'''           Else
'''              NewFolder = Mid(gREGKEYLocation, 1, iPOS - 1)
'''           End If
'''           FoldersCreated = FoldersCreated + 1
'''           Debug.Print NewFolder
'''           rc = RegOpenKeyEx(KeyRoot, NewFolder, 0, KEY_ALL_ACCESS, hKey)
'''           If (rc <> ERROR_SUCCESS) Then
'''              MsgBox "Folder Creation attempt " & vbCrLf & NewFolder
'''              Call RegCreateKey(KeyRoot, NewFolder, hKey)
'''              MsgBox hKey
'''           Else
'''             ' MsgBox "Folder Existed " & vbCrLf & NewFolder
'''           End If
'''           If iPOS = 0 Then Exit Do
'''        Loop
'''        MsgBox "Key Created " & vbCrLf & gREGKEYLocation
PROC_EXIT:
50              Exit Function
PROC_ERR:
60              If iErr > 3 Then
70                 ' LOG YOUR ERROR
80                 Resume PROC_EXIT
90              Else
100                iErr = iErr + 1
110                Resume
120             End If

End Function

Public Function SetKeyValue(KeyRoot As Long, KeyName As String, lType As Long, SubKeyRef As String, KeyVal As Variant) As Boolean
                Dim iErr As Integer
                Dim rc As Long
                Dim hKey As Long
10              iErr = 0
20              On Error GoTo PROC_ERR
30              rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
40              If (rc <> ERROR_SUCCESS) Then Call RegCreateKey(KeyRoot, KeyName, hKey)
50              Select Case lType
                Case REG_SZ
60                 rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_SZ, ByVal CStr(KeyVal & Chr$(0)), Len(KeyVal))
70              Case REG_BINARY
80                 rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_BINARY, ByVal CStr(KeyVal & Chr$(0)), Len(KeyVal))
90              Case REG_DWORD
100                rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_DWORD, CLng(KeyVal), 4)
110             End Select
120             If (rc <> ERROR_SUCCESS) Then GoTo SetKeyError
130             SetKeyValue = True
140             rc = RegCloseKey(hKey)
150             Exit Function
SetKeyError:
160             KeyVal = ""
170             SetKeyValue = False
180             rc = RegCloseKey(hKey)
PROC_EXIT:
190             Exit Function
PROC_ERR:
200             If iErr > 3 Then
210                ' LOG YOUR ERROR
220                Resume PROC_EXIT
230             Else
240                iErr = iErr + 1
250                Resume
260             End If
     
End Function

Public Function DeleteRegValue(KeyName As String, SubKeyRef As String) As Boolean
                Dim iErr As Integer
                Dim rc As Long
                Dim hKey As Long
10              iErr = 0
20              On Error GoTo PROC_ERR
30              rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, KeyName, 0, KEY_ALL_ACCESS, hKey)
40              If (rc <> ERROR_SUCCESS) Then GoTo DeleteKeyError
50              rc = RegDeleteValue(hKey, SubKeyRef)
60              If (rc <> ERROR_SUCCESS) Then GoTo DeleteKeyError
70              DeleteRegValue = True
80              Exit Function
DeleteKeyError:
90              DeleteRegValue = False
PROC_EXIT:
100             Exit Function
PROC_ERR:
110             If iErr > 3 Then
120                ' LOG YOUR ERROR
130                Resume PROC_EXIT
140             Else
150                iErr = iErr + 1
160                Resume
170             End If
                
End Function

Public Function DeleteRegKey(KeyName As String) As Boolean
                Dim iErr As Integer
                Dim rc As Long
10              iErr = 0
20              On Error GoTo PROC_ERR
                'All sub keys must be deleted for this to work.
                'If you create key under your original key, you
                'need to delete it first.
30              rc = RegDeleteKey(HKEY_LOCAL_MACHINE, KeyName)
40              DeleteRegKey = IIf(rc = ERROR_SUCCESS, True, False)
PROC_EXIT:
50              Exit Function
PROC_ERR:
60              If iErr > 3 Then
70                 ' LOG YOUR ERROR
80                 Resume PROC_EXIT
90              Else
100                iErr = iErr + 1
110                Resume
120             End If
                
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
dayproAuthor Commented:
thanks,but it's to complex for me ,and i have problem to adjust it
to write below registry


can expert give me simple example  code just exactly  how to
write below registry key and value
thanks

[HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Keyboard Layouts\E0200407]
"Ime File"="Abc.IME"
"Layout Text"="Test Message"
"Layout File"="kbdus.dll"

0
Brook BraswellApplication Development ManagerCommented:
I will make this a bit simpler

Copy the code to a new module

Use the SetKeyValue for your registry writing...

Public Sub Set MyKeys()

SetKeyValue HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control\Keyboard Layouts\E0200407",REG_DWORD,"Ime File","Abc.Ime"
SetKeyValue HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control\Keyboard Layouts\E0200407",REG_DWORD,"Layout Text","Test Message"
SetKeyValue HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control\Keyboard Layouts\E0200407",REG_DWORD,"Layout File","kbdus.dll"

End Sub

Open in new window

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _
    ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, ByRef phkResult As Long) As Long


Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long


Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
    ' Note that if you declare the lpData parameter as String
    ' in RegSetValueEx, you must pass it ByVal.


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


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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" ( _
    ByVal hKey As Long, ByVal lpSubKey As String) As Long


Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_WRITE = &H20006
Public Const KEY_ALL_ACCESS = &H2003F
Public Const KEY_READ = _
((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const ERROR_SUCCESS = 0&

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
                Dim iErr As Integer
                Dim i As Long
                Dim rc As Long
                Dim hKey As Long
                Dim KeyValType As Long
                Dim tmpVal As String
                Dim KeyValSize As Long
                Dim Attempts As Single
10              iErr = 0
20              On Error GoTo PROC_ERR
30              Attempts = 0
TryAgain:
40              If Attempts > 3 Then GoTo JustForgetIt
50              rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
140             tmpVal = String$(1024, 0)
150             KeyValSize = 1024
160             rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)
250             If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
260                tmpVal = Left(tmpVal, KeyValSize - 1)
270             Else
280                tmpVal = Left(tmpVal, KeyValSize)
290             End If
300             Select Case KeyValType
                Case REG_DWORD
310                For i = Len(tmpVal) To 1 Step -1
320                   KeyVal = KeyVal + Format(Hex(Asc(Mid(tmpVal, i, 1))), "00")
330                Next
340                KeyVal = Format$("&h" + KeyVal)
350             Case REG_SZ
360                KeyVal = tmpVal
370             End Select
380             GetKeyValue = True
390             rc = RegCloseKey(hKey)
400             Exit Function
GetKeyError:
410             GetKeyValue = False
420             rc = RegCloseKey(hKey)
PROC_EXIT:
430             Exit Function
PROC_ERR:
440             If iErr > 3 Then
450                ' LOG YOUR ERROR
460                Resume PROC_EXIT
470             Else
480                iErr = iErr + 1
490                Resume
500             End If
     
End Function

Public Function SetKeyValue(KeyRoot As Long, KeyName As String, lType As Long, SubKeyRef As String, KeyVal As Variant) As Boolean
                Dim iErr As Integer
                Dim rc As Long
                Dim hKey As Long
10              iErr = 0
20              On Error GoTo PROC_ERR
30              rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
40              If (rc <> ERROR_SUCCESS) Then Call RegCreateKey(KeyRoot, KeyName, hKey)
50              Select Case lType
                Case REG_SZ
60                 rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_SZ, ByVal CStr(KeyVal & Chr$(0)), Len(KeyVal))
70              Case REG_BINARY
80                 rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_BINARY, ByVal CStr(KeyVal & Chr$(0)), Len(KeyVal))
90              Case REG_DWORD
100                rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_DWORD, CLng(KeyVal), 4)
110             End Select
120             If (rc <> ERROR_SUCCESS) Then GoTo SetKeyError
130             SetKeyValue = True
140             rc = RegCloseKey(hKey)
150             Exit Function
SetKeyError:
160             KeyVal = ""
170             SetKeyValue = False
180             rc = RegCloseKey(hKey)
PROC_EXIT:
190             Exit Function
PROC_ERR:
200             If iErr > 3 Then
210                ' LOG YOUR ERROR
220                Resume PROC_EXIT
230             Else
240                iErr = iErr + 1
250                Resume
260             End If
     
End Function

Public Function DeleteRegValue(KeyName As String, SubKeyRef As String) As Boolean
                Dim iErr As Integer
                Dim rc As Long
                Dim hKey As Long
10              iErr = 0
20              On Error GoTo PROC_ERR
30              rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, KeyName, 0, KEY_ALL_ACCESS, hKey)
40              If (rc <> ERROR_SUCCESS) Then GoTo DeleteKeyError
50              rc = RegDeleteValue(hKey, SubKeyRef)
60              If (rc <> ERROR_SUCCESS) Then GoTo DeleteKeyError
70              DeleteRegValue = True
80              Exit Function
DeleteKeyError:
90              DeleteRegValue = False
PROC_EXIT:
100             Exit Function
PROC_ERR:
110             If iErr > 3 Then
120                ' LOG YOUR ERROR
130                Resume PROC_EXIT
140             Else
150                iErr = iErr + 1
160                Resume
170             End If
                
End Function

Public Function DeleteRegKey(KeyName As String) As Boolean
                Dim iErr As Integer
                Dim rc As Long
10              iErr = 0
20              On Error GoTo PROC_ERR
                'All sub keys must be deleted for this to work.
                'If you create key under your original key, you
                'need to delete it first.
30              rc = RegDeleteKey(HKEY_LOCAL_MACHINE, KeyName)
40              DeleteRegKey = IIf(rc = ERROR_SUCCESS, True, False)
PROC_EXIT:
50              Exit Function
PROC_ERR:
60              If iErr > 3 Then
70                 ' LOG YOUR ERROR
80                 Resume PROC_EXIT
90              Else
100                iErr = iErr + 1
110                Resume
120             End If
                
End Function

Open in new window

0
dayproAuthor Commented:
thanks for the help ,i'll try
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

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.