summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog12
-rw-r--r--tests/registry.test53
-rw-r--r--win/tclWinReg.c318
3 files changed, 260 insertions, 123 deletions
diff --git a/ChangeLog b/ChangeLog
index 4cd68e5..8614245 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,16 @@
+2010-03-30 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #362 IMPLEMENTATION
+
+ * win/tclWinReg.c: [Patch 2960976]: Apply patch from Damon Courtney to
+ * tests/registry.test: allow the registry command to be told to work
+ with both 32-bit and 64-bit registries.
+
2010-03-29 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4 Only test for -visibility=hidden with gcc
+ * unix/tcl.m4: Only test for -visibility=hidden with gcc
(Second remark in [Bug 2976508])
- * unix/configure regen
+ * unix/configure: regen
2010-03-29 Don Porter <dgp@users.sourceforge.net>
diff --git a/tests/registry.test b/tests/registry.test
index 62c9d84..8a7c4d4 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -10,7 +10,7 @@
# Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
-# RCS: @(#) $Id: registry.test,v 1.24 2008/11/29 14:44:24 patthoyts Exp $
+# RCS: @(#) $Id: registry.test,v 1.25 2010/03/30 12:33:47 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -35,17 +35,32 @@ testConstraint english [expr {
[llength [info commands testlocale]]
&& [string match "English*" [testlocale all ""]]
}]
-
+
test registry-1.1 {argument parsing for registry command} {win reg} {
list [catch {registry} msg] $msg
-} {1 {wrong # args: should be "registry option ?arg ...?"}}
+} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
+test registry-1.1a {argument parsing for registry command} {win reg} {
+ list [catch {registry -32bit} msg] $msg
+} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
+test registry-1.1b {argument parsing for registry command} {win reg} {
+ list [catch {registry -64bit} msg] $msg
+} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.2 {argument parsing for registry command} {win reg} {
list [catch {registry foo} msg] $msg
} {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}}
+test registry-1.2a {argument parsing for registry command} {win reg} {
+ list [catch {registry -33bit foo} msg] $msg
+} {1 {bad option "-33bit": must be broadcast, delete, get, keys, set, type, or values}}
test registry-1.3 {argument parsing for registry command} {win reg} {
list [catch {registry d} msg] $msg
} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
+test registry-1.3a {argument parsing for registry command} {win reg} {
+ list [catch {registry -32bit d} msg] $msg
+} {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}}
+test registry-1.3b {argument parsing for registry command} {win reg} {
+ list [catch {registry -64bit d} msg] $msg
+} {1 {wrong # args: should be "registry -64bit delete keyName ?valueName?"}}
test registry-1.4 {argument parsing for registry command} {win reg} {
list [catch {registry delete} msg] $msg
} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
@@ -56,6 +71,12 @@ test registry-1.5 {argument parsing for registry command} {win reg} {
test registry-1.6 {argument parsing for registry command} {win reg} {
list [catch {registry g} msg] $msg
} {1 {wrong # args: should be "registry get keyName valueName"}}
+test registry-1.6a {argument parsing for registry command} {win reg} {
+ list [catch {registry -32bit g} msg] $msg
+} {1 {wrong # args: should be "registry -32bit get keyName valueName"}}
+test registry-1.6b {argument parsing for registry command} {win reg} {
+ list [catch {registry -64bit g} msg] $msg
+} {1 {wrong # args: should be "registry -64bit get keyName valueName"}}
test registry-1.7 {argument parsing for registry command} {win reg} {
list [catch {registry get} msg] $msg
} {1 {wrong # args: should be "registry get keyName valueName"}}
@@ -69,6 +90,12 @@ test registry-1.9 {argument parsing for registry command} {win reg} {
test registry-1.10 {argument parsing for registry command} {win reg} {
list [catch {registry k} msg] $msg
} {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
+test registry-1.10a {argument parsing for registry command} {win reg} {
+ list [catch {registry -32bit k} msg] $msg
+} {1 {wrong # args: should be "registry -32bit keys keyName ?pattern?"}}
+test registry-1.10b {argument parsing for registry command} {win reg} {
+ list [catch {registry -64bit k} msg] $msg
+} {1 {wrong # args: should be "registry -64bit keys keyName ?pattern?"}}
test registry-1.11 {argument parsing for registry command} {win reg} {
list [catch {registry keys} msg] $msg
} {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
@@ -79,6 +106,12 @@ test registry-1.12 {argument parsing for registry command} {win reg} {
test registry-1.13 {argument parsing for registry command} {win reg} {
list [catch {registry s} msg] $msg
} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
+test registry-1.13a {argument parsing for registry command} {win reg} {
+ list [catch {registry -32bit s} msg] $msg
+} {1 {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}}
+test registry-1.13b {argument parsing for registry command} {win reg} {
+ list [catch {registry -64bit s} msg] $msg
+} {1 {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}}
test registry-1.14 {argument parsing for registry command} {win reg} {
list [catch {registry set} msg] $msg
} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
@@ -92,6 +125,12 @@ test registry-1.16 {argument parsing for registry command} {win reg} {
test registry-1.17 {argument parsing for registry command} {win reg} {
list [catch {registry t} msg] $msg
} {1 {wrong # args: should be "registry type keyName valueName"}}
+test registry-1.17a {argument parsing for registry command} {win reg} {
+ list [catch {registry -32bit t} msg] $msg
+} {1 {wrong # args: should be "registry -32bit type keyName valueName"}}
+test registry-1.17b {argument parsing for registry command} {win reg} {
+ list [catch {registry -64bit t} msg] $msg
+} {1 {wrong # args: should be "registry -64bit type keyName valueName"}}
test registry-1.18 {argument parsing for registry command} {win reg} {
list [catch {registry type} msg] $msg
} {1 {wrong # args: should be "registry type keyName valueName"}}
@@ -105,6 +144,12 @@ test registry-1.20 {argument parsing for registry command} {win reg} {
test registry-1.21 {argument parsing for registry command} {win reg} {
list [catch {registry v} msg] $msg
} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
+test registry-1.21a {argument parsing for registry command} {win reg} {
+ list [catch {registry -32bit v} msg] $msg
+} {1 {wrong # args: should be "registry -32bit values keyName ?pattern?"}}
+test registry-1.21b {argument parsing for registry command} {win reg} {
+ list [catch {registry -64bit v} msg] $msg
+} {1 {wrong # args: should be "registry -64bit values keyName ?pattern?"}}
test registry-1.22 {argument parsing for registry command} {win reg} {
list [catch {registry values} msg] $msg
} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
@@ -630,7 +675,7 @@ test registry-12.4 {BroadcastValue} -constraints {win reg} -body {
test registry-12.5 {BroadcastValue} -constraints {win reg} -body {
registry b {}
} -result {1 0}
-
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 195afd2..d5e1a28 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinReg.c,v 1.50 2010/01/10 22:58:40 nijtmans Exp $
+ * RCS: @(#) $Id: tclWinReg.c,v 1.51 2010/03/30 12:33:47 dkf Exp $
*/
#undef STATIC_BUILD
@@ -25,6 +25,17 @@
#include <stdlib.h>
/*
+ * Ensure that we can say which registry is being accessed.
+ */
+
+#ifndef KEY_WOW64_64KEY
+#define KEY_WOW64_64KEY (0x0100)
+#endif
+#ifndef KEY_WOW64_32KEY
+#define KEY_WOW64_32KEY (0x0200)
+#endif
+
+/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
* Registry_Init declaration is in the source file itself, which is only
* accessed when we are building a library.
@@ -37,8 +48,8 @@
* The following macros convert between different endian ints.
*/
-#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
-#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
+#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
+#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
/*
* The following flag is used in OpenKeys to indicate that the specified key
@@ -171,17 +182,18 @@ static int BroadcastValue(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static DWORD ConvertDWORD(DWORD type, DWORD value);
static void DeleteCmd(ClientData clientData);
-static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
+static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+ REGSAM mode);
static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj);
+ Tcl_Obj *valueNameObj, REGSAM mode);
static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj);
+ Tcl_Obj *patternObj, REGSAM mode);
static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj);
+ Tcl_Obj *valueNameObj, REGSAM mode);
static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj);
+ Tcl_Obj *valueNameObj, REGSAM mode);
static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj);
+ Tcl_Obj *patternObj, REGSAM mode);
static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
REGSAM mode, int flags, HKEY *keyPtr);
static DWORD OpenSubKey(char *hostName, HKEY rootKey,
@@ -191,13 +203,13 @@ static int ParseKeyName(Tcl_Interp *interp, char *name,
char **hostNamePtr, HKEY *rootKeyPtr,
char **keyNamePtr);
static DWORD RecursiveDeleteKey(HKEY hStartKey,
- const TCHAR * pKeyName);
+ const TCHAR * pKeyName, REGSAM mode);
static int RegistryObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
- Tcl_Obj *typeObj);
+ Tcl_Obj *typeObj, REGSAM mode);
EXTERN int Registry_Init(Tcl_Interp *interp);
EXTERN int Registry_Unload(Tcl_Interp *interp, int flags);
@@ -235,11 +247,11 @@ Registry_Init(
*/
useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS);
- regWinProcs = useWide ? &unicodeProcs : &asciiProcs;
+ regWinProcs = useWide ? &unicodeProcs : &asciiProcs;
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
- (ClientData)interp, DeleteCmd);
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd);
+ interp, DeleteCmd);
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
return Tcl_PkgProvide(interp, "registry", "1.2.1");
}
@@ -280,7 +292,7 @@ Registry_Unload(
* Delete the originally registered command.
*/
- cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
+ cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
if (cmd != NULL) {
Tcl_DeleteCommandFromToken(interp, cmd);
}
@@ -310,7 +322,8 @@ DeleteCmd(
ClientData clientData)
{
Tcl_Interp *interp = clientData;
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL);
+
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL);
}
/*
@@ -336,7 +349,9 @@ RegistryObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
- int index;
+ int n = 1;
+ int index, argc;
+ REGSAM mode = 0;
const char *errString = NULL;
static const char *const subcommands[] = {
@@ -345,78 +360,112 @@ RegistryObjCmd(
enum SubCmdIdx {
BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
};
+ static const char *const modes[] = {
+ "-32bit", "-64bit", NULL
+ };
if (objc < 2) {
- Tcl_WrongNumArgs(interp, objc, objv, "option ?arg ...?");
+ wrongArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
- != TCL_OK) {
+ if (Tcl_GetString(objv[n])[0] == '-') {
+ if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case 0: /* -32bit */
+ mode |= KEY_WOW64_32KEY;
+ break;
+ case 1: /* -64bit */
+ mode |= KEY_WOW64_64KEY;
+ break;
+ }
+ if (objc < 3) {
+ goto wrongArgs;
+ }
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
+ argc = (objc - n);
switch (index) {
case BroadcastIdx: /* broadcast */
- return BroadcastValue(interp, objc, objv);
+ if (argc == 1 || argc == 3) {
+ int res = BroadcastValue(interp, argc, objv + n);
+
+ if (res != TCL_BREAK) {
+ return res;
+ }
+ }
+ errString = "keyName ?-timeout milliseconds?";
break;
case DeleteIdx: /* delete */
- if (objc == 3) {
- return DeleteKey(interp, objv[2]);
- } else if (objc == 4) {
- return DeleteValue(interp, objv[2], objv[3]);
+ if (argc == 1) {
+ return DeleteKey(interp, objv[n], mode);
+ } else if (argc == 2) {
+ return DeleteValue(interp, objv[n], objv[++n], mode);
}
errString = "keyName ?valueName?";
break;
case GetIdx: /* get */
- if (objc == 4) {
- return GetValue(interp, objv[2], objv[3]);
+ if (argc == 2) {
+ return GetValue(interp, objv[n], objv[++n], mode);
}
errString = "keyName valueName";
break;
case KeysIdx: /* keys */
- if (objc == 3) {
- return GetKeyNames(interp, objv[2], NULL);
- } else if (objc == 4) {
- return GetKeyNames(interp, objv[2], objv[3]);
+ if (argc == 1) {
+ return GetKeyNames(interp, objv[n], NULL, mode);
+ } else if (argc == 2) {
+ return GetKeyNames(interp, objv[n], objv[++n], mode);
}
errString = "keyName ?pattern?";
break;
case SetIdx: /* set */
- if (objc == 3) {
+ if (argc == 1) {
HKEY key;
/*
* Create the key and then close it immediately.
*/
- if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
+ mode |= KEY_ALL_ACCESS;
+ if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) {
return TCL_ERROR;
}
RegCloseKey(key);
return TCL_OK;
- } else if (objc == 5 || objc == 6) {
- Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
- return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
+ } else if (argc == 3) {
+ return SetValue(interp, objv[n], objv[++n], objv[++n], NULL,
+ mode);
+ } else if (argc == 4) {
+ return SetValue(interp, objv[n], objv[++n], objv[++n], objv[++n],
+ mode);
}
errString = "keyName ?valueName data ?type??";
break;
case TypeIdx: /* type */
- if (objc == 4) {
- return GetType(interp, objv[2], objv[3]);
+ if (argc == 2) {
+ return GetType(interp, objv[n], objv[++n], mode);
}
errString = "keyName valueName";
break;
case ValuesIdx: /* values */
- if (objc == 3) {
- return GetValueNames(interp, objv[2], NULL);
- } else if (objc == 4) {
- return GetValueNames(interp, objv[2], objv[3]);
+ if (argc == 1) {
+ return GetValueNames(interp, objv[n], NULL, mode);
+ } else if (argc == 2) {
+ return GetValueNames(interp, objv[n], objv[++n], mode);
}
errString = "keyName ?pattern?";
break;
}
- Tcl_WrongNumArgs(interp, 2, objv, errString);
+ Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString);
return TCL_ERROR;
}
@@ -439,7 +488,8 @@ RegistryObjCmd(
static int
DeleteKey(
Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj) /* Name of key to delete. */
+ Tcl_Obj *keyNameObj, /* Name of key to delete. */
+ REGSAM mode) /* Mode flags to pass. */
{
char *tail, *buffer, *hostName, *keyName;
const char *nativeTail;
@@ -447,13 +497,14 @@ DeleteKey(
DWORD result;
int length;
Tcl_DString buf;
+ REGSAM saveMode = mode;
/*
* Find the parent of the key being deleted and open it.
*/
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc((unsigned int) length + 1);
+ buffer = ckalloc((unsigned) length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
@@ -463,8 +514,8 @@ DeleteKey(
}
if (*keyName == '\0') {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "bad key: cannot delete root keys", -1));
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("bad key: cannot delete root keys", -1));
ckfree(buffer);
return TCL_ERROR;
}
@@ -477,15 +528,15 @@ DeleteKey(
keyName = NULL;
}
- result = OpenSubKey(hostName, rootKey, keyName,
- KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
+ mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
+ result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
if (result != ERROR_SUCCESS) {
ckfree(buffer);
if (result == ERROR_FILE_NOT_FOUND) {
return TCL_OK;
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unable to delete key: ", -1));
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("unable to delete key: ", -1));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -495,7 +546,7 @@ DeleteKey(
*/
nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf);
- result = RecursiveDeleteKey(subkey, nativeTail);
+ result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
@@ -532,7 +583,8 @@ static int
DeleteValue(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj) /* Name of value to delete. */
+ Tcl_Obj *valueNameObj, /* Name of value to delete. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
char *valueName;
@@ -544,8 +596,8 @@ DeleteValue(
* Attempt to open the key for deletion.
*/
- if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key)
- != TCL_OK) {
+ mode |= KEY_SET_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -589,9 +641,10 @@ static int
GetKeyNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj) /* Optional match pattern. */
+ Tcl_Obj *patternObj, /* Optional match pattern. */
+ REGSAM mode) /* Mode flags to pass. */
{
- const char *pattern; /* Pattern being matched against subkeys */
+ const char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
DWORD subKeyCount; /* Number of subkeys to list */
DWORD maxSubKeyLen; /* Maximum string length of any subkey */
@@ -609,26 +662,26 @@ GetKeyNames(
pattern = NULL;
}
- /* Attempt to open the key for enumeration. */
+ /*
+ * Attempt to open the key for enumeration.
+ */
- if (OpenKey(interp, keyNameObj,
- KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS,
- 0, &key) != TCL_OK) {
+ mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
/*
- * Determine how big a buffer is needed for enumerating subkeys, and
- * how many subkeys there are
+ * Determine how big a buffer is needed for enumerating subkeys, and how
+ * many subkeys there are.
*/
- result = (*regWinProcs->regQueryInfoKeyProc)
- (key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL,
- NULL, NULL, NULL, NULL);
+ result = regWinProcs->regQueryInfoKeyProc(key, NULL, NULL, NULL,
+ &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp, Tcl_NewObj());
Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
RegCloseKey(key);
return TCL_ERROR;
@@ -639,19 +692,19 @@ GetKeyNames(
buffer = ckalloc(maxSubKeyLen+1);
}
- /* Enumerate the subkeys */
+ /*
+ * Enumerate the subkeys.
+ */
resultPtr = Tcl_NewObj();
for (index = 0; index < subKeyCount; ++index) {
bufSize = maxSubKeyLen+1;
- result = (*regWinProcs->regEnumKeyExProc)
- (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL);
+ result = regWinProcs->regEnumKeyExProc(key, index, buffer, &bufSize,
+ NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp,
- "unable to enumerate subkeys of \"",
- Tcl_GetString(keyNameObj),
- "\": ", NULL);
+ Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
result = TCL_ERROR;
break;
@@ -703,11 +756,11 @@ static int
GetType(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj) /* Name of value to get. */
+ Tcl_Obj *valueNameObj, /* Name of value to get. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
- DWORD result;
- DWORD type;
+ DWORD result, type;
Tcl_DString ds;
const char *valueName, *nativeValue;
int length;
@@ -716,8 +769,8 @@ GetType(
* Attempt to open the key for reading.
*/
- if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
- != TCL_OK) {
+ mode |= KEY_QUERY_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -774,7 +827,8 @@ static int
GetValue(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj) /* Name of value to get. */
+ Tcl_Obj *valueNameObj, /* Name of value to get. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
const char *valueName, *nativeValue;
@@ -786,7 +840,8 @@ GetValue(
* Attempt to open the key for reading.
*/
- if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) {
+ mode |= KEY_QUERY_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -841,7 +896,7 @@ GetValue(
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type,
- *((DWORD*) Tcl_DStringValue(&data)))));
+ *((DWORD *) Tcl_DStringValue(&data)))));
} else if (type == REG_MULTI_SZ) {
char *p = Tcl_DStringValue(&data);
char *end = Tcl_DStringValue(&data) + length;
@@ -853,16 +908,17 @@ GetValue(
* we get bogus data.
*/
- while (p < end && ((regWinProcs->useWide)
- ? *((Tcl_UniChar *)p) : *p) != 0) {
+ while ((p < end)
+ && (regWinProcs->useWide ? *((Tcl_UniChar *) p) : *p) != 0) {
Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf)));
if (regWinProcs->useWide) {
- Tcl_UniChar* up = (Tcl_UniChar*) p;
+ Tcl_UniChar *up = (Tcl_UniChar *) p;
+
while (*up++ != 0) {}
- p = (char*) up;
+ p = (char *) up;
} else {
while (*p++ != '\0') {}
}
@@ -907,7 +963,8 @@ static int
GetValueNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj) /* Optional match pattern. */
+ Tcl_Obj *patternObj, /* Optional match pattern. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
Tcl_Obj *resultPtr;
@@ -919,8 +976,8 @@ GetValueNames(
* Attempt to open the key for enumeration.
*/
- if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
- != TCL_OK) {
+ mode |= KEY_QUERY_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -944,7 +1001,7 @@ GetValueNames(
resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
Tcl_DStringSetLength(&buffer,
- (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize));
+ (int) (regWinProcs->useWide ? maxSize*2 : maxSize));
index = 0;
result = TCL_OK;
@@ -1022,7 +1079,7 @@ OpenKey(
DWORD result;
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc((unsigned int) length + 1);
+ buffer = ckalloc((unsigned) length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -1223,12 +1280,16 @@ ParseKeyName(
static DWORD
RecursiveDeleteKey(
HKEY startKey, /* Parent of key to be deleted. */
- const char *keyName) /* Name of key to be deleted in external
+ const char *keyName, /* Name of key to be deleted in external
* encoding, not UTF. */
+ REGSAM mode) /* Mode flags to pass. */
{
DWORD result, size, maxSize;
Tcl_DString subkey;
HKEY hKey;
+ REGSAM saveMode = mode;
+ static int checkExProc = 0;
+ static FARPROC regDeleteKeyExProc = NULL;
/*
* Do not allow NULL or empty key name.
@@ -1238,8 +1299,8 @@ RecursiveDeleteKey(
return ERROR_BADKEY;
}
- result = regWinProcs->regOpenKeyExProc(startKey, keyName, 0,
- KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
+ mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
+ result = regWinProcs->regOpenKeyExProc(startKey, keyName, 0, mode, &hKey);
if (result != ERROR_SUCCESS) {
return result;
}
@@ -1254,6 +1315,7 @@ RecursiveDeleteKey(
Tcl_DStringSetLength(&subkey,
(int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize));
+ mode = saveMode;
while (result == ERROR_SUCCESS) {
/*
* Always get index 0 because key deletion changes ordering.
@@ -1263,10 +1325,36 @@ RecursiveDeleteKey(
result = regWinProcs->regEnumKeyExProc(hKey, 0,
Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
if (result == ERROR_NO_MORE_ITEMS) {
- result = regWinProcs->regDeleteKeyProc(startKey, keyName);
+ /*
+ * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we
+ * can't compile with it in. We need to check for it at runtime
+ * and use it if we find it.
+ */
+
+ if (mode && !checkExProc) {
+ HINSTANCE dllH;
+
+ checkExProc = 1;
+ dllH = LoadLibrary("advapi32.dll");
+ if (dllH) {
+ if (regWinProcs->useWide) {
+ regDeleteKeyExProc = (FARPROC)
+ GetProcAddress(dllH, "RegDeleteKeyExW");
+ } else {
+ regDeleteKeyExProc = (FARPROC)
+ GetProcAddress(dllH, "RegDeleteKeyExA");
+ }
+ }
+ }
+ if (mode && regDeleteKeyExProc) {
+ result = regDeleteKeyExProc(startKey, keyName, mode, 0);
+ } else {
+ result = regWinProcs->regDeleteKeyProc(startKey, keyName);
+ }
break;
} else if (result == ERROR_SUCCESS) {
- result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
+ result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey),
+ mode);
}
}
Tcl_DStringFree(&subkey);
@@ -1298,12 +1386,12 @@ SetValue(
Tcl_Obj *keyNameObj, /* Name of key. */
Tcl_Obj *valueNameObj, /* Name of value to set. */
Tcl_Obj *dataObj, /* Data to be written. */
- Tcl_Obj *typeObj) /* Type of data to be written. */
+ Tcl_Obj *typeObj, /* Type of data to be written. */
+ REGSAM mode) /* Mode flags to pass. */
{
- int type;
+ int type, length;
DWORD result;
HKEY key;
- int length;
const char *valueName;
Tcl_DString nameBuf;
@@ -1311,12 +1399,13 @@ SetValue(
type = REG_SZ;
} else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
0, (int *) &type) != TCL_OK) {
- if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
+ if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
return TCL_ERROR;
}
Tcl_ResetResult(interp);
}
- if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
+ mode |= KEY_ALL_ACCESS;
+ if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -1369,7 +1458,7 @@ SetValue(
Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
&buf);
result = regWinProcs->regSetValueExProc(key, valueName, 0,
- (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
+ (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
(DWORD) Tcl_DStringLength(&buf));
Tcl_DStringFree(&data);
Tcl_DStringFree(&buf);
@@ -1389,7 +1478,7 @@ SetValue(
length = Tcl_DStringLength(&buf) + 1;
result = regWinProcs->regSetValueExProc(key, valueName, 0,
- (DWORD) type, (BYTE *) data, (DWORD) length);
+ (DWORD) type, (BYTE *) data, (DWORD) length);
Tcl_DStringFree(&buf);
} else {
BYTE *data;
@@ -1400,7 +1489,7 @@ SetValue(
data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
result = regWinProcs->regSetValueExProc(key, valueName, 0,
- (DWORD) type, data, (DWORD) length);
+ (DWORD) type, data, (DWORD) length);
}
Tcl_DStringFree(&nameBuf);
@@ -1445,24 +1534,18 @@ BroadcastValue(
const char *str;
Tcl_Obj *objPtr;
- if ((objc != 3) && (objc != 5)) {
- Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
- return TCL_ERROR;
- }
-
- if (objc > 3) {
- str = Tcl_GetStringFromObj(objv[3], &len);
+ if (objc == 3) {
+ str = Tcl_GetStringFromObj(objv[1], &len);
if ((len < 2) || (*str != '-')
|| strncmp(str, "-timeout", (size_t) len)) {
- Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
- return TCL_ERROR;
+ return TCL_BREAK;
}
- if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[2], (int *) &timeout) != TCL_OK) {
return TCL_ERROR;
}
}
- str = Tcl_GetStringFromObj(objv[2], &len);
+ str = Tcl_GetStringFromObj(objv[0], &len);
if (len == 0) {
str = NULL;
}
@@ -1526,7 +1609,8 @@ AppendSystemError(
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
0, NULL);
if (length > 0) {
- wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
+ wMsgPtr = (WCHAR *)
+ LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
length + 1);
LocalFree(msgPtr);
@@ -1604,7 +1688,7 @@ ConvertDWORD(
* Check to see if the low bit is in the first byte.
*/
- localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+ localType = (*((char *) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
return (type != localType) ? (DWORD) SWAPLONG(value) : value;
}