Option ExplicitDeclare 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 LongDeclare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As LongDeclare 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 LongDeclare 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 LongDeclare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As Long, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Public Const SYNCHRONIZE = &H100000Public Const READ_CONTROL = &H20000Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1Public Const KEY_ENUMERATE_SUB_KEYS = &H8Public Const KEY_NOTIFY = &H10Public Const KEY_SET_VALUE = &H2Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const REG_SZ = 1Public Const REG_BINARY = 3Public Const REG_DWORD = 4
Public Const HKEY_LOCAL_MACHINE = &H80000002Public Const REG_OPENED_EXISTING_KEY = &H2__________________________________________________
'在需要时建立主键Function CreateRegistryKey(ByVal hkey As Long, ByVal KeyName As String) As BooleanDim Handle As Long, Disposition As LongIf RegCreateKeyEx(hkey, KeyName, 0, 0, 0, 0, 0, Handle, Disposition) ThenMsgBox "不能建立该键", , "注意"Else' Return True if the key already existed.If Disposition = REG_OPENED_EXISTING_KEY Then CreateRegistryKey = True' Close the key.RegCloseKey HandleEnd IfEnd Function
'读取注册表的键值Function GetRegistryValue(ByVal hkey As Long, ByVal KeyName As String, _ByVal ValueName As String, ByVal KeyType As Integer, _Optional DefaultValue As Variant = Empty) As Variant
Dim Handle As Long, resLong As LongDim resString As String, length As LongDim resBinary() As Byte
' Prepare the default result.GetRegistryValue = DefaultValue' Open the key, exit if not found.If RegOpenKeyEx(hkey, KeyName, 0, KEY_READ, Handle) Then Exit Function
Select Case KeyTypeCase REG_DWORD' Read the value, use the default if not found.If RegQueryValueEx(Handle, ValueName, 0, REG_DWORD, _resLong, 4) = 0 ThenGetRegistryValue = resLongEnd IfCase REG_SZlength = 1024: resString = Space$(length)If RegQueryValueEx(Handle, ValueName, 0, REG_SZ, _ByVal resString, length) = 0 Then' If value is found, trim characters in excess.GetRegistryValue = Left$(resString, length - 1)End IfCase REG_BINARYlength = 4096ReDim resBinary(length - 1) As ByteIf RegQueryValueEx(Handle, ValueName, 0, REG_BINARY, _resBinary(0), length) = 0 ThenReDim Preserve resBinary(length - 1) As ByteGetRegistryValue = resBinary()End IfCase ElseMsgBox "不支持的类型", , "注意"End Select
RegCloseKey HandleEnd Function
'设置注册表的键值' Write / Create a Registry value.' Use KeyName = "" for the default value.' Supports only DWORD, SZ, and BINARY value types.
Sub SetRegistryValue(ByVal hkey As Long, ByVal KeyName As String, ByVal ValueName As String, ByVal KeyType As Integer, value As Variant)Dim Handle As Long, lngValue As Long, Disposition As LongDim strValue As StringDim binValue() As Byte, length As Long
' Open the key, exit if not found.If RegCreateKeyEx(hkey, KeyName, 0, 0, 0, 0, 0, Handle, Disposition) ThenMsgBox "出错了", , "注意"Exit SubEnd IfSelect Case KeyTypeCase REG_DWORDlngValue = valueRegSetValueEx Handle, ValueName, 0, KeyType, lngValue, 4Case REG_SZstrValue = valueRegSetValueEx Handle, ValueName, 0, KeyType, ByVal strValue, Len(strValue)Case REG_BINARYbinValue = valuelength = UBound(binValue) - LBound(binValue) + 1RegSetValueEx Handle, ValueName, 0, KeyType, binValue(LBound(binValue)), lengthEnd Select
' Close the key.RegCloseKey HandleEndEnd Sub
Form中的使用方法如下:'窗体中有一个按钮，名为cmdOk
Private Sub Form_Load()CreateRegistryKey HKEY_LOCAL_MACHINE, "Software\Text1"CreateRegistryKey HKEY_LOCAL_MACHINE, "Software\Text1\Text2"End Sub
Private Sub cmdOk_Click()If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Text1\Text2", 0, KEY_READ, Handle) = 0 ThenKeyValue = Text1.TextRegSetValueEx Handle, "Text3", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)KeyValue = Text2.TextRegSetValueEx Handle, "Text4", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)KeyValue = Text3.TextRegSetValueEx Handle, "Text5", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)KeyValue = Text5.TextRegSetValueEx Handle, "Text6", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)RegCloseKey HandleEnd IfEnd Sub
