#define USE_TCL_STUBS #include #include Tcl_ObjCmdProc GetEnvObjCmd; Tcl_ObjCmdProc SetEnvObjCmd; Tcl_ObjCmdProc WGetEnvObjCmd; Tcl_ObjCmdProc WSetEnvObjCmd; Tcl_ObjCmdProc TGetEnvObjCmd; Tcl_ObjCmdProc TSetEnvObjCmd; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT EXTERN int Test_Init (Tcl_Interp *interp) { if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "getenv", GetEnvObjCmd, 0L, 0L); Tcl_CreateObjCommand(interp, "setenv", SetEnvObjCmd, 0L, 0L); Tcl_CreateObjCommand(interp, "wgetenv", WGetEnvObjCmd, 0L, 0L); Tcl_CreateObjCommand(interp, "wsetenv", WSetEnvObjCmd, 0L, 0L); Tcl_CreateObjCommand(interp, "tgetenv", TGetEnvObjCmd, 0L, 0L); Tcl_CreateObjCommand(interp, "tsetenv", TSetEnvObjCmd, 0L, 0L); return TCL_OK; } int GetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj( getenv(Tcl_GetString(objv[1])), -1)); return TCL_OK; } int SetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) { Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, Tcl_GetString(objv[1]), -1); Tcl_DStringAppend(&ds, "=", -1); Tcl_DStringAppend(&ds, Tcl_GetString(objv[2]), -1); putenv(Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); return TCL_OK; } int WGetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) { TCHAR buf[255]; GetEnvironmentVariable(Tcl_GetString(objv[1]), buf, 255); Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); return TCL_OK; } int WSetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) { SetEnvironmentVariable(Tcl_GetString(objv[1]), Tcl_GetString(objv[2])); return TCL_OK; } int TGetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) { Tcl_DString ds; TclGetEnv(Tcl_GetString(objv[1]), &ds); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&ds), -1)); Tcl_DStringFree(&ds); return TCL_OK; } int TSetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) { Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, Tcl_GetString(objv[1]), -1); Tcl_DStringAppend(&ds, "=", -1); Tcl_DStringAppend(&ds, Tcl_GetString(objv[2]), -1); Tcl_PutEnv(Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); return TCL_OK; }