diff options
Diffstat (limited to 'win/tclWinReg.c')
-rw-r--r-- | win/tclWinReg.c | 420 |
1 files changed, 319 insertions, 101 deletions
diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 0f892df..479435c 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -1,4 +1,4 @@ -/* +/* * tclWinReg.c -- * * This file contains the implementation of the "registry" Tcl @@ -6,14 +6,15 @@ * loadable extension in a separate DLL. * * Copyright (c) 1997 by Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * 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.8 1999/03/10 05:52:53 stanton Exp $ + * RCS: @(#) $Id: tclWinReg.c,v 1.9 1999/04/16 00:48:09 stanton Exp $ */ -#include <tcl.h> +#include <tclPort.h> #include <stdlib.h> #define WIN32_LEAN_AND_MEAN @@ -35,7 +36,7 @@ #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 should be created if it doesn't currently exist. @@ -67,12 +68,95 @@ static HKEY rootKeys[] = { */ static char *typeNames[] = { - "none", "sz", "expand_sz", "binary", "dword", + "none", "sz", "expand_sz", "binary", "dword", "dword_big_endian", "link", "multi_sz", "resource_list", NULL }; 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)(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 *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *, + DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, + FILETIME *); + 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 *)(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, TCHAR *, DWORD *, DWORD *, + DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, + FILETIME *)) RegQueryInfoKeyA, + (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 *)(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, TCHAR *, DWORD *, DWORD *, + DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, + FILETIME *)) RegQueryInfoKeyW, + (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. @@ -99,15 +183,15 @@ static DWORD OpenSubKey(char *hostName, HKEY rootKey, static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); -static DWORD RecursiveDeleteKey(HKEY hStartKey, LPTSTR pKeyName); +static DWORD RecursiveDeleteKey(HKEY hStartKey, TCHAR * pKeyName); static int RegistryObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]); + 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); EXTERN int Registry_Init(Tcl_Interp *interp); - /* *---------------------------------------------------------------------- @@ -129,9 +213,26 @@ int Registry_Init( Tcl_Interp *interp) { + OSVERSIONINFO os; + if (!Tcl_InitStubs(interp, "8.0", 0)) { return TCL_ERROR; } + + /* + * Determine if the unicode interfaces are available and select the + * appropriate registry function table. + */ + + os.dwOSVersionInfoSize = sizeof(os); + GetVersionEx(&os); + + if (os.dwPlatformId == VER_PLATFORM_WIN32_NT) { + regWinProcs = &unicodeProcs; + } else { + regWinProcs = &asciiProcs; + } + Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL); return Tcl_PkgProvide(interp, "registry", "1.0"); } @@ -264,6 +365,7 @@ DeleteKey( DWORD result; int length; Tcl_Obj *resultPtr; + Tcl_DString buf; /* * Find the parent of the key being deleted and open it. @@ -311,7 +413,9 @@ DeleteKey( * Now we recursively delete the key and everything below it. */ + tail = Tcl_WinUtfToTChar(tail, -1, &buf); result = RecursiveDeleteKey(subkey, tail); + Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1); @@ -353,7 +457,8 @@ DeleteValue( int length; DWORD result; Tcl_Obj *resultPtr; - + Tcl_DString ds; + /* * Attempt to open the key for deletion. */ @@ -365,11 +470,13 @@ DeleteValue( resultPtr = Tcl_GetObjResult(interp); valueName = Tcl_GetStringFromObj(valueNameObj, &length); - result = RegDeleteValue(key, valueName); + Tcl_WinUtfToTChar(valueName, length, &ds); + result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"", - Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"", - Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL); + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -406,9 +513,10 @@ GetKeyNames( { HKEY key; DWORD index; - char buffer[MAX_PATH+1], *pattern; + char buffer[MAX_PATH+1], *pattern, *name; Tcl_Obj *resultPtr; int result = TCL_OK; + Tcl_DString ds; /* * Attempt to open the key for enumeration. @@ -420,7 +528,7 @@ GetKeyNames( } if (patternObj) { - pattern = Tcl_GetStringFromObj(patternObj, NULL); + pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } @@ -431,13 +539,17 @@ GetKeyNames( */ resultPtr = Tcl_GetObjResult(interp); - for (index = 0; RegEnumKey(key, index, buffer, MAX_PATH+1) - == ERROR_SUCCESS; index++) { - if (pattern && !Tcl_StringMatch(buffer, pattern)) { + for (index = 0; (*regWinProcs->regEnumKeyProc)(key, index, buffer, + MAX_PATH+1) == ERROR_SUCCESS; index++) { + Tcl_WinTCharToUtf((TCHAR *) buffer, -1, &ds); + name = Tcl_DStringValue(&ds); + if (pattern && !Tcl_StringMatch(name, pattern)) { + Tcl_DStringFree(&ds); continue; } result = Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(buffer, -1)); + Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); + Tcl_DStringFree(&ds); if (result != TCL_OK) { break; } @@ -474,7 +586,10 @@ GetType( Tcl_Obj *resultPtr; DWORD result; DWORD type; - + Tcl_DString ds; + char *valueName; + int length; + /* * Attempt to open the key for reading. */ @@ -490,14 +605,17 @@ GetType( resultPtr = Tcl_GetObjResult(interp); - result = RegQueryValueEx(key, Tcl_GetStringFromObj(valueNameObj, NULL), - NULL, &type, NULL, NULL); + valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_WinUtfToTChar(valueName, length, &ds); + result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type, + NULL, NULL); + Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"", - Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"", - Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL); + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); return TCL_ERROR; } @@ -543,7 +661,8 @@ GetValue( char *valueName; DWORD result, length, type; Tcl_Obj *resultPtr; - Tcl_DString data; + Tcl_DString data, buf; + int nameLen; /* * Attempt to open the key for reading. @@ -558,30 +677,34 @@ GetValue( * Initialize a Dstring to maximum statically allocated size * we could get one more byte by avoiding Tcl_DStringSetLength() * and just setting length to TCL_DSTRING_STATIC_SIZE, but this - * should be safer if the implementation Dstrings changes. + * should be safer if the implementation of Dstrings changes. * * This allows short values to be read from the registy in one call. * Longer values need a second call with an expanded DString. */ Tcl_DStringInit(&data); - Tcl_DStringSetLength(&data, length = TCL_DSTRING_STATIC_SIZE - 1); + length = TCL_DSTRING_STATIC_SIZE - 1; + Tcl_DStringSetLength(&data, length); resultPtr = Tcl_GetObjResult(interp); - - valueName = Tcl_GetStringFromObj(valueNameObj, NULL); - result = RegQueryValueEx(key, valueName, NULL, &type, - (LPBYTE) Tcl_DStringValue(&data), &length); + + valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); + valueName = Tcl_WinUtfToTChar(valueName, nameLen, &buf); + + result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type, + (BYTE *) Tcl_DStringValue(&data), &length); if (result == ERROR_MORE_DATA) { Tcl_DStringSetLength(&data, length); - result = RegQueryValueEx(key, valueName, NULL, &type, - (LPBYTE) Tcl_DStringValue(&data), &length); + result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, + &type, (BYTE *) Tcl_DStringValue(&data), &length); } + Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_AppendStringsToObj(resultPtr, "unable to get value \"", - Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"", - Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL); + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -599,23 +722,38 @@ GetValue( *((DWORD*) Tcl_DStringValue(&data)))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); - char *lastChar = Tcl_DStringValue(&data) + Tcl_DStringLength(&data); + char *end = Tcl_DStringValue(&data) + length; /* * Multistrings are stored as an array of null-terminated strings, * terminated by two null characters. Also do a bounds check in * case we get bogus data. */ - - while (p < lastChar && *p != '\0') { + + while (p < end && ((regWinProcs->useWide) + ? *((Tcl_UniChar *)p) : *p) != 0) { + Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(p, -1)); - while (*p++ != '\0') {} + Tcl_NewStringObj(Tcl_DStringValue(&buf), + Tcl_DStringLength(&buf))); + if (regWinProcs->useWide) { + while (*((Tcl_UniChar *)p)++ != 0) {} + } else { + while (*p++ != '\0') {} + } + Tcl_DStringFree(&buf); } } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { - Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), -1); + Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); + Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buf), + Tcl_DStringLength(&buf)); + Tcl_DStringFree(&buf); } else { - Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), length); + /* + * Save binary data as a byte array. + */ + + Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), length); } Tcl_DStringFree(&data); return result; @@ -648,9 +786,9 @@ GetValueNames( { HKEY key; Tcl_Obj *resultPtr; - DWORD index, size, result; - Tcl_DString buffer; - char *pattern; + DWORD index, size, maxSize, result; + Tcl_DString buffer, ds; + char *pattern, *name; /* * Attempt to open the key for enumeration. @@ -668,26 +806,27 @@ GetValueNames( * largest value name plus the terminating null. */ - result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL, NULL, NULL, &index, - &size, NULL, NULL, NULL); + result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL, + NULL, NULL, &index, &maxSize, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { Tcl_AppendStringsToObj(resultPtr, "unable to query key \"", - Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL); + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); RegCloseKey(key); result = TCL_ERROR; goto done; } - size++; + maxSize++; Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, size); + Tcl_DStringSetLength(&buffer, + (regWinProcs->useWide) ? maxSize*2 : maxSize); index = 0; result = TCL_OK; if (patternObj) { - pattern = Tcl_GetStringFromObj(patternObj, NULL); + pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } @@ -698,17 +837,29 @@ GetValueNames( * after each iteration because RegEnumValue smashes the old value. */ - while (RegEnumValue(key, index, Tcl_DStringValue(&buffer), &size, NULL, - NULL, NULL, NULL) == ERROR_SUCCESS) { - if (!pattern || Tcl_StringMatch(Tcl_DStringValue(&buffer), pattern)) { + size = maxSize; + while ((*regWinProcs->regEnumValueProc)(key, index, + Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) + == ERROR_SUCCESS) { + + if (regWinProcs->useWide) { + size *= 2; + } + + Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), size, &ds); + name = Tcl_DStringValue(&ds); + if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(Tcl_DStringValue(&buffer), size)); + Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); if (result != TCL_OK) { + Tcl_DStringFree(&ds); break; } } + Tcl_DStringFree(&ds); + index++; - size = Tcl_DStringLength(&buffer); + size = maxSize; } Tcl_DStringFree(&buffer); @@ -797,13 +948,17 @@ OpenSubKey( HKEY *keyPtr) /* Returned HKEY. */ { DWORD result; + Tcl_DString buf; /* * Attempt to open the root key on a remote host if necessary. */ if (hostName) { - result = RegConnectRegistry(hostName, rootKey, &rootKey); + hostName = Tcl_WinUtfToTChar(hostName, -1, &buf); + result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey, + &rootKey); + Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { return result; } @@ -814,13 +969,16 @@ OpenSubKey( * that this key must be closed by the caller. */ + keyName = Tcl_WinUtfToTChar(keyName, -1, &buf); if (flags & REG_CREATE) { DWORD create; - result = RegCreateKeyEx(rootKey, keyName, 0, "", + result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, "", REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else { - result = RegOpenKeyEx(rootKey, keyName, 0, mode, keyPtr); + result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode, + keyPtr); } + Tcl_DStringFree(&buf); /* * Be sure to close the root key since we are done with it now. @@ -829,7 +987,7 @@ OpenSubKey( if (hostName) { RegCloseKey(rootKey); } - return result; + return result; } /* @@ -838,7 +996,7 @@ OpenSubKey( * ParseKeyName -- * * This function parses a key name into the host, root, and subkey - * parts. + * parts. * * Results: * The pointers to the start of the host and subkey names are @@ -937,9 +1095,10 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - char *keyName) /* Name of key to be deleted. */ + char *keyName) /* Name of key to be deleted in external + * encoding, not UTF. */ { - DWORD result, subKeyLength; + DWORD result, size, maxSize; Tcl_DString subkey; HKEY hKey; @@ -947,35 +1106,36 @@ RecursiveDeleteKey( * Do not allow NULL or empty key name. */ - if (!keyName || lstrlen(keyName) == '\0') { + if (!keyName || *keyName == '\0') { return ERROR_BADKEY; } - result = RegOpenKeyEx(startKey, keyName, 0, + result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0, KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey); if (result != ERROR_SUCCESS) { return result; } - result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL, &subKeyLength, - NULL, NULL, NULL, NULL, NULL, NULL); - subKeyLength++; + result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL, + &maxSize, NULL, NULL, NULL, NULL, NULL, NULL); + maxSize++; if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, subKeyLength); + Tcl_DStringSetLength(&subkey, + (regWinProcs->useWide) ? maxSize * 2 : maxSize); while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ - subKeyLength = Tcl_DStringLength(&subkey); - result=RegEnumKeyEx(hKey, 0, Tcl_DStringValue(&subkey), &subKeyLength, - NULL, NULL, NULL, NULL); + size = maxSize; + result=(*regWinProcs->regEnumKeyExProc)(hKey, 0, + Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { - result = RegDeleteKey(startKey, keyName); + result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName); break; } else if (result == ERROR_SUCCESS) { result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey)); @@ -1017,6 +1177,7 @@ SetValue( int length; char *valueName; Tcl_Obj *resultPtr; + Tcl_DString nameBuf; if (typeObj == NULL) { type = REG_SZ; @@ -1032,26 +1193,28 @@ SetValue( } valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_WinUtfToTChar(valueName, length, &nameBuf); resultPtr = Tcl_GetObjResult(interp); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { DWORD value; if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) { RegCloseKey(key); + Tcl_DStringFree(&nameBuf); return TCL_ERROR; } value = ConvertDWORD(type, value); - result = RegSetValueEx(key, valueName, 0, type, (BYTE*) &value, - sizeof(DWORD)); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, + (BYTE*) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { - Tcl_DString data; + Tcl_DString data, buf; int objc, i; Tcl_Obj **objv; - char *element; if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) { RegCloseKey(key); + Tcl_DStringFree(&nameBuf); return TCL_ERROR; } @@ -1063,29 +1226,55 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - element = Tcl_GetStringFromObj(objv[i], NULL); - Tcl_DStringAppend(&data, element, -1); + Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); + + /* + * 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. + */ + Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); } - result = RegSetValueEx(key, valueName, 0, type, - (LPBYTE) Tcl_DStringValue(&data), - (DWORD) (Tcl_DStringLength(&data)+1)); + + Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, + &buf); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, + (BYTE *) Tcl_DStringValue(&buf), + (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); - } else { + Tcl_DStringFree(&buf); + } else if (type == REG_SZ || type == REG_EXPAND_SZ) { + Tcl_DString buf; char *data = Tcl_GetStringFromObj(dataObj, &length); + data = Tcl_WinUtfToTChar(data, length, &buf); + /* - * Include the null in the length if we are storing a null terminated - * string. Note that we also need to call strlen to find the first - * null so we don't pass bad data to the registry. + * Include the null in the length, padding if needed for Unicode. */ - if (type == REG_SZ || type == REG_EXPAND_SZ) { - length = strlen(data) + 1; + if (regWinProcs->useWide) { + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); } + length = Tcl_DStringLength(&buf) + 1; - result = RegSetValueEx(key, valueName, 0, type, (LPBYTE)data, length); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, + (BYTE*)data, length); + Tcl_DStringFree(&buf); + } else { + char *data; + + /* + * Store binary data in the registry. + */ + + data = Tcl_GetByteArrayFromObj(dataObj, &length); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, + (BYTE *)data, length); } + Tcl_DStringFree(&nameBuf); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_AppendToObj(resultPtr, "unable to set value: ", -1); @@ -1118,36 +1307,65 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - char *msgbuf, id[10]; + WCHAR *wMsgPtr; + char *msg; + char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; + Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); - sprintf(id, "%d", error); - length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR)&msgbuf, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr, 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) { - msgbuf = "function not supported under Win32s"; + msg = "function not supported under Win32s"; } else { - msgbuf = id; + sprintf(msgBuf, "unknown error: %d", error); + msg = msgBuf; } } else { + Tcl_Encoding encoding; + + encoding = Tcl_GetEncoding(NULL, "unicode"); + Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); + Tcl_FreeEncoding(encoding); + LocalFree(wMsgPtr); + + msg = Tcl_DStringValue(&ds); + length = Tcl_DStringLength(&ds); + /* * Trim the trailing CR/LF from the system message. */ - if (msgbuf[length-1] == '\n') { - msgbuf[--length] = 0; + if (msg[length-1] == '\n') { + msg[--length] = 0; } - if (msgbuf[length-1] == '\r') { - msgbuf[--length] = 0; + if (msg[length-1] == '\r') { + msg[--length] = 0; } } - Tcl_SetErrorCode(interp, "WINDOWS", id, msgbuf, (char *) NULL); - Tcl_AppendToObj(resultPtr, msgbuf, -1); + + sprintf(id, "%d", error); + Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL); + Tcl_AppendToObj(resultPtr, msg, length); if (length != 0) { - LocalFree(msgbuf); + Tcl_DStringFree(&ds); } } |