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