vb对注册表访问的函数!!!最好给个例子!
问题点数：20、回复次数：8Top
1 楼snake1122（surfer）回复于 2001-07-02 10:16:52 得分 0
gzTop
2 楼chenhw（我要回复）回复于 2001-07-02 10:31:04 得分 0
引用Registry Access Functions，在对象浏览器中可以看到这个库里有哪几个函数，自己试吧，很简单的Top
3 楼subzero（赘姆烂壳）回复于 2001-07-02 10:33:41 得分 10
Option Explicit
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
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
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue 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)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
RegCloseKey (hKey)
End Function
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Function
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Top
4 楼sjxf（xf）回复于 2001-07-02 20:11:53 得分 0
vb6的模块模板有现成的函数，很好用的
Top
5 楼xxlroad（土八路）回复于 2001-07-02 21:25:45 得分 10
Private Sub Form_Load()
Dim r As Long
r = GetSetting("API", "Win32", "u32", 0)
If r > 100000 Then
MsgBox "使用次数到！"
Unload Me
End If
r = r + 1000
SaveSetting "API", "Win32", "u32", r
End Sub
操作注册表的函数库
作者： 黄河[4326340] 2001-04-29 17:16:54
'这是一个操作注册表的标准模块文件,其中包含可以建立新键值,删除
'键值,查询键值的函数.
Option Explicit
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
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
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue 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)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
RegCloseKey (hKey)
End Function
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Function
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
调用:这里假设程序从sub Main启动
'Sub Main()
' '函数在注册表的"HKEY_CURRENT_USER\Software"中建立了
' '一个SubKey1项并在其中建立了值，并在显示后删除建立
' '的值，如果你想通过RegEdit看到结果，可以将最后两句
' '删除，不过要记得手动删除建立的键值
' CreateNewKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
' SetKeyValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test", "This is just a test", REG_SZ
' MsgBox QueryValue(HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test")
' DeleteValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test"
' DeleteKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
'End Sub
VB操作注册表--所用函数收录
梦里水乡
VB操作注册表--所用函数收录
RegOpenKey--取得SubKey的Hkey
VB声明 Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
参数类型及说明:
hKey:Key Handle
lpSubKey:SubKey名称或路径
phkResult:若RegOpenKey执行成功，则这一参数返回Subkey的hKey.
返回值: =0,表示成功；≠0,表示失败。[注意这一点与别的API函数不太一样]
e.g:
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey)
*************************************************************************
RegCreateKey函数：建立SubKey
VB声明 Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
它的参数用法与RegOpenKey一样。所不同的是RegOpenKey只能打开已经有的SubKey,而RegCreateKey则可以建立SubKey,比较特别的是，如果调用RegCreateKey所建立的SubKey是一个已经存在的SubKey,则它的功能和RegOpenKey相同。由于RegCreateKey的这种特性，有的程序员干脆不用RegOpenKey，而用RegCreateKey来统一代替RegOpenKey。
e.g:
ret = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt", hKey)
*************************************************************************
RegClose函数：关闭SubKey
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
当我们不再存取Registry时，将打开或建立的SubKey关闭是一个比较好的习惯，就正如我们在使用C语言的文件打开函数后必须要关闭一样。
e.g:
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey)
....
RegClose hkey
*************************************************************************
RegQueryValue--读取某Key的默认值(default value)
VB声明
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
hKey: Key Handle
lpSubKey:SubKey名称路径
lpValue:返回读取的Default Value
lpcbValue:传入lpValue参数的长度，若成功读取了默认值default value,则返回default value字符串的长度(含chr(0))这个和C语言中字符串的处理相似，都是以chr(0)作为结束符。
返回值: =0,表示成功；≠0,表示失败。
e.g:
ret = RegQueryValue(hKey, Subkey, "", lenS)
*************************************************************************
RegSetValue--删除某Key的默认值(default value)
VB声明
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
hKey:Key Handle
lpSubKey:Subkey名称或路径
dwType:数据类型，但在这里只能接受REG_SZ[字符串类型]
lpData:所设置的字符串
cbData:lpData字符串的长度，这一长度包括chr(0)字符。
关于dwType的可能取值
Enum ValueType
REG_NONE = 0
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
REG_DWORD = 4
REG_DWORD_BIG_ENDIAN = 5
REG_MULTI_SZ = 7
End Enum
e.g:
Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, ByVal Value As String) As Boolean
Dim ret As Long, lenS As Long, S As String
ret = RegSetValue(hKey, Subkey, REG_SZ, Value, LenB(StrConv(Value, vbFromUnicode)) + 1) SetDefaultValue = (ret = 0)
End Function
*************************************************************************
RegQueryValueEx--读取某Key的特定名称的值(Value)
Vb声明和参数解释：
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
hkey:Key Handle
lpValueName:Value Name
lpReserved:保留参数，调用时设置为0即可
lpType:返回读取的数据类型
lpData:返回读取的数据
lpcbData:传入lpData数据的长度，若成功读取数据，则返回所读取的数据的长度。
返回值: =0,表示成功；≠0,表示失败。
说明：
1、 这一函数除了可读取指定名称的值之外，也可以读取default value。如果要读取default value,只需要将
参数lpValueName设置为""[空字符串]即可。
2、lpType 的可能取值
Enum ValueType
REG_NONE = 0
REG_SZ = 1 -->字符串
REG_EXPAND_SZ = 2 -->可展开式字符串
REG_BINARY = 3 -->Binary数据
REG_DWORD = 4 -->长整数
REG_DWORD_BIG_ENDIAN = 5 -->BIG_ENDIAN长整数
REG_MULTI_SZ = 7 -->多重字符串
End Enum
e.g:
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim Name As String
`读取HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run的internat.exe的value.
Name="internat.exe"
ret=RegOpenKey(HKEY_LOCAL_MACHINE,"Software\Microsoft\Windows\CurrentVersion\Run", hKey)
if ret=0 then
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)`注意ByVal千万别忘了
end if
*************************************************************************
RegEnumValue--列出某Key的所有名称的值
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
`以下的两个函数是经过王国荣老师改编过的函数，与此相关，也一并列出.并且在我们的例子程序中要用到它们。RegEnumValueAsAny可以传入长整数和字符串；RegEnumValueAsAny2中lpData参数被改成Any后，可以使用Byte数组，由于Byte数组是采用”传地址方式来传递参数的，可以省下复制字符串数据的时间，使得程序变得更加高效。
Declare Function RegEnumValueAsAny 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 Any, lpcbData As Long) As Long
Declare Function RegEnumValueAsAny2 Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
参数说明：
hKey:Key Handle
dwIndex:欲读取之名称的顺序
lpValueName:返回所读取的名称
lpcbValueName:传入lpValueName参数的长度，返回所读取的名称的长度，注意这一长度不含chr(0)
lpReserved:保留参数，实际使用时传入ByVal 0即可
lpType:返回所读取的数据类型
lpData:返回所读取的数据
lpcbData:传入lpData，返回所读取的数据长度
返回值: =0,表示成功；≠0,表示失败。
调用例子：
ret=0
myindex=0
while ret=0
ret=RegEnumValue(hkey,myindex,Name,ByVal 0, typeData, ByVal vbNullString, lenData)
myindex=myindex+1
wend
*************************************************************************
RegSetValueEx--设置某Key特定名称的值(Value)
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
参数：
hKey:Key Handle
lpValueName:Value名称
Reserved:保留参数，具体使用时置为0即可
dwType:数据类型
lpData:所设置的数据，注意这一参数被定义成lpData As Any，所以要传入字符串数据时别忘了在参数前加保留字ByVal
cbData:数据的长度。注意：如果写入的数据属于REG_SZ、REG_EXPAND_SZ、REG_MULTI_SZ类型时，则这个长度应该包含chr(0)字符。
返回值: =0,表示成功；≠0,表示失败。
e.g:
Dim hKey As Long
Dim L As Long
L = 99999
RegCreateKey HKEY_CURRENT_USER, "Software\SetValue", hKey
RegSetValueEx hKey, "LongData", 0, REG_DWORD, L, 4
*************************************************************************
RegDeleteValue--删除某Key的某一名称
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
参数：
hKey:Key Handle
lpValueName: Value名称，如果想删除默认值的话，传入""[空字符串]即可。
返回值: =0,表示成功；≠0,表示失败。
函数调用例：
`我们假设在HKEY_CURRENT_USER\Software\SetValue有：
`预设值--VB操作注册表
`str1--我爱我的祖国
`我们要删除这两个Value
ret = RegOpenKey(HKEY_CURRENT_USER, "Software\SetValue", hKey)
If ret = 0 Then
RegDeleteValue hKey, "Str1"
MsgBox "已删除HKCU\Software\SetValueSubKeyStr1Value"
RegDeleteValue hKey, ""
MsgBox "已删除HKCU\Software\SetValueSubKey‘预设值’"
End If
*************************************************************************
RegEnumKey--列出某Key的所有SubKey
Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
参数说明：
hKey:Key Handle
dwIndex:欲读取的SubKey的顺序
lpName:返回所读取的SubKey的名称
cbName:传入lpName的字符串长度。
返回值: =0,表示成功；≠0,表示失败。
调用例：
Dim hKey As Long, ret As Long, Name As String, Idx As Long
List1.Clear
Idx = 0
Name = String(256, Chr(0))
Do
ret = RegEnumKey(HKEY_CURRENT_USER, Idx, Name, Len(Name))
If ret = 0 Then
List1.AddItem Left(Name, InStr(Name, Chr(0)) - 1)
Idx = Idx + 1
End If
Loop Until ret <> 0
*************************************************************************
RegDeleteKey--删除Key或者SubKey
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
参数：
hKey:Key Handle
lpSubKey:SubKey名称或者路径，若传入""[空字符串],表示删除Key本身。
返回值: =0,表示成功；≠0,表示失败。
eg:
Dim hKey,ret As Long
ret = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt\xiaoyuer", hKey)
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt", hKey)
ret = RegDeleteKey(hKey, "xiaoyuer")`删除HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt\xiaoyuer
注意：
如果我们利用RegDeleteKey函数删除一个含有SubKey的Key时，对于Windows98和Winnt来讲是不一样的。比如我们把上面的删除调用改成ret = RegDeleteKey(hKey, "")，则在windows98下，它会连hongqt下的xiaoyuer一起删除，而在winnt下则会报错。
-------------------------------------------------------
-------------------------------------------------------
-------------------------------------------------------
作者的话
梦里水乡
我在早期学习Vb时,老早就想能够掌握用它来控制注册表的一些操作，但一直苦于没有找到相应的资料。后来在白云黄鹤bbs站上看到了一篇由VisualBasic版版主coolknight撰写的有关这方面的文章，于是发信去向他请教。得到了他的无私的帮助，他为我提供了用Vb操作注册表的源代码。我拿回来仔细研究后终于掌握了这方面的技术。
后来我又买到了一本讲述windows api方面的书--由人民邮电出版社出版的《Visual Basic6.0与Windows API讲座》，是由台湾的王国荣老师编写的。再次读了一下关注册表方面的部分， 再次受到震撼。原来我掌握的技术还太复杂了一些，还有更简单的方法。
在此，我先向coolknight和王国荣老师表示敬意和感谢。
受神奇注册表网站主人lgyh所托，写了这一系列文章，希望同时对Vb和注册表感兴趣朋友能够解决一些平时技术上的难题并能学到一些相关的知识，那么我的愿望就算达到了。需要说明的是，这些文章中有些代码我抄录自《Visual Basic6.0与Windows API讲座》一书。非为赢利目的，但求知识与技术共享。
就说这些吧，本来还想编写一个用Vb操作注册表的演示性程序的，但我的工作太忙了。我是抽出许多休息时间来完成这些文章的。我本来还写了一个清除木马冰河服务器端程序的，但木马冰河程序好象又升级了，我还没来得及研究它的工作过程，我的代码没有升级，就不好意思拿出来让大家笑话了。
Top
6 楼xxlroad（土八路）回复于 2001-07-02 21:33:58 得分 0
http://my.6to23.com/vbnetcn/vb6/vbjqq/vbjqq.htmTop
7 楼xxlroad（土八路）回复于 2001-07-02 21:36:43 得分 0
主 题：我想利用api删除注册表下HKEY_CURRENT_USER\software\microsoft\internet explorer\typedurls\下的所有键值(给满分, 再要再加)
作 者：xzxzxxz
所属论坛：Visual Basic
问题点数：69
回复次数：6
发表时间：2001-6-1 13:55:00
谢谢
回复贴子：
回复人：xclxd(小虾) (2001-6-1 14:05:00) 得0分
最简单的方法是删除HKEY_CURRENT_USER\software\microsoft\internet explorer\typedurls\子键及其下的所有子键及键值（使用api RegDeleteKey)，然后重建该子键（使用api RegCreateKey)，我用delphi，VB不太清楚，供参考。
回复人：Tenner(Tenner) (2001-6-1 14:06:00) 得0分
VB一样
要代码的话发信到 tenner@etang.com
回复人：flyinnet(flyinnet) (2001-6-1 14:07:00) 得0分
'\\==================================================================================
'作者: flyinnet
'Email: wh@ hongzhi.com
'
' 该模块用于替换vb里面的 SaveSetting getsetting ,getallsettings,deletesetting
' 等注册表函数，不同之处在于可以自己设置存放的位置,
'
' Visual Basic 6.0 sp3 调试通过，window 98(中文版) NT4.0(中文版), Window2000(中文版)均使用通过,
'
'注意:
'
' 1.getallsettings 返回的数组与原VB返回的数组不同，原getallsettings返回的数组为(n,1)
' 现在返回的为(1,n),原因是重定义数组只能是定义数组的最后一维,但使用没有什么影响，没必要再费力转换
'
' 2.getallsettings 返回的最大数据默认为255byte,如果需要更大，请设置MaxCount！
'
' 3,无法存取二进制格式,原vb函数似乎也不行
'
' 4,原deletesetting,和 savesetting 没有返回值 ，现在将返回boolean值，表示是否成功
'
'\\===================================================================================
' 使用时出现问题，或您有更好的想法，请发信给我
'\\===================================================================================
Option Explicit
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type ACL
AclRevision As Byte
Sbz1 As Byte
AclSize As Integer
AceCount As Integer
Sbz2 As Integer
End Type
Private Type SECURITY_DESCRIPTOR
Revision As Byte
Sbz1 As Byte
Control As Long
Owner As Long
Group As Long
Sacl As ACL
Dacl As ACL
End Type
Public Enum PKey
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_LOCAL_MACHINE = &H80000002
HKEY_DYN_DATA = &H80000006
HKEY_CURRENT_USER = &H80000001
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CLASSES_ROOT = &H80000000
End Enum
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) 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 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 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 RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName 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 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 Any, lpcbData As Long) As Long
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegGetKeySecurity Lib "advapi32.dll" (ByVal hKey As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR, lpcbSecurityDescriptor As Long) 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 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 RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegLoadKey Lib "advapi32.dll" Alias "RegLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpFile As String) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) 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
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function RegSetKeySecurity Lib "advapi32.dll" (ByVal hKey As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegUnLoadKey Lib "advapi32.dll" Alias "RegUnLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_BINARY = 3 ' Free form binary
Private Const REG_CREATED_NEW_KEY = &H1 ' New Registry Key created
Private Const REG_DWORD = 4 ' 32-bit number
Private Const REG_DWORD_BIG_ENDIAN = 5 ' 32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)
Private Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Private Const REG_LINK = 6 ' Symbolic Link (unicode)
Private Const REG_MULTI_SZ = 7 ' Multiple Unicode strings
Private Const REG_NONE = 0 ' No value type
Private Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Private Const REG_NOTIFY_CHANGE_LAST_SET = &H4 ' Time stamp
Private Const REG_NOTIFY_CHANGE_NAME = &H1 ' Create or delete (child)
Private Const REG_NOTIFY_CHANGE_SECURITY = &H8
Private Const REG_OPENED_EXISTING_KEY = &H2 ' Existing Key opened
Private Const REG_OPTION_BACKUP_RESTORE = 4 ' open for backup or restore
Private Const REG_OPTION_CREATE_LINK = 2 ' Created key is a symbolic link
Private Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Private Const REG_OPTION_RESERVED = 0 ' Parameter is reserved
Private Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted
Private Const REG_REFRESH_HIVE = &H2 ' Unwind changes to last flush
Private Const REG_RESOURCE_LIST = 8 ' Resource list in the resource map
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Private Const REG_WHOLE_HIVE_VOLATILE = &H1 ' Restore whole hive volatile
Private Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Private Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_NOTIFY = &H10
Private Const KEY_EVENT = &H1 ' Event contains key event record
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_SET_VALUE = &H2
'private 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))
'private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
'private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
'private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1009&
Private Const ERROR_BADKEY = 1010&
Private Const ERROR_CANTOPEN = 1011&
Private Const ERROR_CANTREAD = 1012&
Private Const ERROR_CANTWRITE = 1013&
Private Const ERROR_REGISTRY_RECOVERED = 1014&
Private Const ERROR_REGISTRY_CORRUPT = 1015&
Private Const ERROR_REGISTRY_IO_FAILED = 1016&
Private Const ERROR_MORE_DATA = 234 ' dderror
Private Const ERROR_NO_MORE_ITEMS = 259&
Private mSubKey As String
Private mKey As PKey
Private mMaxCount As Long
Property Let Subkey(theSubkey As String)
mSubKey = theSubkey
End Property
Property Get Subkey() As String
Subkey = mSubKey
End Property
Property Let key(thekey As PKey)
mKey = thekey
End Property
Property Get key() As PKey
key = mKey
End Property
Property Let MaxCount(theMaxCount As Long)
mMaxCount = theMaxCount
End Property
Property Get MaxCount() As Long
MaxCount = mMaxCount
End Property
'//保存注册表项目
Function SaveSetting(AppName As String, section As String, key As String, setting As Variant) As Boolean
Dim ret As Long
Dim hKey As Long
Dim lSize As Long
Dim lType As Long
Dim sSetting As String
sSetting = CStr(setting)
On Error GoTo DError
ret = RegCreateKey(mKey, mSubKey & "\" & AppName & "\" & section, hKey)
If ret = ERROR_SUCCESS Then
lSize = lstrlenA(sSetting)
lType = REG_SZ
ret = RegSetValueEx(hKey, key, 0&, lType, ByVal sSetting, lSize)
If ret = ERROR_SUCCESS Then
SaveSetting = True
Else
SaveSetting = False
End If
Call RegCloseKey(hKey)
Else
SaveSetting = False
End If
Exit Function
DError:
SaveSetting = False
End Function
'//读取注册表项目
Function GetSetting(AppName As String, section As String, key As String, Optional default As Variant) As Variant
Dim ret As Long
Dim hKey As Long
Dim lSize As Long
Dim stemp As String
On Error GoTo DError
If IsMissing(default) Then default = ""
ret = RegOpenKeyEx(mKey, mSubKey & "\" & AppName & "\" & section, 0&, KEY_QUERY_VALUE, hKey)
If ret = ERROR_SUCCESS Then
ret = RegQueryValueEx(hKey, key, 0&, REG_SZ, ByVal 0&, lSize)
If ret = ERROR_SUCCESS Then
stemp = String(lSize, Chr$(0))
ret = RegQueryValueEx(hKey, key, 0&, REG_SZ, ByVal stemp, lSize)
If ret = ERROR_SUCCESS Then
'此一段主要是为了适用于中文
stemp = Left$(stemp, lSize - 1)
Do While Right$(stemp, 1) = Chr$(0)
stemp = Left$(stemp, Len(stemp) - 1)
Loop
GetSetting = stemp
Else
GetSetting = default
End If
Else
GetSetting = default
End If
Call RegCloseKey(hKey)
Else
GetSetting = default
End If
Exit Function
DError:
GetSetting = ""
End Function
'//枚举注册表项目
Function GetAllSettings(AppName As String, section As String) As Variant
Dim ret As Long
Dim hKey As Long
Dim lSize As Long
Dim lSizeName As Long
Dim stemp As String
Dim sTempName As String
Dim arrayTemp() As String
Dim VarTemp As Variant
Dim lIndex As Long
On Error GoTo DError
ret = RegOpenKeyEx(mKey, mSubKey & "\" & AppName & "\" & section, 0&, KEY_QUERY_VALUE, hKey)
If ret = ERROR_SUCCESS Then
lIndex = 0
Do
lSizeName = 255
sTempName = String(255, Chr$(0))
lSize = mMaxCount
stemp = String(mMaxCount, Chr$(0))
ret = RegEnumValue(hKey, lIndex, sTempName, lSizeName, 0&, REG_SZ, ByVal stemp, lSize)
If ret = ERROR_SUCCESS Then
ReDim Preserve arrayTemp(1, lIndex)
Do While Right$(sTempName, 1) = Chr$(0)
sTempName = Left$(sTempName, Len(sTempName) - 1)
Loop
Do While Right$(stemp, 1) = Chr$(0)
stemp = Left$(stemp, Len(stemp) - 1)
Loop
arrayTemp(0, lIndex) = sTempName
arrayTemp(1, lIndex) = stemp
lIndex = lIndex + 1
VarTemp = arrayTemp
Else
Exit Do
End If
Loop
Call RegCloseKey(hKey)
GetAllSettings = VarTemp
Exit Function
End If
DError:
End Function
'//删除注册表项目
Function DeleteSetting(AppName As String, section As String, Optional key As String) As Boolean
Dim ret As Long
Dim hKey As Long
On Error GoTo DError
If key = "" Then
ret = RegDeleteKey(mKey, mSubKey & "\" & AppName & "\" & section)
If ret = ERROR_SUCCESS Then
DeleteSetting = True
Else
DeleteSetting = False
End If
Else
ret = RegOpenKeyEx(mKey, mSubKey & "\" & AppName & "\" & section, 0&, KEY_SET_VALUE, hKey)
If ret = ERROR_SUCCESS Then
ret = RegDeleteValue(hKey, key)
If ret = ERROR_SUCCESS Then
DeleteSetting = True
Else
DeleteSetting = False
End If
Call RegCloseKey(hKey)
Else
DeleteSetting = False
End If
End If
Exit Function
DError:
DeleteSetting = False
End Function
Private Sub Class_Initialize()
mMaxCount = 255
mKey = HKEY_CURRENT_USER
mSubKey = "software"
End Sub
回复人：xzxzxxz(只要功夫深，草木皆成剑) (2001-6-1 14:24:00) 得0分
谢谢各位!
回复人：Wuxyingshu(无影石) (2001-6-1 14:30:00) 得0分
弄注册表不看这个很可惜
http://my.6to23.com/vbnetcn/vb6/vbjqq/vbjqq.htm
回复人：xzxzxxz(只要功夫深，草木皆成剑) (2001-6-3 8:41:00) 得0分
tenner寄给我的程序好像不是关于注册表的哦!?帮我看一看好吗,谢谢
Top
8 楼wwl007（疑难杂症）回复于 2001-07-25 12:48:47 得分 0
谢谢Top
