/* trashbox.dll * Move file to trashbox and empty trashbox under Windows. * You need IE4.0 or above version. * This program is placed in Public Domain. */ #include <windows.h> #include <shlwapi.h> #include <tcl.h> char* GetExternalNormPath(Tcl_Interp *interp, Tcl_Obj *obj, Tcl_DString *ds) { char *filename; Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, obj); Tcl_UtfToExternalDString(NULL, Tcl_GetString(norm), -1, ds); filename = Tcl_DStringValue(ds); filename = Tcl_TranslateFileName(interp, filename, ds); return filename; } int Trashbox_ClearCmd (ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj *objv[]) { static vok = -1; //Version check if (vok == -1) { DLLVERSIONINFO version; HINSTANCE hDll = LoadLibrary("SHELL32.DLL"); DLLGETVERSIONPROC getVersion = NULL; getVersion = (DLLGETVERSIONPROC)GetProcAddress(hDll, "DllGetVersion"); vok = 0; if (getVersion != NULL) { ZeroMemory(&version, sizeof(version)); version.cbSize = sizeof(version); if (getVersion(&version) == NOERROR) { int major = version.dwMajorVersion; int minor = version.dwMinorVersion; if (major >= 5 || (major == 4 && minor >=71)) { vok = 1; } } } FreeLibrary(hDll); } if (vok == 0) { Tcl_Obj *wr = Tcl_NewStringObj("You need InternetExplorer 4.0 or above version.", -1); Tcl_SetObjResult(interp, wr); return TCL_ERROR; } if (objc>2) { Tcl_Obj *wr = Tcl_NewStringObj("wrong # args: should be \"clear ?drivename?\"", -1); Tcl_SetObjResult(interp, wr); return TCL_ERROR; } if (objc<=1) { if (SHEmptyRecycleBin(NULL, NULL, SHERB_NOCONFIRMATION) != S_OK) return TCL_ERROR; } else { CONST char *path; Tcl_DString ds; path = GetExternalNormPath(interp, objv[1], &ds); if (SHEmptyRecycleBin(NULL, path, SHERB_NOCONFIRMATION) != S_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } Tcl_DStringFree(&ds); } return TCL_OK; } int Trashbox_DeleteCmd (ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj *objv[]) { int i; SHFILEOPSTRUCT FileOp; char *filelist = malloc(1), *p; int n = 0; if (objc<=1) return TCL_OK; for (i=1; i<objc; i++){ CONST char *filename; Tcl_DString ds; filename = GetExternalNormPath(interp, objv[i], &ds); filelist = realloc(filelist, strlen(filename) + n + 2); p = filelist + n; strcpy(p, filename); p += strlen(filename); n += strlen(filename)+1; Tcl_DStringFree(&ds); } p = filelist + n; *p = '\0'; FileOp.hwnd = NULL; FileOp.wFunc = FO_DELETE; FileOp.pFrom = filelist; FileOp.pTo = NULL; FileOp.fFlags = FOF_ALLOWUNDO | FOF_NOCONFIRMATION | FOF_NOERRORUI | FOF_SILENT; FileOp.fAnyOperationsAborted = FALSE; FileOp.hNameMappings = NULL; FileOp.lpszProgressTitle = NULL; if (SHFileOperation(&FileOp)) { Tcl_Obj *wr = Tcl_NewStringObj("failed to delete files", -1); Tcl_SetObjResult(interp, wr); free(filelist); return TCL_ERROR; } free(filelist); return TCL_OK; } DLLEXPORT int Trashbox_Init (Tcl_Interp *interp) { #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8", 0) == NULL) { return TCL_ERROR; } #endif Tcl_CreateObjCommand(interp, "::trashbox::delete", Trashbox_DeleteCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::trashbox::clear", Trashbox_ClearCmd, NULL, NULL); if (Tcl_PkgProvide(interp, "Trashbox", "1.0") != TCL_OK) { return TCL_ERROR; } return TCL_OK; }
http://reddog.s35.xrea.com/software/trashbox1.0.zip
trashbox::delete file ?file...? trashbox::clear ?drivename?