Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public 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 As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long

Public 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Public 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const HKEY_CURRENT_USER = &H80000001
Public Const KEY_WRITE = &H20006
Public Const KEY_READ = &H20019


'Put 6 labels, 1 textbox ,1 combobox and 2 button.Write down the codes belom on the form

Private Sub Command1_Click()
Dim hregkey As Long
Dim secattr As SECURITY_ATTRIBUTES
Dim neworused As Long
Dim stringbuffer As String
Dim slength As Long
Dim retval As Long
subkey = "\Software\MyCorp\MyProgram\Config"
secattr.nLength = Len(secattr)
secattr.lpSecurityDescriptor = 0
secattr.bInheritHandle = True
retval = RegCreateKeyEx(HKEY_CURRENT_USER, subkey, 0, "", 0, KEY_WRITE, secattr, hregkey, neworused)
If retval <> 0 Then
Debug.Print "Error opening or creating registry key ---aborting"
End
End If
stringbuffer = Trim(Text2.Text) & vbNullChar
retval = RegSetValueEx(hregkey, Trim(Combo1.Text), 0, REG_SZ, ByVal stringbuffer, Len(stringbuffer))
retval = RegCloseKey(hregkey)
End Sub
Private Sub Command2_Click()
Dim hregkey As Long
Dim secattr As SECURITY_ATTRIBUTES
Dim neworused As Long
Dim stringbuffer As String
Dim slength As Long
Dim retval As Long
subkey = "\Software\MyCorp\MyProgram\Config"
secattr.nLength = Len(secattr)
secattr.lpSecurityDescriptor = 0
secattr.bInheritHandle = True
retval = RegCreateKeyEx(HKEY_CURRENT_USER, subkey, 0, "", 0, KEY_READ, secattr, hregkey, neworused)
If retval <> 0 Then
Debug.Print "Error opening or creating registry key ---aborting"
End
End If
stringbuffer = Space(255)
slength = 255
retval = RegQueryValueEx(hregkey, Trim(Combo1.Text), 0, REG_SZ, ByVal stringbuffer, slength)
stringbuffer = Left(stringbuffer, slength)
If retval <> 0 Then
MsgBox "Sorry No Value Name Like That ", , "Warning"
Else
MsgBox Combo1.Text & " :::> " & stringbuffer, , "Result"
End If
retval = RegCloseKey(hregkey)
End Sub

Private Sub Form_Load()
Command1.Caption = "Create Value In System Registry"
Command2.Caption = "Read Value From System Registry"
Label3.Caption = "Handle Key"
Label3.Font = "Arial"
Label3.FontSize = 12
Label3.FontBold = True
Label4.Caption = "HKEY_CURRENT_USER"
Label4.Font = "Arial"
Label4.FontSize = 12
Label4.FontBold = True
Label4.BackColor = &H80000009
Label4.BorderStyle = 1
Label5.Caption = "Sub Key"
Label5.Font = "Arial"
Label5.FontSize = 12
Label5.FontBold = True
Label6.Caption = "\Software\MyCorp\MyProgram\Config"
Label6.Font = "Arial"
Label6.FontSize = 12
Label6.FontBold = True
Label6.BackColor = &H80000009
Label6.BorderStyle = 1
Label1.Caption = "Value Name"
Label1.Font = "Arial"
Label1.FontSize = 12
Label1.FontBold = True
With Combo1
.Text = ""
.Font = "Arial"
.FontBold = True
.FontSize = 12
.AddItem "Name ", 0
.AddItem "Address", 1
.AddItem "Job", 2
.AddItem "Salary", 3
.AddItem "Social Security No.", 4
.AddItem "Children ", 5
.AddItem "Status", 6
.ListIndex = 0
End With
Label2.Caption = "Value Data"
Label2.Font = "Arial"
Label2.FontSize = 12
Label2.FontBold = True
Text2.Text = ""
Text2.Font = "Arial"
Text2.FontSize = 12
Text2.FontBold = True
End Sub