用VB操作注册表

我们在这里主要通过由Windows系统本身提供的注册表编辑器regedit.exe来认识登录数据库(Registry)

注册表编辑器运行时我们可以看到它的窗口结构和资源管理器很像，左边窗格的没一个文件夹图标表示一个Key.Key下面还有Subkey.我们习惯上采用文件夹的路径表示法。e.g:HKEY_LOCAL_MACHINE底下的"Software"Subkey表示成HKEY_LOCAL_MACHINE\Software.

我们用Regedit.exe打开HKEY_CLASSES_ROOT\.txt这个Key,在右窗格中显示的是Key的Value,Value可能有很多，对某个特定的Value来将，它有两个属性--Value Name和Value Data,如在此例中，HKEY_CLASSES_ROOT\.txt有一个Value-->"Content Type",这个Value的Value Name为"Content Type",Value Data为"text/plain",某些Key,还有缺省Value--Default Value,如此例中,HKEY_CLASSES_ROOT\.txt这个Key的Default Value就是我们看到的"默认"
[Value Name],"txtfile"[Value Data]。

在了解了Registry的结构之后，接下来的事就是如何存取它了。就像我们存取文件必须指明文件的存取路径[目录]一样，存取Registry必须先指明Key.Key在Regedit.exe中看到的是一长串的字符串，例如: "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows",
但在Windows内部，每个Key都对应一个Key Handle(等于一个长整数值，程序中通常以hKey表示),Windows之所以要用hkey来代表Key是为了让Registry的存取更有效率，因为整数的操作功能优于字符串，所以我们的首要任务就是取得Key的Key Handle(hKey)

取得最上层的hKey
首先是位于最上层的Key,这些Key的hKey是固定不变的，其值如下表所示。

Key hKey(Key Handle)
HKEY_CLASSES_ROOT &H80000000
HKEY_CURRENT_USER &H80000001
HKEY_LOCAL_MACHINE &H80000002
HKEY_USERS &H80000003
HKEY_CURRENT_CONFIG &H80000005
HKEY_DYN_DATA &H80000006

如果想取得上述几个Key的SubKey Handle,可以调用RegOpenKey这个API函数。其详细描述如下：

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函数不太一样]

调用例：
Dim ret As Long, hKey As Long, hKey2 As Long
'取得"HKEY_LOCAL_MACHINE"底下的"SOFTWARE\Microsoft"这个SubKey Handle.
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey)
If ret = 0 Then 'If Success
MsgBox "HKLM\SOFTWARE\Microsoft = " & hKey
End If

'继续以刚才所取得的"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft"hKey为参数，再取得它的'SubKey"Windows\CurrentVersion"的handle。

ret = RegOpenKey(hKey, "Windows\CurrentVersion", hKey2)
If ret = 0 Then
MsgBox "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion = " & hKey2
End If

相关的两个API函数是：RegCreateKey[建立SubKey]和RegClose[关闭SubKey]
详细说明：
RegCreateKey函数：
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。
RegClose函数：
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
当我们不再存取Registry时，将打开或建立的SubKey关闭是一个比较好的习惯，就正如我们在使用C语言的文件打开函数后必须要关闭一样。

Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Sub Main()
Dim ret As Long, hKey As Long, hKey2 As Long
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey)
If ret = 0 Then
MsgBox "HKLM\SOFTWARE\Microsoft = " & hKey
End If

ret = RegOpenKey(hKey, "Windows\CurrentVersion", hKey2)
If ret = 0 Then
MsgBox "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion = " & hKey2
End If

'Use RegCreateKey function to create subkey "HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt"
ret = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt", hKey)
If Not ret Then
MsgBox "Create HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt SubKey Success"
Else
MsgBox "Create Subkey Operation Fail"
End If

1、Default value的存取
我曾经给我的朋友开了个玩笑,他最讨厌喜欢windows中自带的一个扫雷的游戏了.我呢,编写了一个小程序叫他帮我测试一下有没有运行错误,他欣然接受了,结果在执行完毕之后,那个程序自己消失了[那段时间我正在研究"木马冰河",对程序的自销毁技术很感兴趣,想着法子也实现了这个功能.]以后他的机器一启动就要运行扫雷这个程序,气得他暴跳如雷......。其实这样的程序很容易实现的。我们在讲述了有关函数后将给出这个程序的完整例子

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)作为结束符。

函数调用实例:
'自编函数GetDefaultValue
'读取Default Value，若成功，返回true
'Example:
'Dim S As String, ret As Boolean
'ret = GetDefaultValue(HKEY_CLASSES_ROOT, ".txt", S)
' 如果 ret 为 True(与我们正常的函数调用习惯相同)，則 S 等於读取之資料
' 如果 "HKEY_CLASSES_ROOT\.txt" 沒有缺省值, 則 S = ""

Function GetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, Value As String) As Boolean
Dim ret As Long, lenS As Long, S As String
ret = RegQueryValue(hKey, Subkey, "", lenS)
If ret <> 0 And ret <> ERROR_MORE_DATA
Then GetDefaultValue = False
Exit Function
End If
S = String(lenS, Chr(0))
ret = RegQueryValue(hKey, Subkey, S, lenS)
If ret <> 0 Then
GetDefaultValue = False
Exit Function
End If
Value = Left(S, lenS - 1)
GetDefaultValue = True
End Function

上面讲的是default value的读取，下面我们讲述它的写入。它要用到API函数RegSetValue,它的详细讲解如下：
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
其具体含义我们在以后再讲。

函数调用实例:
'自编函数SetDefaultValue
'写入Default Value
'比较值得注意的事情是，当我们想写入某一个 Subkey 的 Default Value 时，若此一 Subkey 不存在，则 Windows 会自动建立此一 Subkey，然后才写入 Default Value，假设"HKEY_LOCAL_MACHINE\SOFTWARE\kj\Registry" Subkey 并不存在，则以下敘述：
'ret = SetDefaultValue(HKEY_LOCAL_MACHINE, "SOFTWARE\kj\Registry", "kj Registry Master")
'会先建立以下两个 Subkey：(HKEY_LOCAL_MACHINE\SOFTWARE 为已存在的 Subkey) 'HKEY_LOCAL_MACHINE\SOFTWARE\kj 'HKEY_LOCAL_MACHINE\SOFTWARE\kj\Registry
'然后才写入 "kj Registry Master" 到 "HKEY_LOCAL_MACHINE\SOFTWARE\kj\Registry" Subkey 的 Default Value。

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

下面我举的一个完整的例子就是我在这篇文章开头提到的程序,只给出如何设置扫雷程序为开机自运行程序的例子,自销毁程序的设计比较复杂一些,暂不提供.

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
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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
Enum RootKey
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
Enum ErrorCode
ERROR_SUCCESS = 0&
ERROR_MORE_DATA = 234&
End Enum

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

Function GetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, Value As String) As Boolean
Dim ret As Long, lenS As Long, S As String
'读取default value的字符串长度
ret = RegQueryValue(hKey, Subkey, "", lenS)
If ret <> 0 And ret <> ERROR_MORE_DATA
Then GetDefaultValue = False
Exit Function
End If
S = String(lenS, Chr(0)) '再根据上一个RegQueryValue返回的lenS值来配置字符串。
ret = RegQueryValue(hKey, Subkey, S, lenS)
If ret <> 0 Then
GetDefaultValue = False
Exit Function
End If
Value = Left(S, lenS - 1)
GetDefaultValue = True
End Function

然后在form中放置两个命令按钮command1和command2.
'command1_click要做的事就是设置扫雷程序为开机自启动程序。若操作成功，显示success对话框。
Private Sub Command1_Click()
Dim ret As Boolean
Dim disp As String
ret = SetDefaultValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "c:\windows\winmine.exe")
If ret Then
disp = "Sucess!"
Else disp = "Fail"
End If
MsgBox disp, , "结果"
End Sub
'command2_click要做的事情就是读入HKEY_CLASSES_ROOT\.txt这个SubKey的Default Value。
Private Sub Command2_Click()
Dim S As String, ret As Boolean
Dim hKey As Long
Dim tmpstr As String
Dim disp As String
tmpstr = "The defaultvalue of HKEY_CLASSES_ROOT\.txt is: "
ret = RegOpenKey(HKEY_CLASSES_ROOT, ".txt", hKey)
ret = GetDefaultValue(hKey, "", S)
If ret Then
If S <> "" Then
disp = tmpstr & S
Else
disp = tmpstr & "NoDefaultValue"
End If
End If
MsgBox disp, , "结果"
End Sub

我们在这篇文章中将讲述利用RegQueryValueEx函数来读取某个Key的指定名称的值(value)
RegQueryValueEx的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

先利用RegQueryValueEx函数获得某个value的数据类型和数据的长度，只需要将参数lpData设置为vbNullString[表示暂时不读取数据]，然后由参数lpType获得数据类型，lpcbData获得数据长度。调用例子如下：
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
在得到某个value的数据类型和数据长度后，我们将根据不同的数据类型进行不同的处理。下面分别叙述之。

a-->数据类型为REG_SZ
这种方式最简单，只需要在上面的语句结束之后使用以下语句就可以得到正确的字符串。eg:
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
S=String(lenData,Chr(0))
RegQueryValueEx hKey, Name, 0, typeData, ByVal S, lenData '注意ByVal千万别忘了
S=Left(S,InStr(S,Chr(0))-1)

b-->数据类型为REG_EXPAND_SZ
所谓REG_EXPAND_SZ类型的字符串是指字符串中可能含有%WinDir%之类的字符串[%WinDir%表示Windows所在目录我们可以在Ms-Dos方式下使用set命令来看看这类字符串，我们也许还会看到诸如TMP,PATH,WINBOOTDIR这些和WinDir类似的具有特殊意义的字符串。]，遇到这类字符串，我们还必须调用另一个API函数ExpandEnvironmentStrings来将它展开[比如%WinDir%就展开为C:\WINDOWS]。以下是ExpandEnvironmentStrings的描述和用法：
Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
参数类型及说明
lpSrc String，欲扩充的字串
lpDst String，扩充过后的字串
nSize Long，lpDst的长度。
注意预先对lpDst进行初始化，使其与这个长度相符
函数调用例：
Dim S2 As String
'先利用RegQueryValueEx函数获得某个value的数据类型和数据的长度
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
S = String(lenData, Chr(0))
RegQueryValueEx hKey, Name, 0, typeData, ByVal S, lenData
S = Left(S, InStr(S, Chr(0)) - 1) 'S为读取出来的字符串
S2 = String(Len(S) + 256, Chr(0))'S2为扩展之后的字符串
ExpandEnvironmentStrings S, S2, Len(S2)
S2= Left(S2, InStr(S2, Chr(0)) - 1)

c-->数据类型为REG_MULTI_SZ
REG_MULTI_SZ为多重字符串，其结构如下：

下面的自定义子程序的功能是取得多重字符串中每一个字符串。
Sub MultiStringToStringArray(S As String, S2() As String)
'S为我们读取出来的多重字符串
'S2为转换后的字符串数组
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))

While pos > 0 count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
'取得多重字符串中的字符串个数
count = count - 1

ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub
在调用MultiStringToStringArray之前，要先定义一个不含任何元素的字符串数组。子程序调用例子如下：
S= "WGL"+chr(0)+"LOVE"+chr(0)+"MEISHAN"+chr(0)+chr(0)
Dim S2() As String
MultiStringToStringArray S,S2
那么执行之后，S2(0)="WGL",S2(1)="LOVE",S2(2)="MEISHAN"

d-->数据类型为REG_DWORD,REG_DWORD_BIG_ENDIAN
'先利用RegQueryValueEx函数获得某个value的数据类型和数据的长度
Dim L As Long
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
RegQueryValueEx hKey, Name, 0, typeData, L, lenData

e-->数据类型为REG_BINARY
'先利用RegQueryValueEx函数获得某个value的数据类型和数据的长度
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
ReDim bArr(0 To lenData - 1) As Byte
RegQueryValueEx hKey, Name, 0, typeData, bArr(0), lenData

有时候我们需要读取某个Key下的所有名称的值，找到特定的或者全部名称的值以作它用，比如我在编写清除著名的"木马冰河" 服务器端程序时，就需要查找HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run下的所有可疑的加载程序项目然后删除之。

要用到的API函数RegEnumValue,其详细描述：
VB声明
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
一个完整的例子如下：
'*************EnumVal2.bas***************

Option Explicit
Public Const
HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

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

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

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

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 ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long

Sub MultiStringToStringArray(S As String, S2() As String)
'S为我们读取出来的多重字符串
'S2为转换后的字符串数组
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))

While pos > 0 count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
'取得多重字符串中的字符串个数
count = count - 1

ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub

'以下的Command1_Click事件中我们将列举出'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run下的所有name及其Value.
Private Sub Command1_Click()
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long Dim Name As String
Dim lenName As Long
Dim idx As Integer, j As Integer Dim bName(256) As Byte
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", hKey)
If ret <> 0 Then Exit Sub

ret=RegEnumValueAsAny2(hKey,idx,bName(0),lenName,ByVal 0,typeData,ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
Exit Sub
End If
'上面的RegEnumValueAsAny2调用得到了第一个Name的长度lenName,不含chr(0)
Name = String(lenName + 1, Chr(0))
lenName = Len(Name)
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = Left(S, InStr(S, Chr(0)) - 1)
Text1.SelText=IIf(lenName=0, "(预设值)",Left(Name,InStr(Name,Chr(0))-1)) & "=" & S & vbCrLf
ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = Left(S2, InStr(S2, Chr(0)) - 1)
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & S & vbCrLf
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & "(" & j & ") = " & SArr(j) & vbCrLf
Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim L As Long
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, L, lenData
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & L & vbCrLf
Case REG_BINARY
ReDim bArr(0 To lenData - 1) As Byte
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, bArr(0), lenData
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = "
For j = 0 To UBound(bArr)
Text1.SelText = Hex(bArr(j)) & " "
Next
Text1.SelText = vbCrLf
End Select
idx = idx + 1
Wend
RegCloseKey hKey
End Sub

要完成Value的写入，需要用到API函数RegSetValueEx。下面是它的一些说明。
VB声明
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,表示失败。

由于RegSetValueEx的参数和RegQueryValueEx完全一样，他们的使用方式也差不多，因此，在这里我只是举出下面的例子来简略地说一下就行。
'下面的例子在HKEY_CURRENT_USER\Software\SetValue下建立
'Default Value-->REG_SZ "VB操作注册表"
'str1 -->REG_SZ "我爱我的祖国"
'str2 -->REG_EXPAND_SZ "%WinDir%Command"
'str3 -->REG_MULTI_SZ "hongqt" + Chr(0) + "lstc" + Chr(0) + "edu" + Chr(0) + "cn" + Chr(0) + Chr(0)
'LongData -->REG_DWORD 99999
'BinaryData -->REG_BINARY 11,22,33,44,aa,bb,cc,dd

Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7
'注意下面的函数声明要在一行内写完
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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

Sub Main()
Dim hKey As Long
RegCreateKey HKEY_CURRENT_USER, "Software\SetValue", hKey
RegSetValueEx hKey, "", 0, REG_SZ, ByVal "VB操作注册表", 13
RegSetValueEx hKey, "Str1", 0, REG_SZ, ByVal "我爱我的祖国", 13
RegSetValueEx hKey, "Str2", 0, REG_EXPAND_SZ, ByVal "%WinDir%Command", 16
Dim S As String
S = "hongqt" + Chr(0) + "lstc" + Chr(0) + "edu" + Chr(0) + "cn" + Chr(0) + Chr(0)
RegSetValueEx hKey, "Str3", 0, REG_MULTI_SZ, ByVal S, 20

Dim bArr(0 To 7) As Byte
bArr(0) = &H11: bArr(1) = &H22: bArr(2) = &H33: bArr(3) = &H44
bArr(4) = &HAA: bArr(5) = &HBB: bArr(6) = &HCC: bArr(7) = &HDD
RegSetValueEx hKey, "BinaryData", 0, REG_BINARY, bArr(0), 8

MsgBox "已完成 RegSetValueEx! 请检查 HKEY_CURRENT_USER\Software\SetValue 的内容。"
RegCloseKey hKey

这个功能很容易实现。主要是要调用相应的API函数--RegDeleteValue,以下是它的一些描述：
VB声明
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
参数：
hKey:Key Handle
lpValueName: Value名称，如果想删除默认值的话，传入""[空字符串]即可。

函数调用例：
'我们假设在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\SetValueSubKeyStr1Value"
RegDeleteValue hKey, ""
MsgBox "已删除HKCU\Software\SetValueSubKey‘预设值’"
End If

登录数据库Registry的Key的存取

相对于注册表中Value的存取,Key的存取要简单得多。要用到的API函数，除了前面提到的RegOpenKey、RegCreateKey之外，主要就还有RegEnumKey、RegDeleteKey。

Key的建立，可以采用前面提到的RegCreateKey完成，此处不再举例。

********************************************************************************

Key的读取：
单个Key的读取利用RegOpenKey显然已经足够。
我们这里要讲的是列出某个Key下的所有SubKey。比如：
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows这个Key下面一般就只有两个SubKey-->CurrentVersion 和Help。要实现这个功能，需要用到RegEnumKey函数。下面是它的描述：
VB声明
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

********************************************************************************

Key的删除：会用到RegDeleteKey函数，其描述如下：
VB声明
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下则会报错。

下面的一个子函数可以在WinNt下递归删除某个Key和它下面的所有SubKey.

Function DeleteSubkeyTree(ByVal hKey As Long, ByVal Subkey As String) As Boolean
Dim ret As Long, Index As Long, Name As String
Dim hSubKey As Long
ret = RegOpenKey(hKey, Subkey, hSubKey)
If ret <> 0 Then
DeleteSubkeyTree = False
Exit Function
End If
ret = RegDeleteKey(hSubKey, "")
If ret <> 0 Then
Name=String(256,chr(0))
If ret <> 0 Then
'RegDeleteKey无法删除，用于Winnt下。
Name = String(256, Chr(0))
While RegEnumKey(hSubkey, 0, Name, Len(Name)) = 0 And DeleteSubkeyTree(hSubkey, Name)
'递归删除Subkey的Subkey
Wend
ret = RegDeleteKey(hSubkey, "")
End If
DeleteSubkeyTree = (ret = 0)
RegCloseKey hSubkey
End Function

http://www.vbnew.net/artcile/2j.asp?page=6&id=11&cid=1

回复Comments()点击Count()

回复Comments

{commenttime}{commentauthor}

{CommentUrl}