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"
2 Option Explicit
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
37 Private Const REG_CREATED_NEW_KEY = &H1
38 Private Const REG_OPENED_EXISTING_KEY = &H2
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
|