/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinreg.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinreg.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (show annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (8 years, 2 months ago) by dashley
File MIME type: text/plain
File size: 39928 byte(s)
Rename for reorganization.
1 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwinreg.c,v 1.1.1.1 2001/06/13 04:50:03 dtashley Exp $ */
2
3 /*
4 * tclWinReg.c --
5 *
6 * This file contains the implementation of the "registry" Tcl
7 * built-in command. This command is built as a dynamically
8 * loadable extension in a separate DLL.
9 *
10 * Copyright (c) 1997 by Sun Microsystems, Inc.
11 * Copyright (c) 1998-1999 by Scriptics Corporation.
12 *
13 * See the file "license.terms" for information on usage and redistribution
14 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 *
16 * RCS: @(#) $Id: tclwinreg.c,v 1.1.1.1 2001/06/13 04:50:03 dtashley Exp $
17 */
18
19 #include <tclPort.h>
20 #include <stdlib.h>
21
22 #define WIN32_LEAN_AND_MEAN
23 #include <windows.h>
24 #undef WIN32_LEAN_AND_MEAN
25
26 /*
27 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
28 * Registry_Init declaration is in the source file itself, which is only
29 * accessed when we are building a library.
30 */
31
32 #undef TCL_STORAGE_CLASS
33 #define TCL_STORAGE_CLASS DLLEXPORT
34
35 /*
36 * The following macros convert between different endian ints.
37 */
38
39 #define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
40 #define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
41
42 /*
43 * The following flag is used in OpenKeys to indicate that the specified
44 * key should be created if it doesn't currently exist.
45 */
46
47 #define REG_CREATE 1
48
49 /*
50 * The following tables contain the mapping from registry root names
51 * to the system predefined keys.
52 */
53
54 static char *rootKeyNames[] = {
55 "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
56 "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
57 "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
58 };
59
60 static HKEY rootKeys[] = {
61 HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
62 HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
63 };
64
65 /*
66 * The following table maps from registry types to strings. Note that
67 * the indices for this array are the same as the constants for the
68 * known registry types so we don't need a separate table to hold the
69 * mapping.
70 */
71
72 static char *typeNames[] = {
73 "none", "sz", "expand_sz", "binary", "dword",
74 "dword_big_endian", "link", "multi_sz", "resource_list", NULL
75 };
76
77 static DWORD lastType = REG_RESOURCE_LIST;
78
79 /*
80 * The following structures allow us to select between the Unicode and ASCII
81 * interfaces at run time based on whether Unicode APIs are available. The
82 * Unicode APIs are preferable because they will handle characters outside
83 * of the current code page.
84 */
85
86 typedef struct RegWinProcs {
87 int useWide;
88
89 LONG (WINAPI *regConnectRegistryProc)(TCHAR *, HKEY, PHKEY);
90 LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
91 DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
92 LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *);
93 LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *);
94 LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD);
95 LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
96 TCHAR *, DWORD *, FILETIME *);
97 LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
98 DWORD *, BYTE *, DWORD *);
99 LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM,
100 HKEY *);
101 LONG (WINAPI *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *,
102 DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
103 FILETIME *);
104 LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
105 BYTE *, DWORD *);
106 LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD,
107 CONST BYTE*, DWORD);
108 } RegWinProcs;
109
110 static RegWinProcs *regWinProcs;
111
112 static RegWinProcs asciiProcs = {
113 0,
114
115 (LONG (WINAPI *)(TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
116 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
117 DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
118 DWORD *)) RegCreateKeyExA,
119 (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
120 (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
121 (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
122 (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
123 TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA,
124 (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
125 DWORD *, BYTE *, DWORD *)) RegEnumValueA,
126 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
127 HKEY *)) RegOpenKeyExA,
128 (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
129 DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
130 FILETIME *)) RegQueryInfoKeyA,
131 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
132 BYTE *, DWORD *)) RegQueryValueExA,
133 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
134 CONST BYTE*, DWORD)) RegSetValueExA,
135 };
136
137 static RegWinProcs unicodeProcs = {
138 1,
139
140 (LONG (WINAPI *)(TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
141 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
142 DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
143 DWORD *)) RegCreateKeyExW,
144 (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
145 (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
146 (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
147 (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
148 TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW,
149 (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
150 DWORD *, BYTE *, DWORD *)) RegEnumValueW,
151 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
152 HKEY *)) RegOpenKeyExW,
153 (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
154 DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
155 FILETIME *)) RegQueryInfoKeyW,
156 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
157 BYTE *, DWORD *)) RegQueryValueExW,
158 (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
159 CONST BYTE*, DWORD)) RegSetValueExW,
160 };
161
162
163 /*
164 * Declarations for functions defined in this file.
165 */
166
167 static void AppendSystemError(Tcl_Interp *interp, DWORD error);
168 static DWORD ConvertDWORD(DWORD type, DWORD value);
169 static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
170 static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
171 Tcl_Obj *valueNameObj);
172 static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
173 Tcl_Obj *patternObj);
174 static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
175 Tcl_Obj *valueNameObj);
176 static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
177 Tcl_Obj *valueNameObj);
178 static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
179 Tcl_Obj *patternObj);
180 static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
181 REGSAM mode, int flags, HKEY *keyPtr);
182 static DWORD OpenSubKey(char *hostName, HKEY rootKey,
183 char *keyName, REGSAM mode, int flags,
184 HKEY *keyPtr);
185 static int ParseKeyName(Tcl_Interp *interp, char *name,
186 char **hostNamePtr, HKEY *rootKeyPtr,
187 char **keyNamePtr);
188 static DWORD RecursiveDeleteKey(HKEY hStartKey, TCHAR * pKeyName);
189 static int RegistryObjCmd(ClientData clientData,
190 Tcl_Interp *interp, int objc,
191 Tcl_Obj * CONST objv[]);
192 static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
193 Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
194 Tcl_Obj *typeObj);
195
196 EXTERN int Registry_Init(Tcl_Interp *interp);
197
198 /*
199 *----------------------------------------------------------------------
200 *
201 * Registry_Init --
202 *
203 * This procedure initializes the registry command.
204 *
205 * Results:
206 * A standard Tcl result.
207 *
208 * Side effects:
209 * None.
210 *
211 *----------------------------------------------------------------------
212 */
213
214 int
215 Registry_Init(
216 Tcl_Interp *interp)
217 {
218 if (!Tcl_InitStubs(interp, "8.0", 0)) {
219 return TCL_ERROR;
220 }
221
222 /*
223 * Determine if the unicode interfaces are available and select the
224 * appropriate registry function table.
225 */
226
227 if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
228 regWinProcs = &unicodeProcs;
229 } else {
230 regWinProcs = &asciiProcs;
231 }
232
233 Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
234 return Tcl_PkgProvide(interp, "registry", "1.0");
235 }
236
237 /*
238 *----------------------------------------------------------------------
239 *
240 * RegistryObjCmd --
241 *
242 * This function implements the Tcl "registry" command.
243 *
244 * Results:
245 * A standard Tcl result.
246 *
247 * Side effects:
248 * None.
249 *
250 *----------------------------------------------------------------------
251 */
252
253 static int
254 RegistryObjCmd(
255 ClientData clientData, /* Not used. */
256 Tcl_Interp *interp, /* Current interpreter. */
257 int objc, /* Number of arguments. */
258 Tcl_Obj * CONST objv[]) /* Argument values. */
259 {
260 int index;
261 char *errString;
262
263 static char *subcommands[] = { "delete", "get", "keys", "set", "type",
264 "values", (char *) NULL };
265 enum SubCmdIdx { DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx };
266
267 if (objc < 2) {
268 Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
269 return TCL_ERROR;
270 }
271
272 if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
273 != TCL_OK) {
274 return TCL_ERROR;
275 }
276
277 switch (index) {
278 case DeleteIdx: /* delete */
279 if (objc == 3) {
280 return DeleteKey(interp, objv[2]);
281 } else if (objc == 4) {
282 return DeleteValue(interp, objv[2], objv[3]);
283 }
284 errString = "keyName ?valueName?";
285 break;
286 case GetIdx: /* get */
287 if (objc == 4) {
288 return GetValue(interp, objv[2], objv[3]);
289 }
290 errString = "keyName valueName";
291 break;
292 case KeysIdx: /* keys */
293 if (objc == 3) {
294 return GetKeyNames(interp, objv[2], NULL);
295 } else if (objc == 4) {
296 return GetKeyNames(interp, objv[2], objv[3]);
297 }
298 errString = "keyName ?pattern?";
299 break;
300 case SetIdx: /* set */
301 if (objc == 3) {
302 HKEY key;
303
304 /*
305 * Create the key and then close it immediately.
306 */
307
308 if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key)
309 != TCL_OK) {
310 return TCL_ERROR;
311 }
312 RegCloseKey(key);
313 return TCL_OK;
314 } else if (objc == 5 || objc == 6) {
315 Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
316 return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
317 }
318 errString = "keyName ?valueName data ?type??";
319 break;
320 case TypeIdx: /* type */
321 if (objc == 4) {
322 return GetType(interp, objv[2], objv[3]);
323 }
324 errString = "keyName valueName";
325 break;
326 case ValuesIdx: /* values */
327 if (objc == 3) {
328 return GetValueNames(interp, objv[2], NULL);
329 } else if (objc == 4) {
330 return GetValueNames(interp, objv[2], objv[3]);
331 }
332 errString = "keyName ?pattern?";
333 break;
334 }
335 Tcl_WrongNumArgs(interp, 2, objv, errString);
336 return TCL_ERROR;
337 }
338
339 /*
340 *----------------------------------------------------------------------
341 *
342 * DeleteKey --
343 *
344 * This function deletes a registry key.
345 *
346 * Results:
347 * A standard Tcl result.
348 *
349 * Side effects:
350 * None.
351 *
352 *----------------------------------------------------------------------
353 */
354
355 static int
356 DeleteKey(
357 Tcl_Interp *interp, /* Current interpreter. */
358 Tcl_Obj *keyNameObj) /* Name of key to delete. */
359 {
360 char *tail, *buffer, *hostName, *keyName;
361 HKEY rootKey, subkey;
362 DWORD result;
363 int length;
364 Tcl_Obj *resultPtr;
365 Tcl_DString buf;
366
367 /*
368 * Find the parent of the key being deleted and open it.
369 */
370
371 keyName = Tcl_GetStringFromObj(keyNameObj, &length);
372 buffer = ckalloc(length + 1);
373 strcpy(buffer, keyName);
374
375 if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName)
376 != TCL_OK) {
377 ckfree(buffer);
378 return TCL_ERROR;
379 }
380
381 resultPtr = Tcl_GetObjResult(interp);
382 if (*keyName == '\0') {
383 Tcl_AppendToObj(resultPtr, "bad key: cannot delete root keys", -1);
384 ckfree(buffer);
385 return TCL_ERROR;
386 }
387
388 tail = strrchr(keyName, '\\');
389 if (tail) {
390 *tail++ = '\0';
391 } else {
392 tail = keyName;
393 keyName = NULL;
394 }
395
396 result = OpenSubKey(hostName, rootKey, keyName,
397 KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
398 if (result != ERROR_SUCCESS) {
399 ckfree(buffer);
400 if (result == ERROR_FILE_NOT_FOUND) {
401 return TCL_OK;
402 } else {
403 Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
404 AppendSystemError(interp, result);
405 return TCL_ERROR;
406 }
407 }
408
409 /*
410 * Now we recursively delete the key and everything below it.
411 */
412
413 tail = Tcl_WinUtfToTChar(tail, -1, &buf);
414 result = RecursiveDeleteKey(subkey, tail);
415 Tcl_DStringFree(&buf);
416
417 if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
418 Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
419 AppendSystemError(interp, result);
420 result = TCL_ERROR;
421 } else {
422 result = TCL_OK;
423 }
424
425 RegCloseKey(subkey);
426 ckfree(buffer);
427 return result;
428 }
429
430 /*
431 *----------------------------------------------------------------------
432 *
433 * DeleteValue --
434 *
435 * This function deletes a value from a registry key.
436 *
437 * Results:
438 * A standard Tcl result.
439 *
440 * Side effects:
441 * None.
442 *
443 *----------------------------------------------------------------------
444 */
445
446 static int
447 DeleteValue(
448 Tcl_Interp *interp, /* Current interpreter. */
449 Tcl_Obj *keyNameObj, /* Name of key. */
450 Tcl_Obj *valueNameObj) /* Name of value to delete. */
451 {
452 HKEY key;
453 char *valueName;
454 int length;
455 DWORD result;
456 Tcl_Obj *resultPtr;
457 Tcl_DString ds;
458
459 /*
460 * Attempt to open the key for deletion.
461 */
462
463 if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key)
464 != TCL_OK) {
465 return TCL_ERROR;
466 }
467
468 resultPtr = Tcl_GetObjResult(interp);
469 valueName = Tcl_GetStringFromObj(valueNameObj, &length);
470 Tcl_WinUtfToTChar(valueName, length, &ds);
471 result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
472 Tcl_DStringFree(&ds);
473 if (result != ERROR_SUCCESS) {
474 Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"",
475 Tcl_GetString(valueNameObj), "\" from key \"",
476 Tcl_GetString(keyNameObj), "\": ", NULL);
477 AppendSystemError(interp, result);
478 result = TCL_ERROR;
479 } else {
480 result = TCL_OK;
481 }
482 RegCloseKey(key);
483 return result;
484 }
485
486 /*
487 *----------------------------------------------------------------------
488 *
489 * GetKeyNames --
490 *
491 * This function enumerates the subkeys of a given key. If the
492 * optional pattern is supplied, then only keys that match the
493 * pattern will be returned.
494 *
495 * Results:
496 * Returns the list of subkeys in the result object of the
497 * interpreter, or an error message on failure.
498 *
499 * Side effects:
500 * None.
501 *
502 *----------------------------------------------------------------------
503 */
504
505 static int
506 GetKeyNames(
507 Tcl_Interp *interp, /* Current interpreter. */
508 Tcl_Obj *keyNameObj, /* Key to enumerate. */
509 Tcl_Obj *patternObj) /* Optional match pattern. */
510 {
511 HKEY key;
512 DWORD index;
513 char buffer[MAX_PATH+1], *pattern, *name;
514 Tcl_Obj *resultPtr;
515 int result = TCL_OK;
516 Tcl_DString ds;
517
518 /*
519 * Attempt to open the key for enumeration.
520 */
521
522 if (OpenKey(interp, keyNameObj, KEY_ENUMERATE_SUB_KEYS, 0, &key)
523 != TCL_OK) {
524 return TCL_ERROR;
525 }
526
527 if (patternObj) {
528 pattern = Tcl_GetString(patternObj);
529 } else {
530 pattern = NULL;
531 }
532
533 /*
534 * Enumerate over the subkeys until we get an error, indicating the
535 * end of the list.
536 */
537
538 resultPtr = Tcl_GetObjResult(interp);
539 for (index = 0; (*regWinProcs->regEnumKeyProc)(key, index, buffer,
540 MAX_PATH+1) == ERROR_SUCCESS; index++) {
541 Tcl_WinTCharToUtf((TCHAR *) buffer, -1, &ds);
542 name = Tcl_DStringValue(&ds);
543 if (pattern && !Tcl_StringMatch(name, pattern)) {
544 Tcl_DStringFree(&ds);
545 continue;
546 }
547 result = Tcl_ListObjAppendElement(interp, resultPtr,
548 Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
549 Tcl_DStringFree(&ds);
550 if (result != TCL_OK) {
551 break;
552 }
553 }
554
555 RegCloseKey(key);
556 return result;
557 }
558
559 /*
560 *----------------------------------------------------------------------
561 *
562 * GetType --
563 *
564 * This function gets the type of a given registry value and
565 * places it in the interpreter result.
566 *
567 * Results:
568 * Returns a normal Tcl result.
569 *
570 * Side effects:
571 * None.
572 *
573 *----------------------------------------------------------------------
574 */
575
576 static int
577 GetType(
578 Tcl_Interp *interp, /* Current interpreter. */
579 Tcl_Obj *keyNameObj, /* Name of key. */
580 Tcl_Obj *valueNameObj) /* Name of value to get. */
581 {
582 HKEY key;
583 Tcl_Obj *resultPtr;
584 DWORD result;
585 DWORD type;
586 Tcl_DString ds;
587 char *valueName;
588 int length;
589
590 /*
591 * Attempt to open the key for reading.
592 */
593
594 if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
595 != TCL_OK) {
596 return TCL_ERROR;
597 }
598
599 /*
600 * Get the type of the value.
601 */
602
603 resultPtr = Tcl_GetObjResult(interp);
604
605 valueName = Tcl_GetStringFromObj(valueNameObj, &length);
606 valueName = Tcl_WinUtfToTChar(valueName, length, &ds);
607 result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type,
608 NULL, NULL);
609 Tcl_DStringFree(&ds);
610 RegCloseKey(key);
611
612 if (result != ERROR_SUCCESS) {
613 Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"",
614 Tcl_GetString(valueNameObj), "\" from key \"",
615 Tcl_GetString(keyNameObj), "\": ", NULL);
616 AppendSystemError(interp, result);
617 return TCL_ERROR;
618 }
619
620 /*
621 * Set the type into the result. Watch out for unknown types.
622 * If we don't know about the type, just use the numeric value.
623 */
624
625 if (type > lastType || type < 0) {
626 Tcl_SetIntObj(resultPtr, type);
627 } else {
628 Tcl_SetStringObj(resultPtr, typeNames[type], -1);
629 }
630 return TCL_OK;
631 }
632
633 /*
634 *----------------------------------------------------------------------
635 *
636 * GetValue --
637 *
638 * This function gets the contents of a registry value and places
639 * a list containing the data and the type in the interpreter
640 * result.
641 *
642 * Results:
643 * Returns a normal Tcl result.
644 *
645 * Side effects:
646 * None.
647 *
648 *----------------------------------------------------------------------
649 */
650
651 static int
652 GetValue(
653 Tcl_Interp *interp, /* Current interpreter. */
654 Tcl_Obj *keyNameObj, /* Name of key. */
655 Tcl_Obj *valueNameObj) /* Name of value to get. */
656 {
657 HKEY key;
658 char *valueName;
659 DWORD result, length, type;
660 Tcl_Obj *resultPtr;
661 Tcl_DString data, buf;
662 int nameLen;
663
664 /*
665 * Attempt to open the key for reading.
666 */
667
668 if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
669 != TCL_OK) {
670 return TCL_ERROR;
671 }
672
673 /*
674 * Initialize a Dstring to maximum statically allocated size
675 * we could get one more byte by avoiding Tcl_DStringSetLength()
676 * and just setting length to TCL_DSTRING_STATIC_SIZE, but this
677 * should be safer if the implementation of Dstrings changes.
678 *
679 * This allows short values to be read from the registy in one call.
680 * Longer values need a second call with an expanded DString.
681 */
682
683 Tcl_DStringInit(&data);
684 length = TCL_DSTRING_STATIC_SIZE - 1;
685 Tcl_DStringSetLength(&data, length);
686
687 resultPtr = Tcl_GetObjResult(interp);
688
689 valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
690 valueName = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
691
692 result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type,
693 (BYTE *) Tcl_DStringValue(&data), &length);
694 while (result == ERROR_MORE_DATA) {
695 /*
696 * The Windows docs say that in this error case, we just need
697 * to expand our buffer and request more data.
698 * Required for HKEY_PERFORMANCE_DATA
699 */
700 length *= 2;
701 Tcl_DStringSetLength(&data, length);
702 result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL,
703 &type, (BYTE *) Tcl_DStringValue(&data), &length);
704 }
705 Tcl_DStringFree(&buf);
706 RegCloseKey(key);
707 if (result != ERROR_SUCCESS) {
708 Tcl_AppendStringsToObj(resultPtr, "unable to get value \"",
709 Tcl_GetString(valueNameObj), "\" from key \"",
710 Tcl_GetString(keyNameObj), "\": ", NULL);
711 AppendSystemError(interp, result);
712 Tcl_DStringFree(&data);
713 return TCL_ERROR;
714 }
715
716 /*
717 * If the data is a 32-bit quantity, store it as an integer object. If it
718 * is a multi-string, store it as a list of strings. For null-terminated
719 * strings, append up the to first null. Otherwise, store it as a binary
720 * string.
721 */
722
723 if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
724 Tcl_SetIntObj(resultPtr, ConvertDWORD(type,
725 *((DWORD*) Tcl_DStringValue(&data))));
726 } else if (type == REG_MULTI_SZ) {
727 char *p = Tcl_DStringValue(&data);
728 char *end = Tcl_DStringValue(&data) + length;
729
730 /*
731 * Multistrings are stored as an array of null-terminated strings,
732 * terminated by two null characters. Also do a bounds check in
733 * case we get bogus data.
734 */
735
736 while (p < end && ((regWinProcs->useWide)
737 ? *((Tcl_UniChar *)p) : *p) != 0) {
738 Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
739 Tcl_ListObjAppendElement(interp, resultPtr,
740 Tcl_NewStringObj(Tcl_DStringValue(&buf),
741 Tcl_DStringLength(&buf)));
742 if (regWinProcs->useWide) {
743 while (*((Tcl_UniChar *)p)++ != 0) {}
744 } else {
745 while (*p++ != '\0') {}
746 }
747 Tcl_DStringFree(&buf);
748 }
749 } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
750 Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf);
751 Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buf),
752 Tcl_DStringLength(&buf));
753 Tcl_DStringFree(&buf);
754 } else {
755 /*
756 * Save binary data as a byte array.
757 */
758
759 Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), length);
760 }
761 Tcl_DStringFree(&data);
762 return result;
763 }
764
765 /*
766 *----------------------------------------------------------------------
767 *
768 * GetValueNames --
769 *
770 * This function enumerates the values of the a given key. If
771 * the optional pattern is supplied, then only value names that
772 * match the pattern will be returned.
773 *
774 * Results:
775 * Returns the list of value names in the result object of the
776 * interpreter, or an error message on failure.
777 *
778 * Side effects:
779 * None.
780 *
781 *----------------------------------------------------------------------
782 */
783
784 static int
785 GetValueNames(
786 Tcl_Interp *interp, /* Current interpreter. */
787 Tcl_Obj *keyNameObj, /* Key to enumerate. */
788 Tcl_Obj *patternObj) /* Optional match pattern. */
789 {
790 HKEY key;
791 Tcl_Obj *resultPtr;
792 DWORD index, size, maxSize, result;
793 Tcl_DString buffer, ds;
794 char *pattern, *name;
795
796 /*
797 * Attempt to open the key for enumeration.
798 */
799
800 if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
801 != TCL_OK) {
802 return TCL_ERROR;
803 }
804
805 resultPtr = Tcl_GetObjResult(interp);
806
807 /*
808 * Query the key to determine the appropriate buffer size to hold the
809 * largest value name plus the terminating null.
810 */
811
812 result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL,
813 NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
814 if (result != ERROR_SUCCESS) {
815 Tcl_AppendStringsToObj(resultPtr, "unable to query key \"",
816 Tcl_GetString(keyNameObj), "\": ", NULL);
817 AppendSystemError(interp, result);
818 RegCloseKey(key);
819 result = TCL_ERROR;
820 goto done;
821 }
822 maxSize++;
823
824
825 Tcl_DStringInit(&buffer);
826 Tcl_DStringSetLength(&buffer,
827 (regWinProcs->useWide) ? maxSize*2 : maxSize);
828 index = 0;
829 result = TCL_OK;
830
831 if (patternObj) {
832 pattern = Tcl_GetString(patternObj);
833 } else {
834 pattern = NULL;
835 }
836
837 /*
838 * Enumerate the values under the given subkey until we get an error,
839 * indicating the end of the list. Note that we need to reset size
840 * after each iteration because RegEnumValue smashes the old value.
841 */
842
843 size = maxSize;
844 while ((*regWinProcs->regEnumValueProc)(key, index,
845 Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
846 == ERROR_SUCCESS) {
847
848 if (regWinProcs->useWide) {
849 size *= 2;
850 }
851
852 Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), size, &ds);
853 name = Tcl_DStringValue(&ds);
854 if (!pattern || Tcl_StringMatch(name, pattern)) {
855 result = Tcl_ListObjAppendElement(interp, resultPtr,
856 Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
857 if (result != TCL_OK) {
858 Tcl_DStringFree(&ds);
859 break;
860 }
861 }
862 Tcl_DStringFree(&ds);
863
864 index++;
865 size = maxSize;
866 }
867 Tcl_DStringFree(&buffer);
868
869 done:
870 RegCloseKey(key);
871 return result;
872 }
873
874 /*
875 *----------------------------------------------------------------------
876 *
877 * OpenKey --
878 *
879 * This function opens the specified key. This function is a
880 * simple wrapper around ParseKeyName and OpenSubKey.
881 *
882 * Results:
883 * Returns the opened key in the keyPtr argument and a Tcl
884 * result code.
885 *
886 * Side effects:
887 * None.
888 *
889 *----------------------------------------------------------------------
890 */
891
892 static int
893 OpenKey(
894 Tcl_Interp *interp, /* Current interpreter. */
895 Tcl_Obj *keyNameObj, /* Key to open. */
896 REGSAM mode, /* Access mode. */
897 int flags, /* 0 or REG_CREATE. */
898 HKEY *keyPtr) /* Returned HKEY. */
899 {
900 char *keyName, *buffer, *hostName;
901 int length;
902 HKEY rootKey;
903 DWORD result;
904
905 keyName = Tcl_GetStringFromObj(keyNameObj, &length);
906 buffer = ckalloc(length + 1);
907 strcpy(buffer, keyName);
908
909 result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
910 if (result == TCL_OK) {
911 result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
912 if (result != ERROR_SUCCESS) {
913 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
914 Tcl_AppendToObj(resultPtr, "unable to open key: ", -1);
915 AppendSystemError(interp, result);
916 result = TCL_ERROR;
917 } else {
918 result = TCL_OK;
919 }
920 }
921
922 ckfree(buffer);
923 return result;
924 }
925
926 /*
927 *----------------------------------------------------------------------
928 *
929 * OpenSubKey --
930 *
931 * This function opens a given subkey of a root key on the
932 * specified host.
933 *
934 * Results:
935 * Returns the opened key in the keyPtr and a Windows error code
936 * as the return value.
937 *
938 * Side effects:
939 * None.
940 *
941 *----------------------------------------------------------------------
942 */
943
944 static DWORD
945 OpenSubKey(
946 char *hostName, /* Host to access, or NULL for local. */
947 HKEY rootKey, /* Root registry key. */
948 char *keyName, /* Subkey name. */
949 REGSAM mode, /* Access mode. */
950 int flags, /* 0 or REG_CREATE. */
951 HKEY *keyPtr) /* Returned HKEY. */
952 {
953 DWORD result;
954 Tcl_DString buf;
955
956 /*
957 * Attempt to open the root key on a remote host if necessary.
958 */
959
960 if (hostName) {
961 hostName = Tcl_WinUtfToTChar(hostName, -1, &buf);
962 result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
963 &rootKey);
964 Tcl_DStringFree(&buf);
965 if (result != ERROR_SUCCESS) {
966 return result;
967 }
968 }
969
970 /*
971 * Now open the specified key with the requested permissions. Note
972 * that this key must be closed by the caller.
973 */
974
975 keyName = Tcl_WinUtfToTChar(keyName, -1, &buf);
976 if (flags & REG_CREATE) {
977 DWORD create;
978 result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, "",
979 REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
980 } else {
981 if (rootKey == HKEY_PERFORMANCE_DATA) {
982 /*
983 * Here we fudge it for this special root key.
984 * See MSDN for more info on HKEY_PERFORMANCE_DATA and
985 * the peculiarities surrounding it
986 */
987 *keyPtr = HKEY_PERFORMANCE_DATA;
988 result = ERROR_SUCCESS;
989 } else {
990 result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0,
991 mode, keyPtr);
992 }
993 }
994 Tcl_DStringFree(&buf);
995
996 /*
997 * Be sure to close the root key since we are done with it now.
998 */
999
1000 if (hostName) {
1001 RegCloseKey(rootKey);
1002 }
1003 return result;
1004 }
1005
1006 /*
1007 *----------------------------------------------------------------------
1008 *
1009 * ParseKeyName --
1010 *
1011 * This function parses a key name into the host, root, and subkey
1012 * parts.
1013 *
1014 * Results:
1015 * The pointers to the start of the host and subkey names are
1016 * returned in the hostNamePtr and keyNamePtr variables. The
1017 * specified root HKEY is returned in rootKeyPtr. Returns
1018 * a standard Tcl result.
1019 *
1020 *
1021 * Side effects:
1022 * Modifies the name string by inserting nulls.
1023 *
1024 *----------------------------------------------------------------------
1025 */
1026
1027 static int
1028 ParseKeyName(
1029 Tcl_Interp *interp, /* Current interpreter. */
1030 char *name,
1031 char **hostNamePtr,
1032 HKEY *rootKeyPtr,
1033 char **keyNamePtr)
1034 {
1035 char *rootName;
1036 int result, index;
1037 Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp);
1038
1039 /*
1040 * Split the key into host and root portions.
1041 */
1042
1043 *hostNamePtr = *keyNamePtr = rootName = NULL;
1044 if (name[0] == '\\') {
1045 if (name[1] == '\\') {
1046 *hostNamePtr = name;
1047 for (rootName = name+2; *rootName != '\0'; rootName++) {
1048 if (*rootName == '\\') {
1049 *rootName++ = '\0';
1050 break;
1051 }
1052 }
1053 }
1054 } else {
1055 rootName = name;
1056 }
1057 if (!rootName) {
1058 Tcl_AppendStringsToObj(resultPtr, "bad key \"", name,
1059 "\": must start with a valid root", NULL);
1060 return TCL_ERROR;
1061 }
1062
1063 /*
1064 * Split the root into root and subkey portions.
1065 */
1066
1067 for (*keyNamePtr = rootName; **keyNamePtr != '\0'; (*keyNamePtr)++) {
1068 if (**keyNamePtr == '\\') {
1069 **keyNamePtr = '\0';
1070 (*keyNamePtr)++;
1071 break;
1072 }
1073 }
1074
1075 /*
1076 * Look for a matching root name.
1077 */
1078
1079 rootObj = Tcl_NewStringObj(rootName, -1);
1080 result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
1081 TCL_EXACT, &index);
1082 Tcl_DecrRefCount(rootObj);
1083 if (result != TCL_OK) {
1084 return TCL_ERROR;
1085 }
1086 *rootKeyPtr = rootKeys[index];
1087 return TCL_OK;
1088 }
1089
1090 /*
1091 *----------------------------------------------------------------------
1092 *
1093 * RecursiveDeleteKey --
1094 *
1095 * This function recursively deletes all the keys below a starting
1096 * key. Although Windows 95 does this automatically, we still need
1097 * to do this for Windows NT.
1098 *
1099 * Results:
1100 * Returns a Windows error code.
1101 *
1102 * Side effects:
1103 * Deletes all of the keys and values below the given key.
1104 *
1105 *----------------------------------------------------------------------
1106 */
1107
1108 static DWORD
1109 RecursiveDeleteKey(
1110 HKEY startKey, /* Parent of key to be deleted. */
1111 char *keyName) /* Name of key to be deleted in external
1112 * encoding, not UTF. */
1113 {
1114 DWORD result, size, maxSize;
1115 Tcl_DString subkey;
1116 HKEY hKey;
1117
1118 /*
1119 * Do not allow NULL or empty key name.
1120 */
1121
1122 if (!keyName || *keyName == '\0') {
1123 return ERROR_BADKEY;
1124 }
1125
1126 result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0,
1127 KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
1128 if (result != ERROR_SUCCESS) {
1129 return result;
1130 }
1131 result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL,
1132 &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
1133 maxSize++;
1134 if (result != ERROR_SUCCESS) {
1135 return result;
1136 }
1137
1138 Tcl_DStringInit(&subkey);
1139 Tcl_DStringSetLength(&subkey,
1140 (regWinProcs->useWide) ? maxSize * 2 : maxSize);
1141
1142 while (result == ERROR_SUCCESS) {
1143 /*
1144 * Always get index 0 because key deletion changes ordering.
1145 */
1146
1147 size = maxSize;
1148 result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
1149 Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
1150 if (result == ERROR_NO_MORE_ITEMS) {
1151 result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName);
1152 break;
1153 } else if (result == ERROR_SUCCESS) {
1154 result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
1155 }
1156 }
1157 Tcl_DStringFree(&subkey);
1158 RegCloseKey(hKey);
1159 return result;
1160 }
1161
1162 /*
1163 *----------------------------------------------------------------------
1164 *
1165 * SetValue --
1166 *
1167 * This function sets the contents of a registry value. If
1168 * the key or value does not exist, it will be created. If it
1169 * does exist, then the data and type will be replaced.
1170 *
1171 * Results:
1172 * Returns a normal Tcl result.
1173 *
1174 * Side effects:
1175 * May create new keys or values.
1176 *
1177 *----------------------------------------------------------------------
1178 */
1179
1180 static int
1181 SetValue(
1182 Tcl_Interp *interp, /* Current interpreter. */
1183 Tcl_Obj *keyNameObj, /* Name of key. */
1184 Tcl_Obj *valueNameObj, /* Name of value to set. */
1185 Tcl_Obj *dataObj, /* Data to be written. */
1186 Tcl_Obj *typeObj) /* Type of data to be written. */
1187 {
1188 DWORD type, result;
1189 HKEY key;
1190 int length;
1191 char *valueName;
1192 Tcl_Obj *resultPtr;
1193 Tcl_DString nameBuf;
1194
1195 if (typeObj == NULL) {
1196 type = REG_SZ;
1197 } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
1198 0, (int *) &type) != TCL_OK) {
1199 if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
1200 return TCL_ERROR;
1201 }
1202 Tcl_ResetResult(interp);
1203 }
1204 if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
1205 return TCL_ERROR;
1206 }
1207
1208 valueName = Tcl_GetStringFromObj(valueNameObj, &length);
1209 valueName = Tcl_WinUtfToTChar(valueName, length, &nameBuf);
1210 resultPtr = Tcl_GetObjResult(interp);
1211
1212 if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
1213 DWORD value;
1214 if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
1215 RegCloseKey(key);
1216 Tcl_DStringFree(&nameBuf);
1217 return TCL_ERROR;
1218 }
1219
1220 value = ConvertDWORD(type, value);
1221 result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1222 (BYTE*) &value, sizeof(DWORD));
1223 } else if (type == REG_MULTI_SZ) {
1224 Tcl_DString data, buf;
1225 int objc, i;
1226 Tcl_Obj **objv;
1227
1228 if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
1229 RegCloseKey(key);
1230 Tcl_DStringFree(&nameBuf);
1231 return TCL_ERROR;
1232 }
1233
1234 /*
1235 * Append the elements as null terminated strings. Note that
1236 * we must not assume the length of the string in case there are
1237 * embedded nulls, which aren't allowed in REG_MULTI_SZ values.
1238 */
1239
1240 Tcl_DStringInit(&data);
1241 for (i = 0; i < objc; i++) {
1242 Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
1243
1244 /*
1245 * Add a null character to separate this value from the next.
1246 * We accomplish this by growing the string by one byte. Since the
1247 * DString always tacks on an extra null byte, the new byte will
1248 * already be set to null.
1249 */
1250
1251 Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
1252 }
1253
1254 Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
1255 &buf);
1256 result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1257 (BYTE *) Tcl_DStringValue(&buf),
1258 (DWORD) Tcl_DStringLength(&buf));
1259 Tcl_DStringFree(&data);
1260 Tcl_DStringFree(&buf);
1261 } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
1262 Tcl_DString buf;
1263 char *data = Tcl_GetStringFromObj(dataObj, &length);
1264
1265 data = Tcl_WinUtfToTChar(data, length, &buf);
1266
1267 /*
1268 * Include the null in the length, padding if needed for Unicode.
1269 */
1270
1271 if (regWinProcs->useWide) {
1272 Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
1273 }
1274 length = Tcl_DStringLength(&buf) + 1;
1275
1276 result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1277 (BYTE*)data, length);
1278 Tcl_DStringFree(&buf);
1279 } else {
1280 char *data;
1281
1282 /*
1283 * Store binary data in the registry.
1284 */
1285
1286 data = Tcl_GetByteArrayFromObj(dataObj, &length);
1287 result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1288 (BYTE *)data, length);
1289 }
1290 Tcl_DStringFree(&nameBuf);
1291 RegCloseKey(key);
1292 if (result != ERROR_SUCCESS) {
1293 Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
1294 AppendSystemError(interp, result);
1295 return TCL_ERROR;
1296 }
1297 return TCL_OK;
1298 }
1299
1300 /*
1301 *----------------------------------------------------------------------
1302 *
1303 * AppendSystemError --
1304 *
1305 * This routine formats a Windows system error message and places
1306 * it into the interpreter result.
1307 *
1308 * Results:
1309 * None.
1310 *
1311 * Side effects:
1312 * None.
1313 *
1314 *----------------------------------------------------------------------
1315 */
1316
1317 static void
1318 AppendSystemError(
1319 Tcl_Interp *interp, /* Current interpreter. */
1320 DWORD error) /* Result code from error. */
1321 {
1322 int length;
1323 WCHAR *wMsgPtr;
1324 char *msg;
1325 char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
1326 Tcl_DString ds;
1327 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1328
1329 length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
1330 | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
1331 MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr,
1332 0, NULL);
1333 if (length == 0) {
1334 char *msgPtr;
1335
1336 length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
1337 | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
1338 MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
1339 0, NULL);
1340 if (length > 0) {
1341 wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
1342 MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
1343 length + 1);
1344 LocalFree(msgPtr);
1345 }
1346 }
1347 if (length == 0) {
1348 if (error == ERROR_CALL_NOT_IMPLEMENTED) {
1349 msg = "function not supported under Win32s";
1350 } else {
1351 sprintf(msgBuf, "unknown error: %d", error);
1352 msg = msgBuf;
1353 }
1354 } else {
1355 Tcl_Encoding encoding;
1356
1357 encoding = Tcl_GetEncoding(NULL, "unicode");
1358 Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
1359 Tcl_FreeEncoding(encoding);
1360 LocalFree(wMsgPtr);
1361
1362 msg = Tcl_DStringValue(&ds);
1363 length = Tcl_DStringLength(&ds);
1364
1365 /*
1366 * Trim the trailing CR/LF from the system message.
1367 */
1368 if (msg[length-1] == '\n') {
1369 msg[--length] = 0;
1370 }
1371 if (msg[length-1] == '\r') {
1372 msg[--length] = 0;
1373 }
1374 }
1375
1376 sprintf(id, "%d", error);
1377 Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL);
1378 Tcl_AppendToObj(resultPtr, msg, length);
1379
1380 if (length != 0) {
1381 Tcl_DStringFree(&ds);
1382 }
1383 }
1384
1385 /*
1386 *----------------------------------------------------------------------
1387 *
1388 * ConvertDWORD --
1389 *
1390 * This function determines whether a DWORD needs to be byte
1391 * swapped, and returns the appropriately swapped value.
1392 *
1393 * Results:
1394 * Returns a converted DWORD.
1395 *
1396 * Side effects:
1397 * None.
1398 *
1399 *----------------------------------------------------------------------
1400 */
1401
1402 static DWORD
1403 ConvertDWORD(
1404 DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
1405 DWORD value) /* The value to be converted. */
1406 {
1407 DWORD order = 1;
1408 DWORD localType;
1409
1410 /*
1411 * Check to see if the low bit is in the first byte.
1412 */
1413
1414 localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
1415 return (type != localType) ? SWAPLONG(value) : value;
1416 }
1417
1418
1419 /* $History: tclwinreg.c $
1420 *
1421 * ***************** Version 1 *****************
1422 * User: Dtashley Date: 1/02/01 Time: 12:27a
1423 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
1424 * Initial check-in.
1425 */
1426
1427 /* End of TCLWINREG.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25