/* 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;
}

Source & Binary

http://reddog.s35.xrea.com/software/trashbox1.0.zip

Command

trashbox::delete file ?file...?
trashbox::clear ?drivename?

Comment



CategoryTclTk CategorySoft


|New|Edit|Freeze|Diff|History|Attach|Copy|Rename|
Last-modified: 2005-08-02 (Tue) 00:00:00
HTML convert time: 0.005 sec.