int TclpRenameFile( CONST char *src, /* Pathname of file or dir to be renamed * (UTF-8). */ CONST char *dst) /* New pathname of file or directory * (UTF-8). */ { int result; TCHAR *nativeSrc; Tcl_DString srcString, dstString; nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString); Tcl_WinUtfToTChar(dst, -1, &dstString); if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32s) && ((Tcl_DStringLength(&srcString) >= MAX_PATH - 1) || (Tcl_DStringLength(&dstString) >= MAX_PATH - 1))) { /* * On Win32s, really long file names cause the MoveFile() call * to lock up, endlessly throwing an access violation and * retrying the operation. */ errno = ENAMETOOLONG; result = TCL_ERROR; } else { result = DoRenameFile(nativeSrc, &dstString); } Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); return result; }
int TclpCopyFile( CONST char *src, /* Pathname of file to be copied (UTF-8). */ CONST char *dst) /* Pathname of file to copy to (UTF-8). */ { int result; Tcl_DString srcString, dstString; Tcl_WinUtfToTChar(src, -1, &srcString); Tcl_WinUtfToTChar(dst, -1, &dstString); result = DoCopyFile(&srcString, &dstString); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); return result; }
int TclpCopyDirectory( CONST char *src, /* Pathname of directory to be copied * (UTF-8). */ CONST char *dst, /* Pathname of target directory (UTF-8). */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free * DString filled with UTF-8 name of file * causing error. */ { int result; Tcl_DString srcString, dstString; Tcl_WinUtfToTChar(src, -1, &srcString); Tcl_WinUtfToTChar(dst, -1, &dstString); result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); return result; }
int TclpCreateDirectory( CONST char *path) /* Pathname of directory to create (UTF-8). */ { int result; Tcl_DString pathString; Tcl_WinUtfToTChar(path, -1, &pathString); result = DoCreateDirectory(&pathString); Tcl_DStringFree(&pathString); return result; }
int TclpDeleteFile( CONST char *path) /* Pathname of file to be removed (UTF-8). */ { int result; Tcl_DString pathString; Tcl_WinUtfToTChar(path, -1, &pathString); result = DoDeleteFile(&pathString); Tcl_DStringFree(&pathString); return result; }
static int SetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ CONST char *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { DWORD fileAttributes; int yesNo; int result; Tcl_DString ds; TCHAR *nativeName; nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); if (fileAttributes == 0xffffffff) { StatError(interp, fileName); result = TCL_ERROR; goto end; } result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo); if (result != TCL_OK) { goto end; } if (yesNo) { fileAttributes |= (attributeArray[objIndex]); } else { fileAttributes &= ~(attributeArray[objIndex]); } if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { StatError(interp, fileName); result = TCL_ERROR; goto end; } end: Tcl_DStringFree(&ds); return result; }
int TclpRemoveDirectory( CONST char *path, /* Pathname of directory to be removed * (UTF-8). */ int recursive, /* If non-zero, removes directories that * are nonempty. Otherwise, will only remove * empty directories. */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free * DString filled with UTF-8 name of file * causing error. */ { int result; Tcl_DString pathString; Tcl_WinUtfToTChar(path, -1, &pathString); result = DoRemoveDirectory(&pathString, recursive, errorPtr); Tcl_DStringFree(&pathString); return result; }
static int TestfindwindowObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { const TCHAR *title = NULL, *class = NULL; Tcl_DString titleString, classString; HWND hwnd = NULL; int r = TCL_OK; Tcl_DStringInit(&classString); Tcl_DStringInit(&titleString); if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "title ?class?"); return TCL_ERROR; } title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString); if (objc == 3) { class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString); } hwnd = FindWindow(class, title); if (hwnd == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1)); AppendSystemError(interp, GetLastError()); r = TCL_ERROR; } else { Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd))); } Tcl_DStringFree(&titleString); Tcl_DStringFree(&classString); return r; }
TWAPI_EXTERN WCHAR *ObjToWinChars(Tcl_Obj *objP) { WinChars *rep; Tcl_DString ds; int nbytes, len; char *utf8; if (objP->typePtr == &gWinCharsType) return WinCharsGet(objP)->chars; utf8 = ObjToStringN(objP, &nbytes); Tcl_WinUtfToTChar(utf8, nbytes, &ds); len = Tcl_DStringLength(&ds) / sizeof(WCHAR); rep = WinCharsNew((WCHAR *) Tcl_DStringValue(&ds), len); Tcl_DStringFree(&ds); /* Convert the passed object's internal rep */ if (objP->typePtr && objP->typePtr->freeIntRepProc) objP->typePtr->freeIntRepProc(objP); WinCharsSet(objP, rep); return rep->chars; }
static int GetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ CONST char *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; Tcl_DString ds; TCHAR *nativeName; nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); result = (*tclWinProcs->getFileAttributesProc)(nativeName); Tcl_DStringFree(&ds); if (result == 0xffffffff) { StatError(interp, fileName); return TCL_ERROR; } *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]); return TCL_OK; }
int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ { HINSTANCE handle; const TCHAR *nativeName; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ nativeName = Tcl_FSGetNativePath(pathPtr); handle = (*tclWinProcs->loadLibraryProc)(nativeName); if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path. */ Tcl_DString ds; char *fileName = Tcl_GetString(pathPtr); nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); handle = (*tclWinProcs->loadLibraryProc)(nativeName); Tcl_DStringFree(&ds); } *loadHandle = (Tcl_LoadHandle) handle; if (handle == NULL) { DWORD lastError = GetLastError(); #if 0 /* * It would be ideal if the FormatMessage stuff worked better, but * unfortunately it doesn't seem to want to... */ LPTSTR lpMsgBuf; char *buf; int size; size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0, (LPTSTR) &lpMsgBuf, 0, NULL); buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1); sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf); #endif Tcl_AppendResult(interp, "couldn't load library \"", Tcl_GetString(pathPtr), "\": ", NULL); /* * Check for possible DLL errors. This doesn't work quite right, * because Windows seems to only return ERROR_MOD_NOT_FOUND for just * about any problem, but it's better than nothing. It'd be even * better if there was a way to get what DLLs */ switch (lastError) { case ERROR_MOD_NOT_FOUND: case ERROR_DLL_NOT_FOUND: Tcl_AppendResult(interp, "this library or a dependent library" " could not be found in library path", NULL); break; case ERROR_PROC_NOT_FOUND: Tcl_AppendResult(interp, "A function specified in the import" " table could not be resolved by the system. Windows" " is not telling which one, I'm sorry.", NULL); break; case ERROR_INVALID_DLL: Tcl_AppendResult(interp, "this library or a dependent library" " is damaged", NULL); break; case ERROR_DLL_INIT_FAILED: Tcl_AppendResult(interp, "the library initialization" " routine failed", NULL); break; default: TclWinConvertError(lastError); Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); } return TCL_ERROR; } else { *unloadProcPtr = &TclpUnloadFile; } return TCL_OK; }
static int TestfindwindowObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { const TCHAR *title = NULL, *class = NULL; Tcl_DString titleString, classString; HWND hwnd = NULL; int r = TCL_OK; DWORD myPid; Tcl_DStringInit(&classString); Tcl_DStringInit(&titleString); if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "title ?class?"); return TCL_ERROR; } title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString); if (objc == 3) { class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString); } if (title[0] == 0) title = NULL; #if 0 hwnd = FindWindow(class, title); #else /* We want find a window the belongs to us and not some other process */ hwnd = NULL; myPid = GetCurrentProcessId(); while (1) { DWORD pid, tid; hwnd = FindWindowEx(NULL, hwnd, class, title); if (hwnd == NULL) break; tid = GetWindowThreadProcessId(hwnd, &pid); if (tid == 0) { /* Window has gone */ hwnd = NULL; break; } if (pid == myPid) break; /* Found it */ } #endif if (hwnd == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1)); AppendSystemError(interp, GetLastError()); r = TCL_ERROR; } else { Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd))); } Tcl_DStringFree(&titleString); Tcl_DStringFree(&classString); return r; }
static int ConvertFileNameFormat( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ CONST char *fileName, /* The name of the file. */ int longShort, /* 0 to short name, 1 to long name. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { int pathc, i; char **pathv, **newv; char *resultStr; Tcl_DString resultDString; int result = TCL_OK; Tcl_SplitPath(fileName, &pathc, &pathv); newv = (char **) ckalloc(pathc * sizeof(char *)); if (pathc == 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not read \"", fileName, "\": no such file or directory", (char *) NULL); result = TCL_ERROR; goto cleanup; } for (i = 0; i < pathc; i++) { if ((pathv[i][0] == '/') || ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':')) || (strcmp(pathv[i], ".") == 0) || (strcmp(pathv[i], "..") == 0)) { /* * Handle "/", "//machine/export", "c:/", "." or ".." by just * copying the string literally. Uppercase the drive letter, * just because it looks better under Windows to do so. */ simple: pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0])); newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1); lstrcpyA(newv[i], pathv[i]); } else { char *str; TCHAR *nativeName; Tcl_DString ds; WIN32_FIND_DATAT data; HANDLE handle; DWORD attr; Tcl_DStringInit(&resultDString); str = Tcl_JoinPath(i + 1, pathv, &resultDString); nativeName = Tcl_WinUtfToTChar(str, -1, &ds); handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* * FindFirstFile() doesn't like root directories. We * would only get a root directory here if the caller * specified "c:" or "c:." and the current directory on the * drive was the root directory */ attr = (*tclWinProcs->getFileAttributesProc)(nativeName); if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); Tcl_DStringFree(&resultDString); goto simple; } } Tcl_DStringFree(&ds); Tcl_DStringFree(&resultDString); if (handle == INVALID_HANDLE_VALUE) { pathc = i - 1; StatError(interp, fileName); result = TCL_ERROR; goto cleanup; } if (tclWinProcs->useWide) { nativeName = (TCHAR *) data.w.cAlternateFileName; if (longShort) { if (data.w.cFileName[0] != '\0') { nativeName = (TCHAR *) data.w.cFileName; } } else { if (data.w.cAlternateFileName[0] == '\0') { nativeName = (TCHAR *) data.w.cFileName; } } } else { nativeName = (TCHAR *) data.a.cAlternateFileName; if (longShort) { if (data.a.cFileName[0] != '\0') { nativeName = (TCHAR *) data.a.cFileName; } } else { if (data.a.cAlternateFileName[0] == '\0') { nativeName = (TCHAR *) data.a.cFileName; } } } /* * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying * to dereference nativeName as a Unicode string. I have proven * to myself that purify is wrong by running the following * example when nativeName == data.w.cAlternateFileName and * noting that purify doesn't complain about the first line, * but does complain about the second. * * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); */ Tcl_WinTCharToUtf(nativeName, -1, &ds); newv[i] = ckalloc(Tcl_DStringLength(&ds) + 1); lstrcpyA(newv[i], Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); FindClose(handle); } } Tcl_DStringInit(&resultDString); resultStr = Tcl_JoinPath(pathc, newv, &resultDString); *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString)); Tcl_DStringFree(&resultDString); cleanup: for (i = 0; i < pathc; i++) { ckfree(newv[i]); } ckfree((char *) newv); ckfree((char *) pathv); return result; }