if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0-]} {
    package ifneeded dde 1.4.5 \
	    [list load [file join $dir tcl9dde14.dll] Dde]
} elseif {![package vsatisfies [package provide Tcl] 8.7]
	&& [::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.4.5 \
	    [list load [file join $dir tcldde14g.dll] Dde]
} else {
    package ifneeded dde 1.4.5 \
	    [list load [file join $dir tcldde14.dll] Dde]
}

if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0-]} {
    package ifneeded registry 1.3.7 \
	    [list load [file join $dir tcl9registry13.dll] Registry]
} else {
    package ifneeded registry 1.3.7 \
	    [list load [file join $dir tclregistry13.dll] Registry]
}

    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.7]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

test registry-1.0 {check if we are testing the right dll} {win reg} {
    set ::regver
} {1.3.7}
test registry-1.1 {argument parsing for registry command} {win reg} {
    list [catch {registry} msg] $msg
} {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} {

}
source [file join [file dirname [info script]] tcltests.tcl]

testConstraint dde 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.5]
	    set ::ddelib [info loaded {} Dde]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

    gets $f line
    return $f
}

# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
    set ::ddever
} {1.4.5}

test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
    list [dde servername foobar] [dde servername] [dde servername self]
} -result {foobar foobar self}

test winDde-2.1 {Checking for other services} -constraints dde -body {
    expr {[llength [dde services {} {}]] >= 0}

REG_DLL_FILE		= tcl9registry$(REGVER)${DLLSUFFIX}
REG_DLL_FILE8		= tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.5 [list load [file normalize ${DDE_DLL_FILE}]];\
			  package ifneeded registry 1.3.7 [list load [file normalize ${REG_DLL_FILE}]]
TEST_LOAD_FACILITIES	= package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
			  $(TEST_LOAD_PRMS)
ZLIB_DLL_FILE		= zlib1.dll
TOMMATH_DLL_FILE		= libtommath.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

!endif
setup:      default-setup

test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.5 [list load "$(TCLDDELIB:\=/)"]
		package ifneeded registry 1.3.7 [list load "$(TCLREGLIB:\=/)"]
<<

runtest: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls

 */

static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;	/* The application instance handle given to us
				 * by DdeInitialize. */
static int ddeIsServer = 0;

#define TCL_DDE_VERSION		"1.4.5"
#define TCL_DDE_PACKAGE_NAME	"dde"
#define TCL_DDE_SERVICE_NAME	L"TclEval"
#define TCL_DDE_EXECUTE_RESULT	L"$TCLEVAL$EXECUTE$RESULT"

#define DDE_FLAG_ASYNC 1
#define DDE_FLAG_BINARY 2
#define DDE_FLAG_FORCE 4

# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif

#define Tcl_Size int






#define TCL_INDEX_NONE -1






#endif





#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load dde14.dll" works without 3th argument */
DLLEXPORT int		Tcldde_Init(Tcl_Interp *interp);
DLLEXPORT int		Tcldde_SafeInit(Tcl_Interp *interp);
#endif
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *

	    for (n = 0; n < srvCount; ++n) {
		Tcl_Obj* namePtr;
		Tcl_DString ds;

		Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
		Tcl_DStringInit(&ds);
		Tcl_UtfToWCharDString(Tcl_GetString(namePtr), TCL_INDEX_NONE, &ds);
		if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) {
		    suffix++;
		    Tcl_DStringFree(&ds);
		    break;
		}
		Tcl_DStringFree(&ds);
	    }

{
    Tcl_Obj *returnPackagePtr;
    int result = TCL_OK;

    if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
	Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
		"a handler procedure must be defined for use in a safe "
		"interp", TCL_INDEX_NONE));
	Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
	result = TCL_ERROR;
    }

    if (riPtr->handlerPtr != NULL) {
	/*
	 * Add the dde request data to the handler proc list.

    HSZ ddeTopic, HSZ ddeItem,	/* String handles. Transaction-type
				 * dependent. */
    HDDEDATA hData,		/* DDE data. Transaction-type dependent. */
    DWORD unused1, DWORD unused2)
				/* Transaction-dependent data. */
{
    Tcl_DString dString;
    Tcl_Size len;
    DWORD dlen;
    WCHAR *utilString;
    Tcl_Obj *ddeObjectPtr;
    HDDEDATA ddeReturn = NULL;
    RegisteredInterp *riPtr;
    Conversation *convPtr, *prevConvPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	    Tcl_DStringInit(&dsBuf);
	    Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1);
	    utilString = (WCHAR *) Tcl_DStringValue(&dString);
	    DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
		    CP_WINUNICODE);
	    if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
		returnString =
			Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);

		if (uFmt != CF_TEXT) {
		    Tcl_DStringInit(&dsBuf);
		    Tcl_UtfToWCharDString(returnString, len, &dsBuf);
		    returnString = Tcl_DStringValue(&dsBuf);
		    len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1;
		}
		ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,

		    Tcl_DStringInit(&ds);
		    Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds);
		    variableObjPtr = Tcl_GetVar2Ex(
			    convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
			    TCL_GLOBAL_ONLY);
		    if (variableObjPtr != NULL) {
			returnString = Tcl_GetStringFromObj(variableObjPtr, &len);

			if (uFmt != CF_TEXT) {
			    Tcl_DStringInit(&dsBuf);
			    Tcl_UtfToWCharDString(returnString, len, &dsBuf);
			    returnString = Tcl_DStringValue(&dsBuf);
			    len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1;
			}
			ddeReturn = DdeCreateDataHandle(ddeInstance,

	    utilString = (WCHAR *) DdeAccessData(hData, &len2);
	    len = len2;
	    if (uFmt != CF_TEXT) {
		Tcl_DStringInit(&ds2);
		Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2);
		utilString = (WCHAR *) Tcl_DStringValue(&ds2);
	    }
	    variableObjPtr = Tcl_NewStringObj((char *)utilString, TCL_INDEX_NONE);

	    Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
		    variableObjPtr, TCL_GLOBAL_ONLY);

	    Tcl_DStringFree(&ds2);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dString);

	    && ((es->topic == (ATOM)0) || (es->topic == topic))) {
	Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
	Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);

	GlobalGetAtomNameW(service, sz, 255);
	Tcl_DStringInit(&dString);
	Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE));
	Tcl_DStringFree(&dString);
	GlobalGetAtomNameW(topic, sz, 255);
	Tcl_DStringInit(&dString);
	Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE));
	Tcl_DStringFree(&dString);

	/*
	 * Adding the hwnd as a third list element provides a unique
	 * identifier in the case of multiple servers with the name
	 * application and topic names.
	 */

	errorCode = "NOCANDO";
	break;
    default:
	errorMessage = "dde command failed";
	errorCode = "FAILED";
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * DdeObjCmd --

	"-async", NULL
    };
    static const char *const ddeReqOptions[] = {
	"-binary", NULL
    };

    int index, i, argIndex;
    Tcl_Size length;
    int flags = 0, result = TCL_OK, firstArg = 0;
    HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
    HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
    HCONV hConv = NULL;
    const WCHAR *serviceName = NULL, *topicName = NULL;
    const char *string;
    DWORD ddeResult;

	    break;
	}
    }

    Initialize();

    if (firstArg != 1) {
	const char *src = Tcl_GetStringFromObj(objv[firstArg], &length);


	Tcl_DStringInit(&serviceBuf);
	Tcl_UtfToWCharDString(src, length, &serviceBuf);
	serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf);
	length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR);
    } else {
	length = 0;
    }

    if (length == 0) {
	serviceName = NULL;
    } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	ddeService = DdeCreateStringHandleW(ddeInstance, serviceName,
		CP_WINUNICODE);
    }

    if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	const char *src = Tcl_GetStringFromObj(objv[firstArg + 1], &length);


	Tcl_DStringInit(&topicBuf);
	topicName = Tcl_UtfToWCharDString(src, length, &topicBuf);
	length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR);
	if (length == 0) {
	    topicName = NULL;
	} else {
	    ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName,

	    Tcl_DStringFree(&dsBuf);
	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	Tcl_Size dataLength;
	const void *dataString;
	Tcl_DString dsBuf;

	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString =
		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    const char *src;

	    src = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);

	    Tcl_DStringInit(&dsBuf);
	    dataString =
		    Tcl_UtfToWCharDString(src, dataLength, &dsBuf);
	    dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	}

	if (dataLength + 1 < 2) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot execute null data", TCL_INDEX_NONE));
	    Tcl_DStringFree(&dsBuf);
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    break;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);

	Tcl_DStringFree(&dsBuf);
	break;
    }
    case DDE_REQUEST: {
	const WCHAR *itemString;
	const char *src;

	src = Tcl_GetStringFromObj(objv[firstArg + 2], &length);

	Tcl_DStringInit(&itemBuf);
	itemString = Tcl_UtfToWCharDString(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR);

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot request value of null data", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

    }
    case DDE_POKE: {
	Tcl_DString dsBuf;
	const WCHAR *itemString;
	BYTE *dataString;
	const char *src;

	src = Tcl_GetStringFromObj(objv[firstArg + 2], &length);

	Tcl_DStringInit(&itemBuf);
	itemString = Tcl_UtfToWCharDString(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR);
	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString = (BYTE *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
	} else {
	    const char *data =
		    Tcl_GetStringFromObj(objv[firstArg + 3], &length);

	    Tcl_DStringInit(&dsBuf);
	    dataString = (BYTE *)
		    Tcl_UtfToWCharDString(data, length, &dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	}

	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);

    case DDE_EVAL: {
	RegisteredInterp *riPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (serviceName == NULL) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("invalid service name \"\"", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}

	objc -= firstArg + 1;
	objv += firstArg + 1;

	     * interp is then deleted, the bytecode structure would be
	     * referring to deallocated objects.
	     */

	    if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
		Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
			"permission denied: a handler procedure must be"
			" defined for use in a safe interp", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
			NULL);
		result = TCL_ERROR;
	    }

	    if (result == TCL_OK) {
		if (objc == 1) {

	     * This is a non-local request. Send the script to the server and
	     * poll it for a result.
	     */

	    if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
	    invalidServerResponse:
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("invalid data returned from server", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    objPtr = Tcl_ConcatObj(objc, objv);
	    string = Tcl_GetStringFromObj(objPtr, &length);

	    Tcl_DStringInit(&dsBuf);
	    Tcl_UtfToWCharDString(string, length, &dsBuf);
	    string = Tcl_DStringValue(&dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	    ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
		    (DWORD) length, 0, 0, CF_UNICODETEXT, 0);
	    Tcl_DStringFree(&dsBuf);

		 * variable "errorCode", and the fourth is the value of the
		 * variable "errorInfo".
		 */

		length = DdeGetData(ddeData, NULL, 0, 0);
		ddeDataString = (WCHAR *) Tcl_Alloc(length);
		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
		if (length > (Tcl_Size)sizeof(WCHAR)) {
		    length -= sizeof(WCHAR);
		}
		Tcl_DStringInit(&dsBuf);
		Tcl_WCharToUtfDString(ddeDataString, length>>1, &dsBuf);
		resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
			Tcl_DStringLength(&dsBuf));
		Tcl_DStringFree(&dsBuf);

# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif

#define Tcl_Size int






#define TCL_INDEX_NONE -1






#endif





#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load registry13.dll" works without 3th argument */
DLLEXPORT int		Tclregistry_Init(Tcl_Interp *interp);
DLLEXPORT int		Tclregistry_SafeInit(Tcl_Interp *interp);
#endif
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }

    cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
	    interp, DeleteCmd);
    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
    return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL);
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Init(
    Tcl_Interp *interp)
{
    return Registry_Init(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *
 *	This function removes the registry command.

    Tcl_Obj *objv[3];
    (void)flags;

    /*
     * Unregister the registry package. There is no Tcl_PkgForget()
     */

    objv[0] = Tcl_NewStringObj("package", TCL_INDEX_NONE);
    objv[1] = Tcl_NewStringObj("forget", TCL_INDEX_NONE);
    objv[2] = Tcl_NewStringObj("registry", TCL_INDEX_NONE);
    Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL);

    /*
     * Delete the originally registered command.
     */

    cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
    if (cmd != NULL) {
	Tcl_DeleteCommandFromToken(interp, cmd);
    }

    return TCL_OK;
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Unload(
    Tcl_Interp *interp,
    int flags)
{
    return Registry_Unload(interp, flags);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * DeleteCmd --
 *
 *	Cleanup the interp command token so that unloading doesn't try to

{
    char *tail, *buffer, *hostName, *keyName;
    const WCHAR *nativeTail;
    HKEY rootKey, subkey;
    DWORD result;
    Tcl_DString buf;
    REGSAM saveMode = mode;
    Tcl_Size len;

    /*
     * Find the parent of the key being deleted and open it.
     */

    keyName = Tcl_GetStringFromObj(keyNameObj, &len);
    buffer = (char *)Tcl_Alloc(len + 1);
    strcpy(buffer, keyName);

    if (ParseKeyName(interp, buffer, &hostName, &rootKey,
	    &keyName) != TCL_OK) {
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    if (*keyName == '\0') {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad key: cannot delete root keys", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {

    result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
    if (result != ERROR_SUCCESS) {
	Tcl_Free(buffer);
	if (result == ERROR_FILE_NOT_FOUND) {
	    return TCL_OK;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE));
	AppendSystemError(interp, result);
	return TCL_ERROR;
    }

    /*
     * Now we recursively delete the key and everything below it.
     */

    Tcl_DStringInit(&buf);
    nativeTail = Tcl_UtfToWCharDString(tail, TCL_INDEX_NONE, &buf);
    result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
    Tcl_DStringFree(&buf);

    if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE));
	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }

    RegCloseKey(subkey);

    Tcl_Obj *valueNameObj,	/* Name of value to delete. */
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    char *valueName;
    DWORD result;
    Tcl_DString ds;
    Tcl_Size len;

    /*
     * Attempt to open the key for deletion.
     */

    mode |= KEY_SET_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&ds);
    Tcl_UtfToWCharDString(valueName, len, &ds);
    result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds));
    Tcl_DStringFree(&ds);
    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unable to delete value \"%s\" from key \"%s\": ",
		Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
	AppendSystemError(interp, result);

    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    DWORD result, type;
    Tcl_DString ds;
    const char *valueName;
    const WCHAR *nativeValue;
    Tcl_Size len;

    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Get the type of the value.
     */

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&ds);
    nativeValue = Tcl_UtfToWCharDString(valueName, len, &ds);
    result = RegQueryValueExW(key, nativeValue, NULL, &type,
	    NULL, NULL);
    Tcl_DStringFree(&ds);
    RegCloseKey(key);

    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(

     * Set the type into the result. Watch out for unknown types. If we don't
     * know about the type, just use the numeric value.
     */

    if (type > lastType) {
	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    const char *valueName;
    const WCHAR *nativeValue;
    DWORD result, length, type;
    Tcl_DString data, buf;
    Tcl_Size len;

    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {

     * Longer values need a second call with an expanded DString.
     */

    Tcl_DStringInit(&data);
    Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
    length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1;

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&buf);
    nativeValue = Tcl_UtfToWCharDString(valueName, len, &buf);

    result = RegQueryValueExW(key, nativeValue, NULL, &type,
	    (BYTE *) Tcl_DStringValue(&data), &length);
    while (result == ERROR_MORE_DATA) {
	/*
	 * The Windows docs say that in this error case, we just need to
	 * expand our buffer and request more data. Required for

    REGSAM mode,		/* Access mode. */
    int flags,			/* 0 or REG_CREATE. */
    HKEY *keyPtr)		/* Returned HKEY. */
{
    char *keyName, *buffer, *hostName;
    HKEY rootKey;
    DWORD result;
    Tcl_Size len;

    keyName = Tcl_GetStringFromObj(keyNameObj, &len);
    buffer = (char *)Tcl_Alloc(len + 1);
    strcpy(buffer, keyName);

    result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
    if (result == TCL_OK) {
	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
	if (result != ERROR_SUCCESS) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unable to open key: ", TCL_INDEX_NONE));
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;
	} else {
	    result = TCL_OK;
	}
    }

    /*
     * Attempt to open the root key on a remote host if necessary.
     */

    if (hostName) {
	Tcl_DStringInit(&buf);
	hostName = (char *) Tcl_UtfToWCharDString(hostName, TCL_INDEX_NONE, &buf);
	result = RegConnectRegistryW((WCHAR *)hostName, rootKey,
		&rootKey);
	Tcl_DStringFree(&buf);
	if (result != ERROR_SUCCESS) {
	    return result;
	}
    }

    /*
     * Now open the specified key with the requested permissions. Note that
     * this key must be closed by the caller.
     */

    if (keyName) {
	Tcl_DStringInit(&buf);
	keyName = (char *) Tcl_UtfToWCharDString(keyName, TCL_INDEX_NONE, &buf);
    }
    if (flags & REG_CREATE) {
	DWORD create;

	result = RegCreateKeyExW(rootKey, (WCHAR *)keyName, 0, NULL,
		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
    } else if (rootKey == HKEY_PERFORMANCE_DATA) {

	}
    }

    /*
     * Look for a matching root name.
     */

    rootObj = Tcl_NewStringObj(rootName, TCL_INDEX_NONE);
    result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
	    TCL_EXACT, &index);
    Tcl_DecrRefCount(rootObj);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    *rootKeyPtr = rootKeys[index];

    REGSAM mode)		/* Mode flags to pass. */
{
    int type;
    DWORD result;
    HKEY key;
    const char *valueName;
    Tcl_DString nameBuf;
    Tcl_Size len;

    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) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    mode |= KEY_ALL_ACCESS;
    if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&nameBuf);
    valueName = (char *) Tcl_UtfToWCharDString(valueName, len, &nameBuf);

    if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
	int value;

	if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
	    RegCloseKey(key);
	    Tcl_DStringFree(&nameBuf);

	 * Append the elements as null terminated strings. Note that we must
	 * not assume the length of the string in case there are embedded
	 * nulls, which aren't allowed in REG_MULTI_SZ values.
	 */

	Tcl_DStringInit(&data);
	for (i = 0; i < objc; i++) {
	    const char *bytes = Tcl_GetStringFromObj(objv[i], &len);

	    Tcl_DStringAppend(&data, bytes, len);

	    /*
	     * Add a null character to separate this value from the next.
	     */

	    Tcl_DStringAppend(&data, "", 1);	/* NUL-terminated string */
	}

	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
		&buf);
	result = RegSetValueExW(key, (WCHAR *) 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, &len);

	Tcl_DStringInit(&buf);
	data = (char *) Tcl_UtfToWCharDString(data, len, &buf);

	/*
	 * Include the null in the length, padding if needed for WCHAR.
	 */

	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);

	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);
    } else {
	BYTE *data;
	Tcl_Size bytelength;

	/*
	 * Store binary data in the registry.
	 */

	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, data, (DWORD) bytelength);
    }

    Tcl_DStringFree(&nameBuf);
    RegCloseKey(key);

    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to set value: ", TCL_INDEX_NONE));
	AppendSystemError(interp, result);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    LRESULT result;
    DWORD_PTR sendResult;
    int timeout = 3000;
    Tcl_Size len;
    const char *str;
    Tcl_Obj *objPtr;
    WCHAR *wstr;
    Tcl_DString ds;

    if (objc == 3) {
	str = Tcl_GetStringFromObj(objv[1], &len);

	if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
	    return TCL_BREAK;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    str = Tcl_GetStringFromObj(objv[0], &len);
    Tcl_DStringInit(&ds);
    wstr = Tcl_UtfToWCharDString(str, len, &ds);
    if (Tcl_DStringLength(&ds) == 0) {
	wstr = NULL;
    }

    /*
     * Use the ignore the result.
     */