Registry Simple

'REGISTRY



'This program needs 3 Command Buttons

Const REG_SZ = 1

Const REG_EXPAND_SZ = 2

Const REG_BINARY = 3

Const REG_DWORD = 4

Const REG_DWORD_BIG = 5

Const REG_LINK = 6

Const REG_MULTI_SZ = 7



Enum Key_Reg

HKEY_CLASSES_ROOT = &H80000000

HKEY_CURRENT_USER = &H80000001

HKEY_LOCAL_MACHINE = &H80000002

HKEY_USERS = &H80000003

HKEY_CURRENT_CONFIG = &H80000005

End Enum



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
Key_Reg, _

ByVal strValueName As String) As String

Dim lResult, lValueType, lDataBufSize As Long

Dim strBuf As String



'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
Key_Reg, 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
Key_Reg, 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
Key_Reg, 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_SZ, _

CByte(strData), 4

'close the key

RegCloseKey Ret

End Sub



Sub DelSetting(hKey As Key_Reg, 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()

'Save the value to the registry

SaveStringLong HKEY_CURRENT_USER, "RockessAlpha", "StringValue", _

CByte("123")

End Sub



Private Sub Command2_Click()

'Get a string from the registry

Ret = GetString(HKEY_CURRENT_USER, "RockessAlpha", "StringValue")

If Ret = "" Then MsgBox "No value found !", _

vbExclamation + vbOKOnly, "RockessAlpha.blogspot.com":
Exit Sub

MsgBox "The value is  " + Ret, _

vbOKOnly + vbInformation, "RockessAlpha.blogspot.com"

End Sub



Private Sub Command3_Click()

'Delete the setting from the registry

DelSetting HKEY_CURRENT_USER, "RockessAlpha", "StringValue"

MsgBox "The value was deleted ...", _

vbInformation + vbOKOnly, "RockessAlpha.blogspot.com"

End Sub



Private Sub Form_Load()

Command1.Caption = "Set Value"

Command2.Caption = "Get Value"

Command3.Caption = "Delete Value"

End Sub