VB读写注册表

Option Explicit

Public Enum ERROR
ERROR_SUCCESS = 0&
ERROR_BADDB = 1009&
ERROR_BADKEY = 1010&
ERROR_CANTOPEN = 1011&
ERROR_CANTREAD = 1012&
ERROR_CANTWRITE = 1013&
ERROR_OUTOFMEMORY = 14&
ERROR_INVALID_PARAMETER = 87&
ERROR_ACCESS_DENIED = 5&
ERROR_NO_MORE_ITEMS = 259&
ERROR_MORE_DATA = 234&
End Enum

Public Enum KEYTYPE
REG_SZ = 1&
REG_EXPAND_SZ = 2&
REG_BINARY = 3
REG_DWORD = 4&
End Enum

Public Enum MAINKEY
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_USERS = &H80000003
End Enum

Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000

Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)

Private Const SYNCHRONIZE = &H100000

Public Enum KEYMODE
KEY_QUERY_VALUE = &H1
KEY_NOTIFY = &H10
KEY_CREATE_LINK = &H20
KEY_CREATE_SUB_KEY = &H4
KEY_ENUMERATE_SUB_KEYS = &H8
KEY_EVENT = &H1     '  Event contains key event record
KEY_SET_VALUE = &H2
KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
End Enum

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private 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
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, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeletevalue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes As Long) As Long
Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long

Public Function GetValue(ByVal hKey As MAINKEY, ByVal subKey As String, ByVal keyItem As String, ByRef keyValue As Variant) As Long
Dim kLength As Long, kBuffer As String * 255, kHandle As Long, kType As Long, kData As Long
Dim rtn As Long
'取得KEY的句柄
rtn = RegOpenKeyEx(hKey, subKey, 0, KEY_READ, kHandle)
If rtn <> ERROR.ERROR_SUCCESS Then
GetValue = rtn
Exit Function
End If

'取得KEY的类型
rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, ByVal 0, kLength)
GetValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If

'根据KEY的类型取值
Select Case kType
Case KEYTYPE.REG_SZ     '字符串
rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, ByVal kBuffer, kLength)
GetValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
keyValue = Left(kBuffer, InStr(kBuffer, Chr(0)) - 1)

Case KEYTYPE.REG_EXPAND_SZ  '字符串
rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, ByVal kBuffer, kLength)
GetValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
keyValue = Left(kBuffer, InStr(kBuffer, Chr(0)) - 1)

Case KEYTYPE.REG_DWORD      '双字
rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, kData, kLength)
GetValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
keyValue = kData
Case KEYTYPE.REG_BINARY     '二进制
rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, kData, kLength)
GetValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
keyValue = kData
End Select
RegCloseKey kHandle
End Function

Public Function DeleteValue(ByVal hKey As MAINKEY, ByVal subKey As String, keyItem As String) As Long
Dim kHandle As Long, rtn As Long
rtn = RegOpenKeyEx(hKey, subKey, 0, KEYMODE.KEY_WRITE, kHandle)
DeleteValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If

rtn = RegDeletevalue(kHandle, keyItem)
DeleteValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If

RegCloseKey kHandle

End Function

Public Function DeleteKey(ByVal hKey As MAINKEY, ByVal subKey As String, ByVal delKey As String) As Long
Dim kHandle As Long, rtn As Long
rtn = RegOpenKeyEx(hKey, subKey, 0, KEYMODE.KEY_WRITE, kHandle)
DeleteKey = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If

rtn = RegDeleteKey(kHandle, delKey)
DeleteKey = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If

RegCloseKey kHandle

End Function

Public Function AddValue(ByVal hKey As MAINKEY, ByVal subKey As String, ByVal KItem As String, ByVal vType As KEYTYPE, ByVal Value As Variant) As Long
Dim kHandle As Long, rtn As Long, cResult As Long

Dim sa As SECURITY_ATTRIBUTES
sa.nLength = Len(sa)
sa.lpSecurityDescriptor = 0
sa.bInheritHandle = True

rtn = RegOpenKeyEx(hKey, subKey, 0, KEYMODE.KEY_WRITE, kHandle)
If rtn <> ERROR.ERROR_SUCCESS Then
rtn = RegCreateKeyEx(hKey, subKey, 0, "", 0, KEYMODE.KEY_WRITE, sa, kHandle, cResult)
AddValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
End If

Select Case vType
Case KEYTYPE.REG_BINARY
rtn = RegSetValueExA(kHandle, KItem, 0, vType, Value, Len(Value))
AddValue = rtn
If rtn <> ERROR_SUCCESS Then
Exit Function
End If
Case KEYTYPE.REG_DWORD
rtn = RegSetValueExA(kHandle, KItem, 0, vType, Value, 4)
AddValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
Case KEYTYPE.REG_EXPAND_SZ
Value = StrConv(Value, vbUnicode)
rtn = RegSetValueEx(kHandle, KItem, 0, vType, StrConv(Value, vbFromUnicode), Len(Value))
AddValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
Case KEYTYPE.REG_SZ
Value = StrConv(Value, vbUnicode)
rtn = RegSetValueEx(kHandle, KItem, 0, vType, StrConv(Value, vbFromUnicode), Len(Value))
AddValue = rtn
If rtn <> ERROR.ERROR_SUCCESS Then
Exit Function
End If
End Select

RegCloseKey kHandle
End Function