Module cRegistry.pkg
1// cRegistry.pkg
2// Author: SWB
3
4// Registry Access Package
5
6Use Windows.pkg
7Use RegistryAPI.pkg
8
9Enum_List // Registry Data types
10 Define rdString
11 Define rdDword
12 Define rdBinary
13 Define rdUnknown
14End_Enum_List
15
16//Prototypes
17Register_Function phRootKey Returns Handle // HKEY_CURRENT_USER
18Register_Function pfAccessRights Returns Integer // KEY_ALL_ACCESS - what access level should be used to open a Key?
19Register_Function phCurrentKey Returns Handle // low-level key
20Register_Function pbLazyWrite Returns Boolean // True
21
22Register_Function CountOfSubkeys Returns Integer
23Register_Function CountOfValues Returns Integer
24Register_Function CreateKey String sKeyName Returns Integer // return=error code
25Register_Function DeleteKey String sKeyName Returns Boolean // Deleted successfully?
26Register_Function DeleteValue String sValueName Returns Boolean // Deleted successfully?
27Register_Function GetSubkeys Handle hoArray Returns Integer // count of Subkeys
28Register_Function GetValues Handle hoArray Returns Integer // count of Values
29Register_Function KeyExists String sKeyName Returns Boolean // does the key exist?
30Register_Function LongestDataLength Returns Integer
31Register_Function LongestSubkeyLength Returns Integer
32Register_Function LongestValueLength Returns Integer
33Register_Function OpenKey string sKeyName Returns Integer
34Register_Function ReadBinary String sValueName Address aValueData Integer iDataLength Returns Boolean
35Register_Function ReadDword String sValueName Returns DWord
36Register_Function ReadString String sValueName Returns String
37Register_Function ValueExists String sValueName Returns Integer // does the Value exist?
38Register_Function ValueLength String sValueName Returns Integer
39Register_Function ValueType String sValueName Returns Integer // what is the datatype of the Value?
40Register_Procedure CloseKey
41Register_Procedure WriteBinary String sValueName Address aValueData Integer iDataLength
42Register_Procedure WriteDword String sValue DWord dwValueData
43Register_Procedure WriteString String sValue String sValueData
44
45
46{ ClassLibrary=Common }
47{ HelpTopic=cRegistry }
48Class cRegistry is a cObject
49 Procedure Construct_Object
50 Forward Send Construct_Object
51
52 Property Handle phRootKey HKEY_CURRENT_USER
53 Property UInteger pfAccessRights KEY_ALL_ACCESS // what access level should be used to open a Key?
54 Property Handle phCurrentKey
55 Property Boolean pbLazyWrite True
56 End_Procedure
57
58 Function CountOfSubkeys Returns Integer
59 DWord dwCountOfSubkeys
60 Integer iError
61 String sError
62
63 Move 0 To dwCountOfSubkeys
64 Move (RegQueryInfoKey(phCurrentKey(self), 0, 0, 0, AddressOf(dwCountOfSubkeys), 0, 0, 0, 0, 0, 0, 0)) To iError
65 If iError Begin
66 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
67 Error DFERR_REGISTRY sError // Generic Windows Error
68 End
69 Function_Return dwCountOfSubkeys
70 End_Function
71
72 Function CountOfValues Returns Integer
73 DWord dwCountOfValues
74 Integer iError
75 String sError
76
77 Move 0 To dwCountOfValues
78 Move (RegQueryInfoKey(phCurrentKey(self), 0, 0, 0, 0, 0, 0, AddressOf(dwCountOfValues), 0, 0, 0, 0)) To iError
79 If iError Begin
80 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
81 Error DFERR_REGISTRY sError // Generic Windows Error
82 End
83
84 Function_Return dwCountOfValues
85 End_Function
86
87 Function LongestSubkeyLength Returns Integer
88 DWord dwLongestSubkeyLength
89 Integer iError
90 String sError
91
92 Move 0 To dwLongestSubkeyLength
93 Move (RegQueryInfoKey(phCurrentKey(self), 0, 0, 0, 0, AddressOf(dwLongestSubkeyLength), 0, 0, 0, 0, 0, 0)) To iError
94 If iError Begin
95 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
96 Error DFERR_REGISTRY sError // Generic Windows Error
97 End
98
99 Function_Return dwLongestSubkeyLength
100 End_Function
101
102 Function LongestValueLength Returns Integer
103 DWord dwLongestValueLength
104 Integer iError
105 String sError
106
107 Move 0 To dwLongestValueLength
108 Move (RegQueryInfoKey(phCurrentKey(self), 0, 0, 0, 0, 0, 0, 0, AddressOf(dwLongestValueLength), 0, 0, 0)) To iError
109 If iError Begin
110 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
111 Error DFERR_REGISTRY sError // Generic Windows Error
112 End
113
114 Function_Return dwLongestValueLength
115 End_Function
116
117 Function LongestDataLength Returns Integer
118 DWord dwLongestDataLength
119 Integer iError
120 String sError
121
122 Move 0 To dwLongestDataLength
123 Move (RegQueryInfoKey(phCurrentKey(self), 0, 0, 0, 0, 0, 0, 0, 0, AddressOf(dwLongestDataLength), 0, 0)) To iError
124 If iError Begin
125 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
126 Error DFERR_REGISTRY sError // Generic Windows Error
127 End
128
129 Function_Return dwLongestDataLength
130 End_Function
131
132 Function ValueType String sValueName Returns Integer
133 DWord dwType
134 Integer iError eType
135 String sError
136
137 Move 0 To dwType
138 Move (RegQueryValueEx(phCurrentKey(self), ToAnsi(sValueName), 0, AddressOf(dwType), 0, 0)) To iError
139 If iError Begin
140 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
141 Error DFERR_REGISTRY sError // Generic Windows Error
142 End
143
144 If (dwType = REG_SZ) Move rdString To eType
145 Else If (dwType = REG_DWORD) Move rdDword To eType
146 Else If (dwType = REG_BINARY) Move rdBinary To eType
147 Else Move rdUnknown To eType
148
149 Function_Return eType
150 End_Function
151
152 Function ValueLength String sValueName Returns Integer
153 DWord dwSize
154 Integer iError
155 String sError
156
157 Move 0 To dwSize
158 Move (RegQueryValueEx(phCurrentKey(self), ToAnsi(sValueName), 0, 0, 0, AddressOf(dwSize))) To iError
159 If iError Begin
160 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
161 Error DFERR_REGISTRY sError // Generic Windows Error
162 End
163
164 Function_Return dwSize
165 End_Function
166
167 Function CreateKey string sKeyName Returns Integer // return=error code
168 // Calling CreateKey for an existing Key, merely opens it without error.
169 Handle hKey hKeyOpened
170 Integer iError
171 String sError
172
173 Move 0 To hKeyOpened // initialize it so we can get its address
174
175 Get phRootKey To hKey
176
177 Move (RegCreateKeyEx(hKey, ToAnsi(sKeyName), 0, 0, REG_OPTION_NON_VOLATILE, pfAccessRights(self), 0, AddressOf(hKeyOpened), 0)) To iError
178 If (iError =0) Set phCurrentKey To hKeyOpened
179 Else Begin
180 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
181 Error DFERR_REGISTRY sError // Generic Windows Error
182 End
183 Function_Return iError
184 End_Function
185
186 Procedure CloseKey
187 Integer iError
188 Handle hKey
189
190 Get phCurrentKey To hKey
191
192 If (hKey <>0) Begin
193 If (pbLazyWrite(self)) Move (RegCloseKey(hKey)) To iError
194 Else Move (RegFlushKey(hKey)) To iError
195
196 Set phCurrentKey To 0
197 End
198 End_Procedure
199
200 Function OpenKey string sKeyName Returns Boolean
201 Handle hKey hKeyOpened
202 Integer iError
203
204 Move 0 To hKeyOpened // initialize it so we can get its address
205
206 Get phRootKey To hKey
207 Move (RegOpenKeyEx(hKey, ToAnsi(sKeyName), 0, pfAccessRights(self), AddressOf(hKeyOpened))) To iError
208 If (iError =0) Set phCurrentKey To hKeyOpened
209
210 Function_Return (iError=0)
211 End_Function
212
213 Procedure WriteDword String sValue DWord dwValueData
214 Handle hKey
215 Integer iError
216 Pointer lpsDWord
217 String sDWord
218 String sError
219
220 ZeroType tDWord To sDWord
221 Put dwValueData To sDWord At tDWord.dword
222 GetAddress of sDWord To lpsDWord
223
224 Get phCurrentKey To hKey
225 Move (RegSetValueEx(hKey, ToAnsi(sValue), 0, REG_DWORD, lpsDWord, 4)) To iError
226 If iError Begin
227 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
228 Error DFERR_REGISTRY sError // Generic Windows Error
229 End
230 End_Procedure
231
232 Procedure WriteString String sValue String sValueData
233 Handle hKey
234 Integer iError cbData
235 Pointer lpsValueData
236 String sError
237
238 If (sValueData = "") Begin
239 Move (Character(0)) To sValueData
240 Move 1 To cbData
241 End
242 Else Begin
243 Move (Length(sValueData) +1) To cbData
244 End
245 Move (ToAnsi(sValueData)) To sValueData
246 GetAddress of sValueData To lpsValueData
247
248 Get phCurrentKey To hKey
249 Move (RegSetValueEx(hKey, ToAnsi(sValue), 0, REG_SZ, lpsValueData, cbData)) To iError
250 If iError Begin
251 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
252 Error DFERR_REGISTRY sError // Generic Windows Error
253 End
254 End_Procedure
255
256 Procedure WriteBinary String sValueName Address aValueData Integer iDataLength
257 Handle hKey
258 Integer iError
259 String sError
260
261 Get phCurrentKey To hKey
262 Move (RegSetValueEx(hKey, ToAnsi(sValueName), 0, REG_BINARY, aValueData, iDataLength)) To iError
263 If iError Begin
264 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
265 Error DFERR_REGISTRY sError // Generic Windows Error
266 End
267 End_Procedure
268
269 Function ReadDword String sValueName Returns DWord
270 Handle hKey
271 Integer iError
272 DWord dwValueData dwValueDataLength
273 String sError
274
275 Move 0 To dwValueData
276 Move tDWord_Size To dwValueDataLength
277
278 Get phCurrentKey To hKey
279 Move (RegQueryValueEx(hKey, ToAnsi(sValueName), 0, 0, AddressOf(dwValueData), AddressOf(dwValueDataLength))) To iError
280 If iError Begin
281 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
282 Error DFERR_REGISTRY sError // Generic Windows Error
283 End
284
285 Function_Return dwValueData
286 End_Function
287
288 Function ReadString String sValueName Returns String
289 Handle hKey
290 Integer iError
291 String sValueData
292 DWord dwValueDataLength
293 Pointer lpsValueData
294 String sError
295
296 Move (Repeat(character(0), ValueLength(self, sValueName))) To sValueData
297 GetAddress of sValueData To lpsValueData
298
299 Move (Length(sValueData)) To dwValueDataLength
300
301 Get phCurrentKey To hKey
302 Move (RegQueryValueEx(hKey, ToAnsi(sValueName), 0, 0, lpsValueData, AddressOf(dwValueDataLength))) To iError
303 If iError Begin
304 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
305 Error DFERR_REGISTRY sError // Generic Windows Error
306 End
307
308 Function_Return (ToOem(CString(sValueData)))
309 End_Function
310
311 Function ReadBinary String sValueName Address aValueData Integer iDataLength Returns Boolean
312 Handle hKey
313 Integer iError
314 String sError
315
316 Get phCurrentKey To hKey
317 Move (RegQueryValueEx(hKey, ToAnsi(sValueName), 0, 0, aValueData, AddressOf(iDataLength))) To iError
318 If iError Begin
319 Move (FormatWinError(iError)) To sError // raise an error if the Query failed
320 Error DFERR_REGISTRY sError // Generic Windows Error
321 End
322
323 Function_Return (iDataLength >0)
324 End_Function
325
326
327 // Private....
328 { Visibility=Private }
329 Function GetBaseKey Returns Handle
330 Handle hBaseKey
331 If (phCurrentKey(self) = 0) Get phRootKey To hBaseKey
332 Else Get phCurrentKey To hBaseKey
333
334 Function_Return hBaseKey
335 End_Function
336
337 { Visibility=Private }
338 Function GetKey String sKeyName Returns Handle
339 Handle hKeyOpened
340 Integer iError
341
342 MOve 0 To hKeyOpened // initialize so we can get its address
343
344 Move (RegOpenKeyEx(GetBaseKey(self), ToAnsi(sKeyName), 0, pfAccessRights(self), AddressOf(hKeyOpened))) To iError
345
346 If (iError =0) Function_Return hKeyOpened
347 Else Function_Return 0
348 End_Function
349
350 // Public
351 Function KeyExists String sKeyName Returns Boolean
352 Handle hKey
353 Integer iVoid
354
355 Get GetKey sKeyName To hKey
356 If hKey Move (RegCloseKey(hKey)) To iVoid
357 Function_Return (hKey <>0)
358 End_Function
359
360 Function ValueExists String sValueName Returns Boolean
361 // Determines whether a Value exists for the currently-opened Key.
362 Integer iError
363 Dword dwDataType
364 Move 0 To dwDataType // must initialize the variable to get its address
365
366 Move (RegQueryValueEx(phCurrentKey(self), ToAnsi(sValueName), 0, AddressOf(dwDataType), 0, 0)) To iError
367
368 Function_Return (iError=0)
369 End_Function
370
371 Function DeleteKey String sKeyName Returns Boolean // Deleted successfully?
372 Function_Return (ShDeleteKey(phRootKey(self), ToAnsi(sKeyName)) =0)
373 End_Function
374
375 Function DeleteValue String sValueName Returns Boolean // Deleted successfully?
376 Function_Return (RegDeleteValue(phCurrentKey(self), ToAnsi(sValueName)) =0)
377 End_Function
378
379 Function GetSubkeys Handle hoArray Returns Integer // count of Values
380 Integer iError
381 Integer icValue iLongestSubkey
382 Handle hKey
383 DWord dwSubkeyNameLength
384 String sSubkeyName sFileTime
385 Pointer lpsSubkeyName lpsFileTime
386
387 Get LongestSubkeyLength To iLongestSubkey
388 Move (Repeat(character(0), iLongestSubkey +1)) To sSubkeyName
389 GetAddress of sSubkeyName To lpsSubkeyName
390
391 ZeroType tFileTime To sFileTime
392 GetAddress of sFileTime To lpsFileTime
393
394 Get phCurrentKey To hKey
395 Repeat
396 Move (iLongestSubkey +1) To dwSubkeyNameLength
397
398 Move (RegEnumKeyEx(hKey, icValue, lpsSubkeyName, AddressOf(dwSubkeyNameLength), 0, 0, 0, lpsFileTime)) To iError
399 If (iError =0) Begin
400 Increment icValue
401 Set Value of hoArray (Item_Count(hoArray)) To (ToOem(CString(sSubkeyName)))
402 End
403 Until (iError)
404 Function_Return icValue
405
406 End_Function
407
408 Function GetValues Handle hoArray Returns Integer // count of Values
409 Integer iError
410 Integer icValue iLongestValue
411 Handle hKey
412 DWord dwValueNameLength
413 String sValueName sValueNameSize
414 Pointer lpsValueName
415
416 Get LongestValueLength To iLongestValue
417 Move (Repeat(character(0), iLongestValue +1)) To sValueName
418 GetAddress of sValueName To lpsValueName
419
420 Get phCurrentKey To hKey
421 Repeat
422 Move (iLongestValue +1) To dwValueNameLength
423 Move (RegEnumValue(hKey, icValue, lpsValueName, AddressOf(dwValueNameLength), 0, 0, 0, 0)) To iError
424 If (iError =0) Begin
425 Increment icValue
426 Set Value of hoArray (Item_Count(hoArray)) To (ToOem(CString(sValueName)))
427 End
428 Until (iError)
429 Function_Return icValue
430
431 End_Function
432
433End_Class
434