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 EnumPublic Enum RegMainKey HKEY_CLASSES_ROOT = &H80000000 HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_USERS = &H80000003 HKEY_PERFORMANCE_DATA = &H80000004 HKEY_CURRENT_CONFIG = &H80000005 HKEY_DYN_DATA = &H80000006 End Enum ' Const READ_CONTROL = &H20000 Const STANDARD_RIGHTS_READ = (READ_CONTROL) Const STANDARD_RIGHTS_WRITE = (READ_CONTROL) Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const SYNCHRONIZE = &H100000 Const STANDARD_RIGHTS_ALL = &H1F0000 '---------------------------------------------------------------- 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 FunctionFunction 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 FunctionPrivate 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
Function gfsGetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As String'功 能:从注册表中取得串值 '参 数: ' 输入: plKey Long 根键名 ' psKey String 主键名 ' psSubKey String 子键名 ' 输出: gfsGetKeyStringValue String 取得的注册表串值 ' 影响: glStatus Long 状态值 Dim llkeyid As Long '打开键的ID Dim llBufferSize As Long '需读取串的串值长度 Dim lsKeyValue As String '存放读取的串值
'预先置为空 gfsGetKeyStringValue = Empty
glstatus = ERROR_SUCCESS '假设成功
'确定参数有效 If Len(psKey) = 0 Then '主键未设置(子键未设置则读默认值) glstatus = REGAGENT_NOKEY Exit Function End If
If glstatus = ERROR_SUCCESS Then '成功则取需读取字串的串值大小 glstatus = RegQueryValueEx(llkeyid, psSubKey, 0&, REG_SZ, 0&, llBufferSize) If llBufferSize < 2 Then '空值 glstatus = RegCloseKey(llkeyid) Else '有值,正式读取串值 lsKeyValue = String(llBufferSize + 1, " ") glstatus = RegQueryValueEx(llkeyid, psSubKey, 0&, REG_SZ, ByVal lsKeyValue, llBufferSize) If glstatus = ERROR_SUCCESS Then gfsGetKeyStringValue = Left$(lsKeyValue, llBufferSize - 1) End If glstatus = RegCloseKey(llkeyid) End If End If End Function
Sub gpvSetKeyBinaryValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal plKeyValue As Long) '功 能:设置注册表中的二进制值 '参 数: ' 输入: plKey Long 根键名 ' psKey String 主键名 ' psSubKey String 子键名 ' plKeyValue Long 要设置的二进制值 ' 输出: 无 ' 影响: glStatus Long 状态值 Dim llkeyid As Long '打开键的ID glstatus = ERROR_SUCCESS '假设成功 '确定参数有效 If Len(psKey) = 0 Then '主键未设置(子键未设置则读默认值) glstatus = REGAGENT_NOKEY Exit Sub End If
If glstatus = ERROR_SUCCESS Then '成功则设置值 glstatus = RegSetValueEx(llkeyid, psSubKey, 0&, REG_BINARY, plKeyValue, Len(plKeyValue)) glstatus = RegCloseKey(llkeyid) End If End If End Sub
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 EnumPublic Enum RegMainKey
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum
'
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000
'----------------------------------------------------------------
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 FunctionFunction 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 FunctionPrivate 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的话就是调用以reg开头的API函数。看看这篇:
http://dev.csdn.net/develop/article/28/28159.shtm
GetSetting 函数
从 Windows 注册表中的应用程序项目返回注册表项设置值。语法
GetSetting(appname, section, key[, default])GetSetting 函数的语法具有下列命名参数:部分 描述
appname 必要。字符串表达式,包含应用程序或工程的名称,要求这些应用程序或工程有 注册表项设置。
section 必要。字符串表达式,包含区域名称,要求该区域有注册表项设置。
key 必要。字符串表达式,返回注册表项设置的名称。
default 可选。表达式,如果注册表项设置中没有设置值,则返回缺省值。如果省略, 则 default 取值为长度为零的字符串 ("")。
SaveSetting 语句 在 Windows 注册表中保存或建立应用程序项目。语法
SaveSetting appname, section, key, settingSaveSetting 语句的语法具有下列命名参数:部分 描述
appname 必要。字符串表达式,包含应用程序或工程的名称,对这些应用程序或工程使用设置
section 必要。字符串表达式,包含区域名称,在该区域保存注册表项设置。
key 必要。字符串表达式,包含将要保存的注册表项设置的名称。
setting 必要。表达式,包含 key 的设置值。
下列示例首先使用 SaveSetting 语句来建立 Windows 注册区(或 16 位 Windows 平台的.ini 档)里 MyApp 应用程序的项目,然后使用 DeleteSetting 语句来将之删除。' 在注册区中添加一些设置值。
SaveSetting appname := "MyApp", section := "Startup", _
key := "Top", setting := 75
SaveSetting "MyApp","Startup", "Left", 50
' 删除区段及所有的设置值。
DeleteSetting "MyApp", "Startup"
'参 数:
' 输入: plKey Long 根键名
' psKey String 主键名
' psSubKey String 子键名
' 输出: gfsGetKeyStringValue String 取得的注册表串值
' 影响: glStatus Long 状态值
Dim llkeyid As Long '打开键的ID
Dim llBufferSize As Long '需读取串的串值长度
Dim lsKeyValue As String '存放读取的串值
'预先置为空
gfsGetKeyStringValue = Empty
glstatus = ERROR_SUCCESS '假设成功
'确定参数有效
If Len(psKey) = 0 Then '主键未设置(子键未设置则读默认值)
glstatus = REGAGENT_NOKEY
Exit Function
End If
'首先打开主键
glstatus = RegOpenKey(plKey, psKey, llkeyid)
If glstatus = ERROR_SUCCESS Then '成功则取需读取字串的串值大小
glstatus = RegQueryValueEx(llkeyid, psSubKey, 0&, REG_SZ, 0&, llBufferSize)
If llBufferSize < 2 Then '空值
glstatus = RegCloseKey(llkeyid)
Else '有值,正式读取串值
lsKeyValue = String(llBufferSize + 1, " ")
glstatus = RegQueryValueEx(llkeyid, psSubKey, 0&, REG_SZ, ByVal lsKeyValue, llBufferSize)
If glstatus = ERROR_SUCCESS Then
gfsGetKeyStringValue = Left$(lsKeyValue, llBufferSize - 1)
End If
glstatus = RegCloseKey(llkeyid)
End If
End If
End Function
'功 能:设置注册表中的二进制值
'参 数:
' 输入: plKey Long 根键名
' psKey String 主键名
' psSubKey String 子键名
' plKeyValue Long 要设置的二进制值
' 输出: 无
' 影响: glStatus Long 状态值
Dim llkeyid As Long '打开键的ID
glstatus = ERROR_SUCCESS '假设成功
'确定参数有效
If Len(psKey) = 0 Then '主键未设置(子键未设置则读默认值)
glstatus = REGAGENT_NOKEY
Exit Sub
End If
'首先打开主键
glstatus = RegOpenKey(plKey, psKey, llkeyid)
If glstatus = ERROR_SUCCESS Then '成功则设置值
glstatus = RegSetValueEx(llkeyid, psSubKey, 0&, REG_BINARY, plKeyValue, Len(plKeyValue))
glstatus = RegCloseKey(llkeyid)
Else
gflCreateKey plKey, psKey
glstatus = RegOpenKey(plKey, psKey, llkeyid)
If glstatus = ERROR_SUCCESS Then '成功则设置值
glstatus = RegSetValueEx(llkeyid, psSubKey, 0&, REG_BINARY, plKeyValue, Len(plKeyValue))
glstatus = RegCloseKey(llkeyid)
End If
End If
End Sub