发信人: sealink()
整理人: (2000-06-23 22:30:11), 站内信件
|
在VB中用API函数访问注册表的一些心得，希望与大家共享
在VB中可用内部函数GetSetting、SaveSetting、GetAllSettings、DeleteSetti
ng完成对注册表的操作，
但仅限于HKEY_CURRENT_USER\Software\VB and VBA Program Settings\下，要完
成复杂的操作就依赖
API函数，下面是几天来的心得,同时感谢luxiuyuan (蓝风) 给予的启示：
我对注册表结构的理解为：项->子项->键,和树结构一样，键相当于树叶
模块如下(模块中所有常量、函数的声明来自API TEXT VIEWER中，但修改了一个
函数的声明):
'这是一个操作注册表的Bas文件
Option Explicit
Global Const REG_NONE = 0
Global Const REG_SZ As Long = 1 '字符串
Global Const REG_BINARY = 3 '二进制数据
Global Const REG_DWORD As Long = 4 '32位长整数
Global Const REG_MULTI_SZ = 7 ' Multiple Unicode str
ings
Global Const REG_LINK = 6 ' Symbolic Link (unico
de)
Global Const REG_EXPAND_SZ = 2 ' Unicode nul terminat
ed string
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 HKEY_CURRENT_CONFIG = &H80000004 '保存常规系统配置信息
,NT3.51下不可用
Global Const HKEY_DYN_DATA = &H80000005 '保存当前会话使用的数
据,NT3.51下不可用
'返回错误代码
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
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
'关闭一打开的项
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long) As Long
'创建新项
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCr
eateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reser
ved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal s
amDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkRes
ult As Long, lpdwDisposition As Long) As Long
'删除一项
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDele
teKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
'删除一值
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDe
leteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'枚举指定项的所有子项名称
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnum
KeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As St
ring, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As Str
ing, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
'枚举指定子项的键名和键值
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnum
ValueA" (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
'获取与一子项有关的信息
Public Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQ
ueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass
As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLe
n As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNam
eLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long,
lpftLastWriteTime As FILETIME) As Long
'打开一项
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpen
KeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions
As Long, ByVal samDesired As Long, phkResult As Long) As Long
'获取键值数据
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQ
ueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) A
s Long ' Note that if you declare the lpData parameter as Stri
ng, you must pass it By Value.
'设置键值
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSet
ValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Rese
rved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Lon
g) As Long ' Note that if you declare the lpData parameter as
String, you must pass it By Value.
'用保存到文体的信息替换注册表信息
Public Declare Function RegReplaceKey Lib "advapi32.dll" Alias "RegRep
laceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFi
le As String, ByVal lpOldFile As String) As Long
'用保存到文体的信息恢复注册表信息
Public Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRes
toreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags A
s Long) As Long
'将注册表信息保存到文件
Public Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKe
yA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes
As SECURITY_ATTRIBUTES) As Long
'载入已保存到文件的注册表信息
Public Declare Function RegLoadKey Lib "advapi32.dll" Alias "RegLoadKe
yA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpFile As Str
ing) As Long
Public RegReturnValue As Long
Public hKey As Long
'删除一子项
Public Function DeleteItemKey(RegMainKey As Long, RegSubKey As String)
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL_AC
CESS, hKey)
If RegReturnValue = 0 Then
RegReturnValue = RegDeleteKey(RegMainKey, RegSubKey)
RegCloseKey (hKey)
End If
End Function
'删除一键
Public Function DeleteKeyValue(RegMainKey As Long, RegSubKey As String
, RegValueName As String)
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL
_ACCESS, hKey)
If RegReturnValue = 0 Then
RegReturnValue = RegDeleteValue(hKey, RegValueName)
RegCloseKey (hKey)
End If
End Function
'建立一个新的子项
Public Function CreateNewItem(RegMainKey As Long, sNewKeyName As Strin
g)
Dim lpSecurity As SECURITY_ATTRIBUTES
RegReturnValue = RegCreateKeyEx(RegMainKey, sNewKeyName, 0&, vbNul
lString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpSecurity, hKey, Re
gReturnValue)
RegCloseKey (hKey)
End Function
'创建类型为数字的键并赋值,注意RegValueSetting的形式为2.12199579047121E
-314
Public Function SetKeyValueD(RegMainKey As Long, RegSubKey As String,
RegValueName As String, RegValueSetting As Double)
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL
_ACCESS, hKey)
If RegReturnValue = 0 Then
RegReturnValue = RegSetValueEx(hKey, RegValueName, 0, REG_DW
ORD, RegValueSetting, 4)
RegCloseKey (hKey)
End If
End Function
'创建类型为字符串的键并赋值
Public Function SetKeyValueS(RegMainKey As Long, RegSubKey As String,
RegValueName As String, RegValueSetting As String)
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL
_ACCESS, hKey)
If RegReturnValue = 0 Then
RegReturnValue = RegSetValueEx(hKey, RegValueName, 0, REG_SZ
, ByVal RegValueSetting, Len(RegValueSetting) + 1)
RegCloseKey (hKey)
End If
End Function
'获取某项某键值。注意取字符串和数字型键值的函数写法
Public Function QueryKeyValue(RegMainKey As Long, RegSubKey As String,
RegValueName As String, TypeFlag As Boolean)
Dim RegValueS As String
Dim RegValueN As Double
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL
_ACCESS, hKey)
If RegReturnValue = 0 Then
If TypeFlag Then '值为字符串
RegValueS = Space(200)
RegReturnValue = RegQueryValueEx(hKey, RegValueName, 0, R
EG_SZ, ByVal RegValueS, Len(RegValueS) + 1)
QueryKeyValue = GetUsefulStr(RegValueS)
Else '值为数字
RegReturnValue = RegQueryValueEx(hKey, RegValueName, 0, R
EG_DWORD, RegValueN, 4)
QueryKeyValue = RegValueN
End If
RegCloseKey (hKey)
End If
End Function
'枚举某项的所有子项的名称
Public Function EnumSubItem(RegMainKey As Long, RegSubKey As String)
Dim SubItemnameS As String
Dim lpstr As String
Dim lpftLastTime As FILETIME
lpstr = Space(255)
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL
_ACCESS, hKey)
If RegReturnValue = 0 Then
Dim I As Integer
I = 0
SubItemnameS = "All SubItem Is :"
Do While RegEnumKeyEx(hKey, I, lpstr, Len(lpstr), 0, vbNullStri
ng, 0, lpftLastTime) = 0
SubItemnameS = SubItemnameS & Chr(13) & Chr(10) & GetUsefulS
tr(lpstr)
I = I + 1
Loop
RegCloseKey (hKey)
EnumSubItem = SubItemnameS
End If
End Function
'枚举某子项的所有键名及键值
Public Function EnumKeyAndValue(RegMainKey As Long, RegSubKey As Strin
g)
Dim KeynameStr As String
Dim KeyvalueS As String
Dim KeyvalueN As Long
Dim KeyAndValueS As String
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL
_ACCESS, hKey)
If RegReturnValue = 0 Then
KeynameStr = Space(64)
KeyvalueS = Space(64)
Dim I As Integer
I = 0
KeyAndValueS = "All Keyname And Keyvalue Is :"
Do While RegEnumValue(hKey, I, KeynameStr, 64, 0, REG_SZ, ByVal
KeyvalueS, 64) = 0
'判断键值类型
If Asc(Left(KeyvalueS, 1)) < 32 Then
'取数字型键值
RegEnumValue hKey, I, KeynameStr, 64, 0, REG_DWORD, Keyva
lueN, 4
KeyAndValueS = KeyAndValueS & Chr(13) & Chr(10) & GetUsef
ulStr(KeynameStr)
KeyAndValueS = KeyAndValueS & ":" & KeyvalueN
Else
'取字符串键值
KeyAndValueS = KeyAndValueS & Chr(13) & Chr(10) & GetUsef
ulStr(KeynameStr)
KeyAndValueS = KeyAndValueS & ":'" & GetUsefulStr(Keyvalu
eS) & "'"
End If
I = I + 1
KeynameStr = Space(64)
Loop
RegCloseKey (hKey)
EnumKeyAndValue = KeyAndValueS
End If
End Function
'获取与一项有关的信息，如：某一项下有几个子项，最长的子项名的长度；
'某一子项有几个键，最长的键名长度，最长的键值长度
Public Function QueryInfoKey(RegMainKey As Long, RegSubKey As String)
Dim LpclassStr As String
Dim SubItemNum As Long
Dim SubItemLen As Long
Dim LpclassmaxLen As Long
Dim KeyNumber As Long
Dim KeyMaxnameLen As Long
Dim KeyMaxvaluelen As Long
Dim LpclassLen As Long
Dim SecurityDes As Long
Dim WriteTimeT As FILETIME
RegReturnValue = RegOpenKeyEx(RegMainKey, RegSubKey, 0, KEY_ALL
_ACCESS, hKey)
If RegReturnValue = 0 Then
RegReturnValue = RegQueryInfoKey(hKey, LpclassStr, LpclassLe
n, 0, SubItemNum, SubItemLen, LpclassmaxLen, KeyNumber, KeyMaxnameLen,
KeyMaxvaluelen, SecurityDes, WriteTimeT)
If RegReturnValue = 0 Then
If SubItemNum = 0 Then
QueryInfoKey = "This SubItem '" & RegSubKey & "' Have
" & KeyNumber & " Keys;" & Chr(13) & Chr(10) & "The KeysName Maxlen Is
" & KeyMaxnameLen & ";" & Chr(13) & Chr(10) & "The KeysValue Maxlen i
s " & KeyMaxvaluelen & ";"
Else
If KeyNumber = 0 Then
QueryInfoKey = "This SubItem '" & RegSubKey & "' Ha
ve " & SubItemNum & " SubItems;" & Chr(13) & Chr(10) & "The SubItemna
me MaxLen Is " & SubItemLen & ";"
Else
QueryInfoKey = "This SubItem '" & RegSubKey & "' Ha
ve " & SubItemNum & " SubItems;" & Chr(13) & Chr(10) & "The SubItemna
me MaxLen Is " & SubItemLen & ";" & Chr(13) & Chr(10) & "It Have " & K
eyNumber & " Keys;" & Chr(13) & Chr(10) & "The KeysName Maxlen Is " &
KeyMaxnameLen & ";" & Chr(13) & Chr(10) & "The KeysValue Maxlen is " &
KeyMaxvaluelen & ";"
End If
End If
End If
End If
End Function
'去掉子项名、键名、键值中的多余字符(Windows不支持的字符，以方块形式存在
的)
Public Function GetUsefulStr(InputStr As String)
Dim UserfulLen As Integer
InputStr = Trim(InputStr)
UserfulLen = InStr(1, InputStr, Chr(0))
If UserfulLen = 0 Then
GetUsefulStr = InputStr
Else
GetUsefulStr = Left(InputStr, UserfulLen - 1)
End If
End Function
要注意的几点：
1、常量HKEY_CLASSES_ROOT等声明，好象HELP、API TEXT VIEWER中根本找不到，
我也是参考别人的。
2、注意RegQueryValueEx的调用，注意取字符串和数字型键值的函数参数的写法
。
该函数取得的数字型键值与我们在注册看到的值是不相同的，而是一很大的值
。
所以在RegSetValueEx函数给数字型键值赋值时也要注意这一点，例如：要赋
值为100，
实际赋值参数为4.94065645841247E-322，该值可通过RegQueryValueEx取得。
3、注意EnumKeyAndValue枚举某子项的所有键名及键值，我把lpData参数申明为
Any，
就可以取得字符型的键值，用该函数取得的数字型键值与我们在注册看到的值
是相同的。
4、由于取得的键名及键值总有一些非法字符，我写了一函数进行转化。
5、以上模块在VB6、NT下通过，并到达对注册表的任何操作，但未考虑对二进制
键的操作。
发现的难点：怎样很容易的取得某一键的类型？？？？
程序难免有一些考虑不周和需要改进的地方希望和高手交流！！！！！！
[email protected]
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.103.135.52]
|
|