- 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
VB注册表操作函数
最新推荐文章于 2017-10-11 21:40:00 发布