Current News Archived News Search News Discussion Forum Old Forum Install Programs More Downloads... Troubleshooting Source Code Format Specs. Misc. Information Non-SF Stuff Links Small banner for links to this site: |
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
|