Commit | Line | Data |
0d212c7b |
1 | Attribute VB_Name = "RegistryFunctions" |
2 | Option Explicit |
3 | |
4 | Private Const HKEY_CLASSES_ROOT = &H80000000 |
5 | Private Const HKEY_CURRENT_USER = &H80000001 |
6 | Private Const HKEY_LOCAL_MACHINE = &H80000002 |
7 | Private Const HKEY_USERS = &H80000003 |
8 | Private Const HKEY_PERFORMANCE_DATA = &H80000004 |
9 | Private Const HKEY_CURRENT_CONFIG = &H80000005 |
10 | Private Const HKEY_DYN_DATA = &H80000006 |
11 | Private Const STANDARD_RIGHTS_ALL = &H1F0000 |
12 | Private Const KEY_QUERY_VALUE = &H1 |
13 | Private Const KEY_SET_VALUE = &H2 |
14 | Private Const KEY_CREATE_SUB_KEY = &H4 |
15 | Private Const KEY_ENUMERATE_SUB_KEYS = &H8 |
16 | Private Const KEY_NOTIFY = &H10 |
17 | Private Const SYNCHRONIZE = &H100000 |
18 | Private Const KEY_CREATE_LINK = &H20 |
19 | Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _ |
20 | KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _ |
21 | Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _ |
22 | KEY_CREATE_LINK) And (Not SYNCHRONIZE)) |
23 | Private Const REG_OPTION_NON_VOLATILE = 0 |
24 | Global Const REG_NONE = 0 |
25 | Global Const REG_SZ = 1 |
26 | Global Const REG_EXPAND_SZ = 2 |
27 | Global Const REG_BINARY = 3 |
28 | Global Const REG_DWORD = 4 |
29 | Global Const REG_DWORD_LITTLE_ENDIAN = 4 ' Same as REG_DWORD |
30 | Global Const REG_DWORD_BIG_ENDIAN = 5 |
31 | Global Const REG_LINK = 6 |
32 | Global Const REG_MULTI_SZ = 7 |
33 | Global Const REG_RESOURCE_LIST = 8 |
34 | Global Const REG_FULL_RESOURCE_DESCRIPTOR = 9 |
35 | Global Const REG_RESOURCE_REQUIREMENTS_LIST = 10 |
36 | |
37 | Private Const REG_CREATED_NEW_KEY = &H1 |
38 | Private Const REG_OPENED_EXISTING_KEY = &H2 |
39 | |
40 | Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _ |
41 | (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _ |
42 | ByVal samDesired As Long, phkResult As Long) As Long |
43 | Private Declare Function RegCloseKey Lib "advapi32.dll" _ |
44 | (ByVal hKey As Long) As Long |
45 | Private Declare Function RegEnumValue Lib "advapi32.dll" _ |
46 | Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex _ |
47 | As Long, lpValueName As String, lpcbValueName As Long, ByVal _ |
48 | lpReserved As Long, lpType As Long, lpData As Any, lpcbData As _ |
49 | Long) As Long |
50 | Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _ |
51 | Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex _ |
52 | As Long, lpName As String, lpcbName As Long, ByVal _ |
53 | lpReserved As Long, lpClass As String, lpcbClass As _ |
54 | Long, lpftLastWriteTime As Any) As Long |
55 | Private Declare Function RegQueryValueEx Lib "advapi32.dll" _ |
56 | Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _ |
57 | As String, ByVal lpReserved As Long, lpType As Long, lpData As _ |
58 | Any, lpcbData As Long) As Long |
59 | Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _ |
60 | Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey _ |
61 | As String, ByVal Reserved As Long, ByVal lpClass As String, _ |
62 | ByVal dwOptions As Long, ByVal samDesired As Long, _ |
63 | lpSecurityAttributes As Any, phkResult _ |
64 | As Long, lpdwDisposition As Long) As Long |
65 | Private Declare Function RegSetValueEx Lib "advapi32.dll" _ |
66 | Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _ |
67 | As String, ByVal Reserved As Long, ByVal dwType As Long, _ |
68 | lpData As Any, ByVal cbData As Long) As Long |
69 | Private Declare Function RegDeleteValue Lib "advapi32.dll" _ |
70 | Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _ |
71 | lpValueName As String) As Long |
72 | Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _ |
73 | "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long |
74 | Sub ConvertValueName(Path As String, ByRef hKey As Long, ByRef Key As String, ValueName As String) |
75 | Dim Data As String, bNum As Long |
76 | Data = Mid$(Path, 1, InStr(Path, "\") - 1) |
77 | Select Case Data |
78 | Case "HKEY_CLASSES_ROOT" |
79 | hKey = HKEY_CLASSES_ROOT |
80 | Case "HKEY_CURRENT_USER" |
81 | hKey = HKEY_CURRENT_USER |
82 | Case "HKEY_LOCAL_MACHINE" |
83 | hKey = HKEY_LOCAL_MACHINE |
84 | Case "HKEY_USERS" |
85 | hKey = HKEY_USERS |
86 | Case "HKEY_PERFORMANCE_DATA" |
87 | hKey = HKEY_PERFORMANCE_DATA |
88 | Case "HKEY_CURRENT_CONFIG" |
89 | hKey = HKEY_CURRENT_CONFIG |
90 | Case "HKEY_DYN_DATA" |
91 | hKey = HKEY_DYN_DATA |
92 | End Select |
93 | bNum = 1 |
94 | Do Until InStr(bNum, Path, "\") = 0 |
95 | bNum = InStr(bNum, Path, "\") + 1 |
96 | Loop |
97 | On Error Resume Next |
98 | Key = Mid$(Path, Len(Data) + 2, bNum - 2 - (Len(Data) + 1)) |
99 | ValueName = Mid$(Path, bNum) |
100 | On Error GoTo 0 |
101 | End Sub |
102 | Function GetReg(Path As String, Optional Default) |
103 | Attribute GetReg.VB_Description = "Reads a value from the registry." |
104 | Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long, NumData As Long |
105 | ConvertValueName Path, hKey, Key, ValueName |
106 | If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then |
107 | If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, vLen) = 0 Then |
108 | Data = String$(vLen, Chr$(0)) |
109 | If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then |
110 | If RegQueryValueEx(kHandle, ValueName, 0&, 0&, NumData, vLen) = 0 Then |
111 | GetReg = NumData |
112 | End If |
113 | Else |
114 | If RegQueryValueEx(kHandle, ValueName, 0&, 0&, ByVal Data, vLen) = 0 Then |
115 | If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then |
116 | Data = Left$(Data, vLen - 1) |
117 | If Data <> "" Then GetReg = Data |
118 | Else |
119 | GetReg = Data |
120 | End If |
121 | End If |
122 | End If |
123 | End If |
124 | RegCloseKey kHandle |
125 | If Not IsEmpty(GetReg) Then Exit Function |
126 | End If |
127 | If Not IsError(Default) Then GetReg = Default |
128 | End Function |
129 | Function GetRegType(Path As String) As Long |
130 | Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long |
131 | ConvertValueName Path, hKey, Key, ValueName |
132 | If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then |
133 | If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, ByVal 0&) Then |
134 | GetRegType = vType |
135 | End If |
136 | RegCloseKey kHandle |
137 | End If |
138 | End Function |
139 | Function EnumReg(ByVal Path As String, Index As Long) As String |
140 | Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long |
141 | If Right$(Path, 1) <> "\" Then Path = Path + "\" |
142 | ConvertValueName Path, hKey, Key, ValueName |
143 | ValueName = "" |
144 | If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then |
145 | vLen = 255 |
146 | Data = String$(255, Chr$(0)) |
147 | If RegEnumValue(kHandle, Index, ByVal Data, vLen, 0&, 0&, ByVal 0&, 0&) = 0 Then |
148 | Data = Left$(Data, vLen) |
149 | If Data = String$(255, Chr$(0)) Then Data = "" |
150 | EnumReg = Data |
151 | End If |
152 | RegCloseKey kHandle |
153 | End If |
154 | End Function |
155 | Function EnumKey(ByVal Path As String, Index As Long) As String |
156 | Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long |
157 | If Right$(Path, 1) <> "\" Then Path = Path + "\" |
158 | ConvertValueName Path, hKey, Key, ValueName |
159 | ValueName = "" |
160 | If RegOpenKeyEx(hKey, Key, 0&, KEY_ENUMERATE_SUB_KEYS, kHandle) = 0 Then |
161 | vLen = 255 |
162 | Data = String$(255, Chr$(0)) |
163 | If RegEnumKeyEx(kHandle, Index, ByVal Data, vLen, 0&, ByVal 0&, 0&, ByVal 0&) = 0 Then |
164 | Data = Left$(Data, vLen) |
165 | If Data = String$(255, Chr$(0)) Then Data = "" |
166 | EnumKey = Data |
167 | End If |
168 | RegCloseKey kHandle |
169 | End If |
170 | End Function |
171 | Sub MultiStringToArray(MultiString As String, ByRef StrArray() As String) |
172 | Dim cNum As Long, cNum2 As Long |
173 | ReDim StrArray(0) |
174 | For cNum = 1 To Len(MultiString) |
175 | cNum2 = InStr(cNum, MultiString, Chr(0)) |
176 | If cNum2 = 0 Then cNum2 = Len(MultiString) + 1 |
177 | ReDim Preserve StrArray(UBound(StrArray) + 1) |
178 | StrArray(UBound(StrArray)) = Mid$(MultiString, cNum, cNum2 - cNum) |
179 | cNum = cNum2 |
180 | Next cNum |
181 | End Sub |
182 | Sub ArrayToMultiString(StrArray() As String, ByRef MultiString As String) |
183 | Dim sNum As Long |
184 | MultiString = "" |
185 | For sNum = 1 To UBound(StrArray) |
186 | MultiString = MultiString + StrArray(sNum) + Chr$(0) |
187 | Next sNum |
188 | End Sub |
189 | Sub NewKey(ByVal Path As String, Optional Default, Optional vType) |
190 | Attribute NewKey.VB_Description = "Creates a new key in the registry." |
191 | Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Temp As Long, Setg As String, NumData As Long |
192 | If Right$(Path, 1) <> "\" Then Path = Path + "\" |
193 | ConvertValueName Path, hKey, Key, ValueName |
194 | ValueName = "" |
195 | If RegCreateKeyEx(hKey, Key, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY Or KEY_SET_VALUE, ByVal 0&, kHandle, Temp) = 0 Then |
196 | If Not IsError(Default) Then |
197 | If IsError(vType) Then vType = REG_SZ |
198 | If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then |
199 | NumData = Default |
200 | RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4 |
201 | Else |
202 | Setg = Default |
203 | If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _ |
204 | Setg = Setg + Chr$(0) |
205 | RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg) |
206 | End If |
207 | End If |
208 | RegCloseKey kHandle |
209 | End If |
210 | End Sub |
211 | Sub SetReg(Path As String, NewValue, Optional vType) |
212 | Attribute SetReg.VB_Description = "Writes a value to the registry." |
213 | Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Setg As String, NumData As Long |
214 | ConvertValueName Path, hKey, Key, ValueName |
215 | If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then |
216 | If IsError(vType) Then vType = REG_SZ |
217 | If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then |
218 | NumData = NewValue |
219 | RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4 |
220 | Else |
221 | Setg = NewValue |
222 | If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _ |
223 | Setg = Setg + Chr$(0) |
224 | RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg) |
225 | End If |
226 | RegCloseKey kHandle |
227 | End If |
228 | End Sub |
229 | Sub DelReg(Path As String) |
230 | Attribute DelReg.VB_Description = "Deletes a value from the registry." |
231 | Dim hKey As Long, kHandle As Long, Key As String, ValueName As String |
232 | ConvertValueName Path, hKey, Key, ValueName |
233 | If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then |
234 | RegDeleteValue kHandle, ValueName |
235 | RegCloseKey kHandle |
236 | End If |
237 | End Sub |
238 | Sub DelKey(ByVal Path As String) |
239 | Attribute DelKey.VB_Description = "Deletes a key from the registry." |
240 | Dim hKey As Long, Key As String, Data As String |
241 | If Right$(Path, 1) <> "\" Then Path = Path + "\" |
242 | ConvertValueName Path, hKey, Key, Data |
243 | RegDeleteKey hKey, Key |
244 | End Sub |