summaryrefslogtreecommitdiffstats
path: root/win/tclWinReg.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinReg.c')
-rw-r--r--win/tclWinReg.c656
1 files changed, 318 insertions, 338 deletions
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index a6ce2ce..5f7fd31 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -12,36 +12,48 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
-#include "tclPort.h"
#ifdef _MSC_VER
# pragma comment (lib, "advapi32.lib")
#endif
#include <stdlib.h>
+#ifndef UNICODE
+# undef Tcl_WinTCharToUtf
+# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+# undef Tcl_WinUtfToTChar
+# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
+#endif /* !UNICODE */
+
/*
- * 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.
+ * Ensure that we can say which registry is being accessed.
*/
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
+#ifndef KEY_WOW64_64KEY
+# define KEY_WOW64_64KEY (0x0100)
+#endif
+#ifndef KEY_WOW64_32KEY
+# define KEY_WOW64_32KEY (0x0200)
+#endif
/*
* The maximum length of a sub-key name.
*/
#ifndef MAX_KEY_LENGTH
-#define MAX_KEY_LENGTH 256
+# define MAX_KEY_LENGTH 256
#endif
/*
* 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
@@ -55,7 +67,7 @@
* system predefined keys.
*/
-static CONST char *rootKeyNames[] = {
+static const char *const rootKeyNames[] = {
"HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
"HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
"HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
@@ -66,7 +78,7 @@ static const HKEY rootKeys[] = {
HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
};
-static CONST char REGISTRY_ASSOC_KEY[] = "registry::command";
+static const char REGISTRY_ASSOC_KEY[] = "registry::command";
/*
* The following table maps from registry types to strings. Note that the
@@ -74,7 +86,7 @@ static CONST char REGISTRY_ASSOC_KEY[] = "registry::command";
* types so we don't need a separate table to hold the mapping.
*/
-static CONST char *typeNames[] = {
+static const char *const typeNames[] = {
"none", "sz", "expand_sz", "binary", "dword",
"dword_big_endian", "link", "multi_sz", "resource_list", NULL
};
@@ -82,100 +94,26 @@ static CONST char *typeNames[] = {
static DWORD lastType = REG_RESOURCE_LIST;
/*
- * The following structures allow us to select between the Unicode and ASCII
- * interfaces at run time based on whether Unicode APIs are available. The
- * Unicode APIs are preferable because they will handle characters outside of
- * the current code page.
- */
-
-typedef struct RegWinProcs {
- int useWide;
-
- LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY);
- LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
- DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
- LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *);
- LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *);
- LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD);
- LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- TCHAR *, DWORD *, FILETIME *);
- LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- DWORD *, BYTE *, DWORD *);
- LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM,
- HKEY *);
- LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
- BYTE *, DWORD *);
- LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD,
- CONST BYTE*, DWORD);
-} RegWinProcs;
-
-static RegWinProcs *regWinProcs;
-
-static RegWinProcs asciiProcs = {
- 0,
-
- (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
- DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
- DWORD *)) RegCreateKeyExA,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- DWORD *, BYTE *, DWORD *)) RegEnumValueA,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
- HKEY *)) RegOpenKeyExA,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
- BYTE *, DWORD *)) RegQueryValueExA,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
- CONST BYTE*, DWORD)) RegSetValueExA,
-};
-
-static RegWinProcs unicodeProcs = {
- 1,
-
- (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
- DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
- DWORD *)) RegCreateKeyExW,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- DWORD *, BYTE *, DWORD *)) RegEnumValueW,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
- HKEY *)) RegOpenKeyExW,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
- BYTE *, DWORD *)) RegQueryValueExW,
- (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
- CONST BYTE*, DWORD)) RegSetValueExW,
-};
-
-
-/*
* Declarations for functions defined in this file.
*/
static void AppendSystemError(Tcl_Interp *interp, DWORD error);
static int BroadcastValue(Tcl_Interp *interp, int objc,
- Tcl_Obj * CONST objv[]);
+ 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,
@@ -185,16 +123,16 @@ 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[]);
+ 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);
+DLLEXPORT int Registry_Init(Tcl_Interp *interp);
+DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
/*
*----------------------------------------------------------------------
@@ -218,25 +156,14 @@ Registry_Init(
{
Tcl_Command cmd;
- if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
return TCL_ERROR;
}
- /*
- * Determine if the unicode interfaces are available and select the
- * appropriate registry function table.
- */
-
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- regWinProcs = &unicodeProcs;
- } else {
- regWinProcs = &asciiProcs;
- }
-
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
- (ClientData)interp, DeleteCmd);
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd);
- return Tcl_PkgProvide(interp, "registry", "1.2.2");
+ interp, DeleteCmd);
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
+ return Tcl_PkgProvide(interp, "registry", "1.3.2");
}
/*
@@ -276,7 +203,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);
}
@@ -306,7 +233,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);
}
/*
@@ -330,89 +258,125 @@ RegistryObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj * CONST objv[]) /* Argument values. */
+ Tcl_Obj *const objv[]) /* Argument values. */
{
- int index;
- char *errString = NULL;
+ int n = 1;
+ int index, argc;
+ REGSAM mode = 0;
+ const char *errString = NULL;
- static CONST char *subcommands[] = {
+ static const char *const subcommands[] = {
"broadcast", "delete", "get", "keys", "set", "type", "values", NULL
};
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 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+1], 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+1], 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+1], 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+1], objv[n+2], NULL,
+ mode);
+ } else if (argc == 4) {
+ return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3],
+ 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+1], 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+1], mode);
}
errString = "keyName ?pattern?";
break;
}
- Tcl_WrongNumArgs(interp, 2, objv, errString);
+ Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString);
return TCL_ERROR;
}
@@ -435,21 +399,22 @@ 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;
+ const TCHAR *nativeTail;
HKEY rootKey, subkey;
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);
+ keyName = Tcl_GetString(keyNameObj);
+ buffer = ckalloc(keyNameObj->length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
@@ -459,8 +424,9 @@ 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));
+ Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
ckfree(buffer);
return TCL_ERROR;
}
@@ -473,15 +439,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;
}
@@ -491,7 +457,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) {
@@ -528,11 +494,12 @@ 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;
- int length;
+ size_t length;
DWORD result;
Tcl_DString ds;
@@ -540,19 +507,20 @@ 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;
}
- valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_GetString(valueNameObj);
+ length = valueNameObj->length;
Tcl_WinUtfToTChar(valueName, length, &ds);
- result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
+ result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to delete value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to delete value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -585,11 +553,13 @@ 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. */
{
- char *pattern; /* Pattern being matched against subkeys */
+ const char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
- TCHAR buffer[MAX_KEY_LENGTH*2]; /* Buffer to hold the subkey name */
+ TCHAR buffer[MAX_KEY_LENGTH];
+ /* Buffer to hold the subkey name */
DWORD bufSize; /* Size of the buffer */
DWORD index; /* Position of the current subkey */
char *name; /* Subkey name */
@@ -603,39 +573,37 @@ 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;
}
- /* Enumerate the subkeys */
+ /*
+ * Enumerate the subkeys.
+ */
resultPtr = Tcl_NewObj();
for (index = 0;; ++index) {
bufSize = MAX_KEY_LENGTH;
- result = (*regWinProcs->regEnumKeyExProc)
- (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL);
+ result = RegEnumKeyEx(key, index, buffer, &bufSize,
+ NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
if (result == ERROR_NO_MORE_ITEMS) {
result = TCL_OK;
} else {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp,
- "unable to enumerate subkeys of \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to enumerate subkeys of \"%s\": ",
+ Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
result = TCL_ERROR;
}
break;
}
- if (regWinProcs->useWide) {
- Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds);
- } else {
- Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds);
- }
+ Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
name = Tcl_DStringValue(&ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
@@ -679,22 +647,22 @@ 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;
- char *valueName;
- CONST char *nativeValue;
- int length;
+ const char *valueName;
+ const TCHAR *nativeValue;
+ size_t length;
/*
* 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;
}
@@ -702,17 +670,18 @@ GetType(
* Get the type of the value.
*/
- valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_GetString(valueNameObj);
+ length = valueNameObj->length;
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
- result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
+ result = RegQueryValueEx(key, nativeValue, NULL, &type,
NULL, NULL);
Tcl_DStringFree(&ds);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to get type of value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to get type of value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -751,20 +720,22 @@ 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;
- char *valueName;
- CONST char *nativeValue;
+ const char *valueName;
+ const TCHAR *nativeValue;
DWORD result, length, type;
Tcl_DString data, buf;
- int nameLen;
+ size_t nameLen;
/*
* 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;
}
@@ -780,12 +751,13 @@ GetValue(
Tcl_DStringInit(&data);
Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
- length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1;
+ length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
- valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
+ valueName = Tcl_GetString(valueNameObj);
+ nameLen = valueNameObj->length;
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
- result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
+ result = RegQueryValueEx(key, nativeValue, NULL, &type,
(BYTE *) Tcl_DStringValue(&data), &length);
while (result == ERROR_MORE_DATA) {
/*
@@ -794,17 +766,17 @@ GetValue(
* HKEY_PERFORMANCE_DATA
*/
- length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2);
- Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1));
- result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
+ length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR));
+ Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
+ result = RegQueryValueEx(key, nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
Tcl_DStringFree(&buf);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to get value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to get value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
Tcl_DStringFree(&data);
return TCL_ERROR;
@@ -819,7 +791,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;
@@ -831,19 +803,17 @@ GetValue(
* we get bogus data.
*/
- while (p < end && ((regWinProcs->useWide)
- ? *((Tcl_UniChar *)p) : *p) != 0) {
+ while ((p < end) && *((WCHAR *) p) != 0) {
+ WCHAR *wp;
+
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;
- while (*up++ != 0) {}
- p = (char*) up;
- } else {
- while (*p++ != '\0') {}
- }
+ wp = (WCHAR *) p;
+
+ while (*wp++ != 0) {/* empty body */}
+ p = (char *) wp;
Tcl_DStringFree(&buf);
}
Tcl_SetObjResult(interp, resultPtr);
@@ -885,27 +855,27 @@ 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;
DWORD index, size, result;
Tcl_DString buffer, ds;
- char *pattern, *name;
+ const char *pattern, *name;
/*
* 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;
}
resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
- Tcl_DStringSetLength(&buffer,
- (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH));
+ Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
index = 0;
result = TCL_OK;
@@ -922,13 +892,9 @@ GetValueNames(
*/
size = MAX_KEY_LENGTH;
- while ((*regWinProcs->regEnumValueProc)(key, index,
- Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
- == ERROR_SUCCESS) {
-
- if (regWinProcs->useWide) {
- size *= 2;
- }
+ while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
+ &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
+ size *= sizeof(TCHAR);
Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
&ds);
@@ -978,12 +944,13 @@ OpenKey(
HKEY *keyPtr) /* Returned HKEY. */
{
char *keyName, *buffer, *hostName;
- int length;
+ size_t length;
HKEY rootKey;
DWORD result;
- keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc((unsigned int) length + 1);
+ keyName = Tcl_GetString(keyNameObj);
+ length = keyNameObj->length;
+ buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -1039,7 +1006,7 @@ OpenSubKey(
if (hostName) {
hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
- result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
+ result = RegConnectRegistry((TCHAR *)hostName, rootKey,
&rootKey);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS) {
@@ -1055,17 +1022,19 @@ OpenSubKey(
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
if (flags & REG_CREATE) {
DWORD create;
- result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL,
+
+ result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
} else if (rootKey == HKEY_PERFORMANCE_DATA) {
/*
* Here we fudge it for this special root key. See MSDN for more info
* on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
*/
+
*keyPtr = HKEY_PERFORMANCE_DATA;
result = ERROR_SUCCESS;
} else {
- result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode,
+ result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
keyPtr);
}
Tcl_DStringFree(&buf);
@@ -1129,8 +1098,9 @@ ParseKeyName(
rootName = name;
}
if (!rootName) {
- Tcl_AppendResult(interp, "bad key \"", name,
- "\": must start with a valid root", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad key \"%s\": must start with a valid root", name));
+ Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
return TCL_ERROR;
}
@@ -1182,12 +1152,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 TCHAR *keyName, /* Name of key to be deleted in external
* encoding, not UTF. */
+ REGSAM mode) /* Mode flags to pass. */
{
DWORD result, size;
Tcl_DString subkey;
HKEY hKey;
+ REGSAM saveMode = mode;
+ static int checkExProc = 0;
+ static FARPROC regDeleteKeyExProc = NULL;
/*
* Do not allow NULL or empty key name.
@@ -1197,29 +1171,50 @@ 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 = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
if (result != ERROR_SUCCESS) {
return result;
}
Tcl_DStringInit(&subkey);
- Tcl_DStringSetLength(&subkey,
- (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH));
+ Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
+ mode = saveMode;
while (result == ERROR_SUCCESS) {
/*
* Always get index 0 because key deletion changes ordering.
*/
size = MAX_KEY_LENGTH;
- result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
- Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
+ result = RegEnumKeyEx(hKey, 0, (TCHAR *)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(TEXT("advapi32.dll"));
+ if (dllH) {
+ regDeleteKeyExProc = (FARPROC)
+ GetProcAddress(dllH, "RegDeleteKeyExW");
+ }
+ }
+ if (mode && regDeleteKeyExProc) {
+ result = regDeleteKeyExProc(startKey, keyName, mode, 0);
+ } else {
+ result = RegDeleteKey(startKey, keyName);
+ }
break;
} else if (result == ERROR_SUCCESS) {
- result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
+ result = RecursiveDeleteKey(hKey,
+ (const TCHAR *) Tcl_DStringValue(&subkey), mode);
}
}
Tcl_DStringFree(&subkey);
@@ -1251,29 +1246,32 @@ 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;
+ size_t length;
DWORD result;
HKEY key;
- int length;
- char *valueName;
+ const char *valueName;
Tcl_DString nameBuf;
if (typeObj == NULL) {
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;
}
- valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_GetString(valueNameObj);
+ length = valueNameObj->length;
valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
@@ -1285,8 +1283,8 @@ SetValue(
return TCL_ERROR;
}
- value = ConvertDWORD((DWORD)type, (DWORD)value);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ value = ConvertDWORD((DWORD) type, (DWORD) value);
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
(DWORD) type, (BYTE *) &value, sizeof(DWORD));
} else if (type == REG_MULTI_SZ) {
Tcl_DString data, buf;
@@ -1307,53 +1305,53 @@ SetValue(
Tcl_DStringInit(&data);
for (i = 0; i < objc; i++) {
- Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
+ const char *bytes = Tcl_GetString(objv[i]);
+
+ length = objv[i]->length;
+ Tcl_DStringAppend(&data, bytes, length);
/*
- * Add a null character to separate this value from the next. We
- * accomplish this by growing the string by one byte. Since the
- * DString always tacks on an extra null byte, the new byte will
- * already be set to null.
+ * Add a null character to separate this value from the next.
*/
- Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
+ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */
}
Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
&buf);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
- (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
+ (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
(DWORD) Tcl_DStringLength(&buf));
Tcl_DStringFree(&data);
Tcl_DStringFree(&buf);
} else if (type == REG_SZ || type == REG_EXPAND_SZ) {
Tcl_DString buf;
- CONST char *data = Tcl_GetStringFromObj(dataObj, &length);
+ const char *data = Tcl_GetString(dataObj);
- data = Tcl_WinUtfToTChar(data, length, &buf);
+ length = dataObj->length;
+ data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
/*
- * Include the null in the length, padding if needed for Unicode.
+ * Include the null in the length, padding if needed for WCHAR.
*/
- if (regWinProcs->useWide) {
- Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
- }
+ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
length = Tcl_DStringLength(&buf) + 1;
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
- (DWORD) type, (BYTE *) data, (DWORD) length);
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
+ (DWORD) type, (BYTE *) data, (DWORD) length);
Tcl_DStringFree(&buf);
} else {
BYTE *data;
+ int bytelength;
/*
* Store binary data in the registry.
*/
- data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
- (DWORD) type, data, (DWORD) length);
+ data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
+ (DWORD) type, data, (DWORD) bytelength);
}
Tcl_DStringFree(&nameBuf);
@@ -1389,35 +1387,33 @@ static int
BroadcastValue(
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument values. */
+ Tcl_Obj *const objv[]) /* Argument values. */
{
LRESULT result;
DWORD_PTR sendResult;
- UINT timeout = 3000;
- int len;
- CONST char *str;
+ int timeout = 3000;
+ size_t len;
+ const char *str;
Tcl_Obj *objPtr;
+ WCHAR *wstr;
+ Tcl_DString ds;
- 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 ((len < 2) || (*str != '-')
- || strncmp(str, "-timeout", (size_t) len)) {
- Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
- return TCL_ERROR;
+ if (objc == 3) {
+ str = Tcl_GetString(objv[1]);
+ len = objv[1]->length;
+ if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
+ return TCL_BREAK;
}
- if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
return TCL_ERROR;
}
}
- str = Tcl_GetStringFromObj(objv[2], &len);
- if (len == 0) {
- str = NULL;
+ str = Tcl_GetString(objv[0]);
+ len = objv[0]->length;
+ wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
+ if (Tcl_DStringLength(&ds) == 0) {
+ wstr = NULL;
}
/*
@@ -1425,11 +1421,12 @@ BroadcastValue(
*/
result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
- (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
+ (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
+ Tcl_DStringFree(&ds);
objPtr = Tcl_NewObj();
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result));
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult));
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
@@ -1458,8 +1455,8 @@ AppendSystemError(
DWORD error) /* Result code from error. */
{
int length;
- WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
- char *msg;
+ TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
+ const char *msg;
char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
Tcl_DString ds;
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
@@ -1467,52 +1464,34 @@ AppendSystemError(
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
}
- length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
+ length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,
0, NULL);
if (length == 0) {
- char *msgPtr;
-
- length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
- | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
- 0, NULL);
- if (length > 0) {
- wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
- MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
- length + 1);
- LocalFree(msgPtr);
- }
- }
- if (length == 0) {
- if (error == ERROR_CALL_NOT_IMPLEMENTED) {
- msg = "function not supported under Win32s";
- } else {
- sprintf(msgBuf, "unknown error: %ld", error);
- msg = msgBuf;
- }
+ sprintf(msgBuf, "unknown error: %ld", error);
+ msg = msgBuf;
} else {
- Tcl_Encoding encoding;
+ char *msgPtr;
- encoding = Tcl_GetEncoding(NULL, "unicode");
- Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
- Tcl_FreeEncoding(encoding);
- LocalFree(wMsgPtr);
+ Tcl_WinTCharToUtf(tMsgPtr, -1, &ds);
+ LocalFree(tMsgPtr);
- msg = Tcl_DStringValue(&ds);
+ msgPtr = Tcl_DStringValue(&ds);
length = Tcl_DStringLength(&ds);
/*
* Trim the trailing CR/LF from the system message.
*/
- if (msg[length-1] == '\n') {
- msg[--length] = 0;
+ if (msgPtr[length-1] == '\n') {
+ --length;
}
- if (msg[length-1] == '\r') {
- msg[--length] = 0;
+ if (msgPtr[length-1] == '\r') {
+ --length;
}
+ msgPtr[length] = 0;
+ msg = msgPtr;
}
sprintf(id, "%ld", error);
@@ -1547,14 +1526,15 @@ ConvertDWORD(
DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
DWORD value) /* The value to be converted. */
{
- DWORD order = 1;
+ const DWORD order = 1;
DWORD localType;
/*
* Check to see if the low bit is in the first byte.
*/
- localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+ localType = (*((const char *) &order) == 1)
+ ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
return (type != localType) ? (DWORD) SWAPLONG(value) : value;
}
generated by cgit v0.12 at 2024-11-17 18:52:14 (GMT)