tclwinreg.c

linux系统下的音频通信

/* 
 * tclWinReg.c --
 *
 *	This file contains the implementation of the "registry" Tcl
 *	built-in command.  This command is built as a dynamically
 *	loadable extension in a separate DLL.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclWinReg.c 1.8 97/08/01 11:17:49
 */

#include <tcl.h>
#include <stdlib.h>

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

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

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

/*
 * VC++ has an alternate entry point called DllMain, so we need to rename
 * our entry point.
 */

#ifdef DLL_BUILD
# if defined(_MSC_VER)
#  define DllEntryPoint DllMain
# endif
#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)))
 
/*
 * The following flag is used in OpenKeys to indicate that the specified
 * key should be created if it doesn't currently exist.
 */

#define REG_CREATE 1

/*
 * The following tables contain the mapping from registry root names
 * to the system predefined keys.
 */

static char *rootKeyNames[] = {
    "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
    "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", NULL
};

static HKEY rootKeys[] = {
    HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
    HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
};

/*
 * The following table maps from registry types to strings.  Note that
 * the indices for this array are the same as the constants for the
 * known registry types so we don't need a separate table to hold the
 * mapping.
 */

static char *typeNames[] = {
    "none", "sz", "expand_sz", "binary", "dword", 
    "dword_big_endian", "link", "multi_sz", "resource_list", NULL
};

static DWORD lastType = REG_RESOURCE_LIST;


/*
 * Declarations for functions defined in this file.
 */

static void		AppendSystemError(Tcl_Interp *interp, DWORD error);
static DWORD		ConvertDWORD(DWORD type, DWORD value);
static int		DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
static int		DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj);
static int		GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *patternObj);
static int		GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj);
static int		GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj);
static int		GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *patternObj);
static int		OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    REGSAM mode, int flags, HKEY *keyPtr);
static DWORD		OpenSubKey(char *hostName, HKEY rootKey,
			    char *keyName, REGSAM mode, int flags,
			    HKEY *keyPtr);
static int		ParseKeyName(Tcl_Interp *interp, char *name,
			    char **hostNamePtr, HKEY *rootKeyPtr,
			    char **keyNamePtr);
static DWORD		RecursiveDeleteKey(HKEY hStartKey, LPTSTR pKeyName);
static int		RegistryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]);
static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
			    Tcl_Obj *typeObj);

EXTERN int Registry_Init(Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * DllEntryPoint --
 *
 *	This wrapper function is used by Windows to invoke the
 *	initialization code for the DLL.  If we are compiling
 *	with Visual C++, this routine will be renamed to DllMain.
 *	routine.
 *
 * Results:
 *	Returns TRUE;
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef __WIN32__
#ifdef DLL_BUILD
BOOL APIENTRY
DllEntryPoint(
    HINSTANCE hInst,		/* Library instance handle. */
    DWORD reason,		/* Reason this function is being called. */
    LPVOID reserved)		/* Not used. */
{
    return TRUE;
}
#endif
#endif

/*
 *----------------------------------------------------------------------
 *
 * Registry_Init --
 *
 *	This procedure initializes the registry command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Registry_Init(
    Tcl_Interp *interp)
{
    Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
    return Tcl_PkgProvide(interp, "registry", "1.0");
}

/*
 *----------------------------------------------------------------------
 *
 * RegistryObjCmd --
 *
 *	This function implements the Tcl "registry" command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
RegistryObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj * CONST objv[])	/* Argument values. */
{
    int index;
    char *errString;

    static char *subcommands[] = { "delete", "get", "keys", "set", "type",
				   "values", (char *) NULL };
    enum SubCmdIdx { DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
	    != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
	case DeleteIdx:			/* delete */
	    if (objc == 3) {
		return DeleteKey(interp, objv[2]);
	    } else if (objc == 4) {
		return DeleteValue(interp, objv[2], objv[3]);
	    }
	    errString = "keyName ?valueName?";
	    break;
	case GetIdx:			/* get */
	    if (objc == 4) {
		return GetValue(interp, objv[2], objv[3]);
	    }
	    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]);
	    }
	    errString = "keyName ?pattern?";
	    break;
	case SetIdx:			/* set */
	    if (objc == 3) {
		HKEY key;

		/*
		 * Create the key and then close it immediately.
		 */

		if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 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);
	    }
	    errString = "keyName ?valueName data ?type??";
	    break;
	case TypeIdx:			/* type */
	    if (objc == 4) {
		return GetType(interp, objv[2], objv[3]);
	    }
	    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]);
	    }
	    errString = "keyName ?pattern?";
	    break;
    }
    Tcl_WrongNumArgs(interp, 2, objv, errString);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteKey --
 *
 *	This function deletes a registry key.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
DeleteKey(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj)	/* Name of key to delete. */
{
    char *tail, *buffer, *hostName, *keyName;
    HKEY rootKey, subkey;
    DWORD result;
    int length;
    Tcl_Obj *resultPtr;

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

    keyName = Tcl_GetStringFromObj(keyNameObj, &length);
    buffer = ckalloc(length + 1);
    strcpy(buffer, keyName);

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

    resultPtr = Tcl_GetObjResult(interp);
    if (*keyName == '\0') {
	Tcl_AppendToObj(resultPtr, "bad key: cannot delete root keys", -1);
	ckfree(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {
	*tail++ = '\0';
    } else {
	tail = keyName;
	keyName = NULL;
    }

    result = OpenSubKey(hostName, rootKey, keyName,
	    KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
    if (result != ERROR_SUCCESS) {
	ckfree(buffer);
	if (result == ERROR_FILE_NOT_FOUND) {
	    return TCL_OK;
	} else {
	    Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
	    AppendSystemError(interp, result);
	    return TCL_ERROR;
	}
    }

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

    result = RecursiveDeleteKey(subkey, tail);

    if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
	Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }

    RegCloseKey(subkey);
    ckfree(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteValue --
 *
 *	This function deletes a value from a registry key.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
DeleteValue(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Name of key. */
    Tcl_Obj *valueNameObj)	/* Name of value to delete. */
{
    HKEY key;
    char *valueName;
    int length;
    DWORD result;
    Tcl_Obj *resultPtr;
    
    /*
     * Attempt to open the key for deletion.
     */

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

    resultPtr = Tcl_GetObjResult(interp);
    valueName = Tcl_GetStringFromObj(valueNameObj, &length);
    result = RegDeleteValue(key, valueName);
    if (result != ERROR_SUCCESS) {
	Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"",