'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
