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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25