VB注册表操作函数

2. Option Explicit
4. '
5. '注册表操作(SmRegCtr)
6. '
7. '/类型.
8. Public Enum RegDataType
9.     '/REG_NONE = 0                     ' 未知类型
10.     REG_SZ = 1                         ' Unicode字符串
11.     '/REG_EXPAND_SZ = 2                ' Unicode字符串
12.     REG_BINARY = 3                     ' 二进制
13.     '/REG_DWORD = 4                    ' 双字节型.
14.     '/REG_DWORD_LITTLE_ENDIAN = 4      ' 32-bit number (same as REG_DWORD)
15.     '/REG_DWORD_BIG_ENDIAN = 5         ' 32-bit number
16. End Enum
18. Public Enum RegMainKey
19.     HKEY_CLASSES_ROOT = 
20.     HKEY_CURRENT_USER = 
21.     HKEY_LOCAL_MACHINE = 
22.     HKEY_USERS = 
23.     HKEY_PERFORMANCE_DATA = 
24.     HKEY_CURRENT_CONFIG = 
25.     HKEY_DYN_DATA = 
26. End Enum
27. '
28. Const READ_CONTROL = 
29. Const STANDARD_RIGHTS_READ = (READ_CONTROL)
30. Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
31. Const KEY_QUERY_VALUE = 
32. Const KEY_SET_VALUE = 
33. Const KEY_CREATE_SUB_KEY = 
34. Const KEY_ENUMERATE_SUB_KEYS = 
35. Const KEY_NOTIFY = 
36. Const KEY_CREATE_LINK = 
37. Const SYNCHRONIZE = 
38. Const STANDARD_RIGHTS_ALL = 
39. '----------------------------------------------------------------
40. Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
41.    KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
42.    And (Not SYNCHRONIZE))
43. Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
44.    KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
45. Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
46.    KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
47.    Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) _
48.    And (Not SYNCHRONIZE))
49. Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
50. Const ERROR_SUCCESS = 0
51. '-----------------------------------------------------------------
52. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
53. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
54. Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
55. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
56. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
57. 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
58. 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
59. 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
60. 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
61. '
62. '功能:取某键值下的所有项
63. '函数:RegEnumKeyVal
64. '参数:hKey RegMainKey枚举,subKey 子键路径名称.
65. '返回值:String 字符串数组
66. '例子:
67. Public Function RegEnumKeyVal(hKey As RegMainKey, subKey As String) As String()
69.     Dim mhKey As Long, Cnt As Long, sSave As String
70.     Dim RevVal() As String
71.     
72.     On Error Resume Next
73.     
74.     RegOpenKey hKey, "Enum", mhKey
75.     Do
76.         sSave = String(255, 0)
77.         If RegEnumKeyEx(mhKey, Cnt, sSave, 255, 0, vbNullString, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
78.         Cnt = Cnt + 1
79.     Loop
80.     RegCloseKey mhKey
81.     RegOpenKey hKey, subKey, mhKey
82.     Cnt = 0
83.     Do
84.         sSave = String(255, 0)
85.         If RegEnumValue(mhKey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
86.         Cnt = Cnt + 1
87.         ReDim Preserve RevVal(Cnt - 1)
88.         RevVal(Cnt - 1) = StripTerminator(sSave)
89.     Loop
90.     RegCloseKey hKey
91.     RegEnumKeyVal = RevVal
92. End Function
93.     
94. '
95. '功能:建立子键.
96. '函数:RegCreatesubKey
97. '参数:hKey RegMainKey枚举,subKey 子键名称.
98. '返回值:0 成功,其它值 失败.
99. '例子:
100. Public Function RegCreatesubKey(hKey As RegMainKey, subKey As String) As Variant
101.        Dim Ret As Variant
102.        If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
103.        If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
104.        RegCreateKey hKey, subKey, Ret
105.        RegCreatesubKey = Ret
106. End Function
108. '
109. '功能:删除子键.
110. '函数:RegDeletesubKey
111. '参数:hKey RegMainKey枚举,subKey 子键名称.
112. '返回值:无
113. '例子:
114. Public Function RegDeletesubKey(hKey As RegMainKey, subKey As String)
115.        If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
116.        If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
117.        RegDeleteKey hKey, subKey
118. End Function
120. '
121. '功能:保存值到注册表.
122. '函数:RegSaveData
123. '参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称,KeyVal 值,ValType RegDataType枚举.
124. '返回值:0 成功,其它值 失败.
125. '例子:
127. Public Function RegSaveData(hKey As RegMainKey, subKey As String, ValName As String, KeyVal As String, Optional ValType As RegDataType = REG_SZ) As Long
128.     Dim Ret As Long
129.     On Error Resume Next
130.     Ret = 0
131.     If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
132.     If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
133.     If ValType = RegDataType.REG_BINARY Then
134.        Ret = SaveStringLong(hKey, subKey, ValName, KeyVal)
135.     Else
136.        Ret = SaveString(hKey, subKey, ValName, KeyVal)
137.     End If
138.     RegSaveData = Ret
139. End Function
141. '
142. '功能:取注册表中的值.
143. '函数:RegGetVal
144. '参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称
145. '返回值:成功,返回注册表中的值,失败 NULL
146. '例子:
147. Public Function RegGetVal(hKey As RegMainKey, subKey As String, ValName As String) As Variant
148.     Dim Ret As Variant
149.     If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
150.     If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
151.     Ret = GetString(hKey, subKey, ValName)
152.     RegGetVal = Ret
153. End Function
155. '
156. '功能:删除注册表中的值.
157. '函数:RegDelVal
158. '参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称
159. '返回值:成功,返回注册表中的值,失败 NULL
160. '例子:
161. Public Function RegDelVal(hKey As RegMainKey, subKey As String, ValName As String)
162.        DelSetting hKey, subKey, ValName
163. End Function
165. '/===================================================================================
167. '/以下函数为功能函数.
168. '/取注册表中的值.
169. Function GetString(hKey As RegMainKey, subKey As String, ValName As String) As Variant
170.     On Error Resume Next
171.     Dim Ret As Variant
172.     RegOpenKey hKey, subKey, Ret
173.     GetString = RegQueryStringValue(Ret, ValName)
174.     RegCloseKey Ret
175. End Function
177. '/保存字符串.
178. Function SaveString(hKey As RegMainKey, subKey As String, ValName As String, strData As String)
179.     Dim Ret As Variant
180.     Dim ReturnVal As Long
181.     On Error Resume Next
182.     RegCreateKey hKey, subKey, Ret
183.     ReturnVal = RegSetValueEx(Ret, ValName, 0, RegDataType.REG_SZ, ByVal strData, Len(strData))
184.     RegCloseKey Ret
185. End Function
187. '/保存值二进制值.
188. Function SaveStringLong(hKey As RegMainKey, subKey As String, ValName As String, strData As String) As Variant
189.     Dim Ret As Variant
190.     On Error Resume Next
191.     RegCreateKey hKey, subKey, Ret
192.     RegSetValueEx Ret, ValName, 0, RegDataType.REG_BINARY, CByte(strData), 1
193.     RegCloseKey Ret
194. End Function
196. '/删除值
197. Function DelSetting(hKey As RegMainKey, subKey As String, ValName As String)
198.     Dim Ret As Variant
199.     On Error Resume Next
200.     RegCreateKey hKey, subKey, Ret
201.     RegDeleteValue Ret, ValName
202.     RegCloseKey Ret
203. End Function
205. Function RegQueryStringValue(ByVal hKey As RegMainKey, ByVal ValName As String) As String
206.     Dim lResult As Long
207.     Dim lValueType As Long
208.     Dim strBuf As String
209.     Dim lDataBufSize As Long
210.     Dim strData As Long
211.     Dim RetVal As String
212.     
213.     On Error Resume Next
214.     
215.     lResult = RegQueryValueEx(hKey, ValName, 0, lValueType, ByVal 0, lDataBufSize)
216.     If lResult = 0 Then
217.         If lValueType = RegDataType.REG_SZ Then
218.             strBuf = String(lDataBufSize, Chr$(0))
219.             lResult = RegQueryValueEx(hKey, ValName, 0, 0, ByVal strBuf, lDataBufSize)
220.             If lResult = 0 Then
221.                RetVal = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
222.             End If
223.         ElseIf lValueType = RegDataType.REG_BINARY Then
224.             lResult = RegQueryValueEx(hKey, ValName, 0, 0, strData, lDataBufSize)
225.             If lResult = 0 Then
226.                RetVal = strData
227.             End If
228.         End If
229.     End If
230.     RegQueryStringValue = RetVal
231. End Function
233. Private Function StripTerminator(sInput As String) As String
234.     Dim ZeroPos As Integer
235.     ZeroPos = InStr(1, sInput, vbNullChar)
236.     If ZeroPos > 0 Then
237.         StripTerminator = Left$(sInput, ZeroPos - 1)
238.     Else
239.         StripTerminator = sInput
240.     End If
241. End Function