VB注册表操作函数

关注

原创最新推荐文章于 2026-03-20 06:21:32 发布 2.1k 阅读 AI 写同款· GEO 优化 ›

利用VB.NET访问注册表 利用VB.NET访问注册表 译者注：访问注册表的例子比较多，然而通过VB.NET访问注册表的例子并不多，本文翻译了一篇MSDN上的利用VB.NET存取注册表的例子，挺详细也挺全面的。 ( http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dv_vstechart/html/vbtchimpdragdrop.as 阅读详情

Option Explicit
' 
'注册表操作(SmRegCtr) 
' 
'/类型. 
Public Enum RegDataType
    '/REG_NONE = 0                     ' 未知类型 
    REG_SZ = 1                         ' Unicode字符串 
    '/REG_EXPAND_SZ = 2                ' Unicode字符串 
    REG_BINARY = 3                     ' 二进制 
    '/REG_DWORD = 4                    ' 双字节型. 
    '/REG_DWORD_LITTLE_ENDIAN = 4      ' 32-bit number (same as REG_DWORD) 
    '/REG_DWORD_BIG_ENDIAN = 5         ' 32-bit number 
End Enum
Public Enum RegMainKey
    HKEY_CLASSES_ROOT = 
    HKEY_CURRENT_USER = 
    HKEY_LOCAL_MACHINE = 
    HKEY_USERS = 
    HKEY_PERFORMANCE_DATA = 
    HKEY_CURRENT_CONFIG = 
    HKEY_DYN_DATA = 
End Enum
' 
Const READ_CONTROL = 
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_QUERY_VALUE = 
Const KEY_SET_VALUE = 
Const KEY_CREATE_SUB_KEY = 
Const KEY_ENUMERATE_SUB_KEYS = 
Const KEY_NOTIFY = 
Const KEY_CREATE_LINK = 
Const SYNCHRONIZE = 
Const STANDARD_RIGHTS_ALL = 
'---------------------------------------------------------------- 
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
   KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
   And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
   KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const 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))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Const ERROR_SUCCESS = 0
'----------------------------------------------------------------- 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 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
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 Any) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
' 
'功能:取某键值下的所有项 
'函数:RegEnumKeyVal 
'参数:hKey RegMainKey枚举,subKey 子键路径名称. 
'返回值:String 字符串数组 
'例子: 
Public Function RegEnumKeyVal(hKey As RegMainKey, subKey As String) As String()
    Dim mhKey As Long, Cnt As Long, sSave As String
    Dim RevVal() As String
    
    On Error Resume Next
    
    RegOpenKey hKey, "Enum", mhKey
    Do
        sSave = String(255, 0)
        If RegEnumKeyEx(mhKey, Cnt, sSave, 255, 0, vbNullString, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
        Cnt = Cnt + 1
    Loop
    RegCloseKey mhKey
    RegOpenKey hKey, subKey, mhKey
    Cnt = 0
    Do
        sSave = String(255, 0)
        If RegEnumValue(mhKey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
        Cnt = Cnt + 1
        ReDim Preserve RevVal(Cnt - 1)
        RevVal(Cnt - 1) = StripTerminator(sSave)
    Loop
    RegCloseKey hKey
    RegEnumKeyVal = RevVal
End Function
    
' 
'功能:建立子键. 
'函数:RegCreatesubKey 
'参数:hKey RegMainKey枚举,subKey 子键名称. 
'返回值:0 成功,其它值 失败. 
'例子: 
Public Function RegCreatesubKey(hKey As RegMainKey, subKey As String) As Variant
       Dim Ret As Variant
       If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
       If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
       RegCreateKey hKey, subKey, Ret
       RegCreatesubKey = Ret
End Function
' 
'功能:删除子键. 
'函数:RegDeletesubKey 
'参数:hKey RegMainKey枚举,subKey 子键名称. 
'返回值:无 
'例子: 
Public Function RegDeletesubKey(hKey As RegMainKey, subKey As String)
       If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
       If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
       RegDeleteKey hKey, subKey
End Function
' 
'功能:保存值到注册表. 
'函数:RegSaveData 
'参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称,KeyVal 值,ValType RegDataType枚举. 
'返回值:0 成功,其它值 失败. 
'例子: 
Public Function RegSaveData(hKey As RegMainKey, subKey As String, ValName As String, KeyVal As String, Optional ValType As RegDataType = REG_SZ) As Long
    Dim Ret As Long
    On Error Resume Next
    Ret = 0
    If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
    If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
    If ValType = RegDataType.REG_BINARY Then
       Ret = SaveStringLong(hKey, subKey, ValName, KeyVal)
    Else
       Ret = SaveString(hKey, subKey, ValName, KeyVal)
    End If
    RegSaveData = Ret
End Function
' 
'功能:取注册表中的值. 
'函数:RegGetVal 
'参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称 
'返回值:成功,返回注册表中的值,失败 NULL 
'例子: 
Public Function RegGetVal(hKey As RegMainKey, subKey As String, ValName As String) As Variant
    Dim Ret As Variant
    If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
    If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
    Ret = GetString(hKey, subKey, ValName)
    RegGetVal = Ret
End Function
' 
'功能:删除注册表中的值. 
'函数:RegDelVal 
'参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称 
'返回值:成功,返回注册表中的值,失败 NULL 
'例子: 
Public Function RegDelVal(hKey As RegMainKey, subKey As String, ValName As String)
       DelSetting hKey, subKey, ValName
End Function
'/=================================================================================== 
'/以下函数为功能函数. 
'/取注册表中的值. 
Function GetString(hKey As RegMainKey, subKey As String, ValName As String) As Variant
    On Error Resume Next
    Dim Ret As Variant
    RegOpenKey hKey, subKey, Ret
    GetString = RegQueryStringValue(Ret, ValName)
    RegCloseKey Ret
End Function
'/保存字符串. 
Function SaveString(hKey As RegMainKey, subKey As String, ValName As String, strData As String)
    Dim Ret As Variant
    Dim ReturnVal As Long
    On Error Resume Next
    RegCreateKey hKey, subKey, Ret
    ReturnVal = RegSetValueEx(Ret, ValName, 0, RegDataType.REG_SZ, ByVal strData, Len(strData))
    RegCloseKey Ret
End Function
'/保存值二进制值. 
Function SaveStringLong(hKey As RegMainKey, subKey As String, ValName As String, strData As String) As Variant
    Dim Ret As Variant
    On Error Resume Next
    RegCreateKey hKey, subKey, Ret
    RegSetValueEx Ret, ValName, 0, RegDataType.REG_BINARY, CByte(strData), 1
    RegCloseKey Ret
End Function
'/删除值 
Function DelSetting(hKey As RegMainKey, subKey As String, ValName As String)
    Dim Ret As Variant
    On Error Resume Next
    RegCreateKey hKey, subKey, Ret
    RegDeleteValue Ret, ValName
    RegCloseKey Ret
End Function
Function RegQueryStringValue(ByVal hKey As RegMainKey, ByVal ValName As String) As String
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim strData As Long
    Dim RetVal As String
    
    On Error Resume Next
    
    lResult = RegQueryValueEx(hKey, ValName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = RegDataType.REG_SZ Then
            strBuf = String(lDataBufSize, Chr$(0))
            lResult = RegQueryValueEx(hKey, ValName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
               RetVal = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = RegDataType.REG_BINARY Then
            lResult = RegQueryValueEx(hKey, ValName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
               RetVal = strData
            End If
        End If
    End If
    RegQueryStringValue = RetVal
End Function
Private Function StripTerminator(sInput As String) As String
    Dim ZeroPos As Integer
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End Function