tclwinreg.c

linux系统下的音频通信

		Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
		Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }
    RegCloseKey(key);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetKeyNames --
 *
 *	This function enumerates the subkeys of a given key.  If the
 *	optional pattern is supplied, then only keys that match the
 *	pattern will be returned.
 *
 * Results:
 *	Returns the list of subkeys in the result object of the
 *	interpreter, or an error message on failure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
GetKeyNames(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Key to enumerate. */
    Tcl_Obj *patternObj)	/* Optional match pattern. */
{
    HKEY key;
    DWORD index;
    char buffer[MAX_PATH+1], *pattern;
    Tcl_Obj *resultPtr;
    int result = TCL_OK;

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

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

    if (patternObj) {
	pattern = Tcl_GetStringFromObj(patternObj, NULL);
    } else {
	pattern = NULL;
    }

    /*
     * Enumerate over the subkeys until we get an error, indicating the
     * end of the list.
     */

    resultPtr = Tcl_GetObjResult(interp);
    for (index = 0; RegEnumKey(key, index, buffer, MAX_PATH+1)
	     == ERROR_SUCCESS; index++) {
	if (pattern && !Tcl_StringMatch(buffer, pattern)) {
	    continue;
	}
	result = Tcl_ListObjAppendElement(interp, resultPtr,
		Tcl_NewStringObj(buffer, -1));
	if (result != TCL_OK) {
	    break;
	}
    }

    RegCloseKey(key);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetType --
 *
 *	This function gets the type of a given registry value and
 *	places it in the interpreter result.
 *
 * Results:
 *	Returns a normal Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
GetType(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Name of key. */
    Tcl_Obj *valueNameObj)	/* Name of value to get. */
{
    HKEY key;
    Tcl_Obj *resultPtr;
    DWORD result;
    DWORD type;
    
    /*
     * Attempt to open the key for reading.
     */

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

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

    resultPtr = Tcl_GetObjResult(interp);

    result = RegQueryValueEx(key, Tcl_GetStringFromObj(valueNameObj, NULL),
	    NULL, &type, NULL, NULL);
    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);
	AppendSystemError(interp, result);
	return TCL_ERROR;
    }

    /*
     * 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 || type < 0) {
	Tcl_SetIntObj(resultPtr, type);
    } else {
	Tcl_SetStringObj(resultPtr, typeNames[type], -1);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetValue --
 *
 *	This function gets the contents of a registry value and places
 *	a list containing the data and the type in the interpreter
 *	result.
 *
 * Results:
 *	Returns a normal Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
GetValue(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Name of key. */
    Tcl_Obj *valueNameObj)	/* Name of value to get. */
{
    HKEY key;
    char *valueName;
    DWORD result, length, type;
    Tcl_Obj *resultPtr;
    Tcl_DString data;

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

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

    /*
     * 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.
     *
     * 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);

    resultPtr = Tcl_GetObjResult(interp);
  
    valueName = Tcl_GetStringFromObj(valueNameObj, NULL);
    result = RegQueryValueEx(key, valueName, NULL, &type,
	    (LPBYTE) Tcl_DStringValue(&data), &length);
    if (result == ERROR_MORE_DATA) {
        Tcl_DStringSetLength(&data, length);
        result = RegQueryValueEx(key, valueName, NULL, &type,
                (LPBYTE) Tcl_DStringValue(&data), &length);
    }
    RegCloseKey(key);
    if (result != ERROR_SUCCESS) {
	Tcl_AppendStringsToObj(resultPtr, "unable to get value \"",
		Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
		Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
	AppendSystemError(interp, result);
	Tcl_DStringFree(&data);
	return TCL_ERROR;
    }

    /*
     * If the data is a 32-bit quantity, store it as an integer object.  If it
     * is a multi-string, store it as a list of strings.  For null-terminated
     * strings, append up the to first null.  Otherwise, store it as a binary
     * string.
     */

    if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
	Tcl_SetIntObj(resultPtr, ConvertDWORD(type,
		*((DWORD*) Tcl_DStringValue(&data))));
    } else if (type == REG_MULTI_SZ) {
	char *p = Tcl_DStringValue(&data);
	char *lastChar = Tcl_DStringValue(&data) + Tcl_DStringLength(&data);

	/*
	 * 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') {
	    Tcl_ListObjAppendElement(interp, resultPtr,
		    Tcl_NewStringObj(p, -1));
	    while (*p++ != '\0') {}
	}
    } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
	Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), -1);
    } else {
	Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), length);
    }
    Tcl_DStringFree(&data);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetValueNames --
 *
 *	This function enumerates the values of the a given key.  If
 *	the optional pattern is supplied, then only value names that
 *	match the pattern will be returned.
 *
 * Results:
 *	Returns the list of value names in the result object of the
 *	interpreter, or an error message on failure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
GetValueNames(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Key to enumerate. */
    Tcl_Obj *patternObj)	/* Optional match pattern. */
{
    HKEY key;
    Tcl_Obj *resultPtr;
    DWORD index, size, result;
    Tcl_DString buffer;
    char *pattern;

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

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

    resultPtr = Tcl_GetObjResult(interp);

    /*
     * Query the key to determine the appropriate buffer size to hold the
     * largest value name plus the terminating null.
     */

    result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL, NULL, NULL, &index,
	&size, NULL, NULL, NULL);
    if (result != ERROR_SUCCESS) {
	Tcl_AppendStringsToObj(resultPtr, "unable to query key \"",
		Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
	AppendSystemError(interp, result);
	RegCloseKey(key);
	result = TCL_ERROR;
	goto done;
    }
    size++;


    Tcl_DStringInit(&buffer);
    Tcl_DStringSetLength(&buffer, size);
    index = 0;
    result = TCL_OK;

    if (patternObj) {
	pattern = Tcl_GetStringFromObj(patternObj, NULL);
    } else {
	pattern = NULL;
    }

    /*
     * Enumerate the values under the given subkey until we get an error,
     * indicating the end of the list.  Note that we need to reset size
     * 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)) {
	    result = Tcl_ListObjAppendElement(interp, resultPtr,
		    Tcl_NewStringObj(Tcl_DStringValue(&buffer), size));
	    if (result != TCL_OK) {
		break;
	    }
	}
	index++;
	size = Tcl_DStringLength(&buffer);
    }
    Tcl_DStringFree(&buffer);

    done:
    RegCloseKey(key);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenKey --
 *
 *	This function opens the specified key.  This function is a
 *	simple wrapper around ParseKeyName and OpenSubKey.
 *
 * Results:
 *	Returns the opened key in the keyPtr argument and a Tcl
 *	result code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
OpenKey(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Key to open. */
    REGSAM mode,		/* Access mode. */
    int flags,			/* 0 or REG_CREATE. */
    HKEY *keyPtr)		/* Returned HKEY. */
{
    char *keyName, *buffer, *hostName;
    int length;
    HKEY rootKey;
    DWORD result;

    keyName = Tcl_GetStringFromObj(keyNameObj, &length);
    buffer = ckalloc(length + 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_Obj *resultPtr = Tcl_GetObjResult(interp);
	    Tcl_AppendToObj(resultPtr, "unable to open key: ", -1);
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;
	} else {
	    result = TCL_OK;
	}
    }

    ckfree(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenSubKey --
 *
 *	This function opens a given subkey of a root key on the
 *	specified host.