/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 1995-2022, University of Amsterdam CWI, Amsterdam SWI-Prolog Solutions b.v. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifdef __WINDOWS__ #include /* Needed on VC8 */ #include #include #ifdef __MINGW32__ #ifndef _WIN32_IE #define _WIN32_IE 0x0400 #endif /* FIXME: these are copied from SWI-Prolog.h. */ #define PL_MSG_EXCEPTION_RAISED -1 #define PL_MSG_IGNORED 0 #define PL_MSG_HANDLED 1 #endif #include "pl-nt.h" #include "pl-fli.h" #include "os/pl-utf8.h" #include #include "os/pl-ctype.h" #include #include #include "os/SWI-Stream.h" #include #include #ifdef HAVE_CRTDBG_H #include #endif /******************************* * CONSOLE * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - There is no way to tell which subsystem an app belongs too, except for peeking in its executable-header. This is a bit too much ... - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ int hasConsole(void) { HANDLE h; if ( GD->os.gui_app == FALSE ) /* has been set explicitly */ succeed; /* I found a console */ if ( (h = GetStdHandle(STD_OUTPUT_HANDLE)) != INVALID_HANDLE_VALUE ) { DWORD mode; if ( GetConsoleMode(h, &mode) ) succeed; } /* assume we are GUI */ fail; } int PL_wait_for_console_input(void *handle) { BOOL rc; HANDLE hConsole = handle; for(;;) { rc = MsgWaitForMultipleObjects(1, &hConsole, FALSE, /* wait for either event */ INFINITE, QS_ALLINPUT); if ( rc == WAIT_OBJECT_0+1 ) { MSG msg; while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) ) { TranslateMessage(&msg); DispatchMessage(&msg); } } else if ( rc == WAIT_OBJECT_0 ) { return TRUE; } else { DEBUG(MSG_WIN_API, Sdprintf("MsgWaitForMultipleObjects(): 0x%x\n", rc)); } } } /******************************* * MESSAGE BOX * *******************************/ void PlMessage(const char *fm, ...) { va_list(args); va_start(args, fm); if ( hasConsole() ) { Sfprintf(Serror, "SWI-Prolog: "); Svfprintf(Serror, fm, args); Sfprintf(Serror, "\n"); } else { char buf[1024]; int64_t hwndi; HWND hwnd = NULL; static atom_t ATOM_hwnd = 0; if ( !ATOM_hwnd ) ATOM_hwnd = PL_new_atom("hwnd"); if ( PL_current_prolog_flag(ATOM_hwnd, PL_INTEGER, &hwndi) ) hwnd = (HWND)(uintptr_t)hwndi; vsprintf(buf, fm, args); MessageBox(hwnd, buf, "SWI-Prolog", MB_OK|MB_TASKMODAL); } va_end(args); } /******************************* * WinAPI ERROR CODES * *******************************/ static const char * WinErrorNo(int id) { char *msg; static WORD lang; static int lang_initialised = 0; if ( !lang_initialised ) lang = MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_UK); again: if ( FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER| FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_FROM_SYSTEM, NULL, /* source */ id, /* identifier */ lang, (LPTSTR) &msg, 0, /* size */ NULL) ) /* arguments */ { atom_t a = PL_new_atom(msg); LocalFree(msg); lang_initialised = 1; return stringAtom(a); } else { if ( lang_initialised == 0 ) { lang = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT); lang_initialised = 1; goto again; } return "Unknown Windows error"; } } const char * WinError(void) { int id = GetLastError(); return WinErrorNo(id); } /******************************* * SLEEP/1 SUPPORT * *******************************/ int Pause(double t) { HANDLE h; if ( t <= 0.0 ) { SwitchToThread(); return TRUE; } if ( (h = CreateWaitableTimer(NULL, TRUE, NULL)) ) { LARGE_INTEGER ft; ft.QuadPart = -(LONGLONG)(t * 10000000.0); /* 100 nanosecs per tick */ SetWaitableTimer(h, &ft, 0, NULL, NULL, FALSE); for(;;) { int rc = MsgWaitForMultipleObjects(1, &h, FALSE, INFINITE, QS_ALLINPUT); if ( rc == WAIT_OBJECT_0+1 ) { MSG msg; while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) ) { TranslateMessage(&msg); DispatchMessage(&msg); if ( PL_exception(0) ) return FALSE; } if ( PL_handle_signals() < 0 ) { CloseHandle(h); return FALSE; } } else break; } CloseHandle(h); return TRUE; } else /* Pre NT implementation */ { DWORD msecs = (DWORD)(t * 1000.0); while( msecs >= 100 ) { Sleep(100); if ( PL_handle_signals() < 0 ) return FALSE; msecs -= 100; } if ( msecs > 0 ) Sleep(msecs); return TRUE; } } /******************************* * SET FILE SIZE * *******************************/ #ifndef HAVE_FTRUNCATE int ftruncate(int fileno, int64_t length) { errno_t e; if ( (e=_chsize_s(fileno, length)) == 0 ) return 0; errno = e; return -1; } #endif /******************************* * QUERY CPU TIME * *******************************/ #define nano * 0.0000001 #define ntick 1.0 /* manual says 100.0 ??? */ double CpuTime(cputime_kind which) { double t; HANDLE proc = GetCurrentProcess(); FILETIME created, exited, kerneltime, usertime; if ( GetProcessTimes(proc, &created, &exited, &kerneltime, &usertime) ) { FILETIME *p; switch ( which ) { case CPU_USER: p = &usertime; break; case CPU_SYSTEM: p = &kerneltime; break; default: assert(0); return 0.0; } t = (double)p->dwHighDateTime * (4294967296.0 * ntick nano); t += (double)p->dwLowDateTime * (ntick nano); } else /* '95, Windows 3.1/win32s */ { t = 0.0; } return t; } int CpuCount(void) { SYSTEM_INFO si; GetSystemInfo(&si); return si.dwNumberOfProcessors; } void setOSPrologFlags(void) { PL_set_prolog_flag("cpu_count", PL_INTEGER, (intptr_t)CpuCount()); #ifdef MSYS2 PL_set_prolog_flag("msys2", PL_BOOL|FF_READONLY, TRUE); #endif } char * findExecutable(const char *module, char *exe, size_t exelen) { int n; wchar_t wbuf[PATH_MAX]; HMODULE hmod; if ( module ) { if ( !(hmod = GetModuleHandle(module)) ) { hmod = GetModuleHandle("libswipl.dll"); DEBUG(MSG_WIN_API, Sdprintf("Warning: could not find module from \"%s\"\n" "Warning: Trying %s to find home\n", module, hmod ? "\"LIBPL.DLL\"" : "executable")); } } else hmod = NULL; if ( (n = GetModuleFileNameW(hmod, wbuf, PATH_MAX)) > 0 ) { wbuf[n] = EOS; return _xos_long_file_name_toA(wbuf, exe, exelen); } else if ( module ) { return PrologPath(module, exe, exelen); } else *exe = EOS; return exe; } char * findModulePath(const char *module, char *buf, size_t len) { wchar_t wbuf[PATH_MAX]; HMODULE hmod; if ( (hmod = GetModuleHandle(module)) ) { int n; if ( (n = GetModuleFileNameW(hmod, wbuf, PATH_MAX)) > 0 ) { wbuf[n] = EOS; char osbuf[PATH_MAX]; char *osp; if ( (osp=_xos_long_file_name_toA(wbuf, osbuf, sizeof(osbuf))) ) return PrologPath(osp, buf, len); } } return NULL; } /******************************* * SUPPORT FOR SHELL/2 * *******************************/ typedef struct { const char *name; UINT id; } showtype; static int get_showCmd(term_t show, UINT *cmd) { char *s; showtype *st; static showtype types[] = { { "hide", SW_HIDE }, { "maximize", SW_MAXIMIZE }, { "minimize", SW_MINIMIZE }, { "restore", SW_RESTORE }, { "show", SW_SHOW }, { "showdefault", SW_SHOWDEFAULT }, { "showmaximized", SW_SHOWMAXIMIZED }, { "showminimized", SW_SHOWMINIMIZED }, { "showminnoactive", SW_SHOWMINNOACTIVE }, { "showna", SW_SHOWNA }, { "shownoactive", SW_SHOWNOACTIVATE }, { "shownormal", SW_SHOWNORMAL }, /* compatibility */ { "normal", SW_SHOWNORMAL }, { "iconic", SW_MINIMIZE }, { NULL, 0 }, }; if ( show == 0 ) { *cmd = SW_SHOWNORMAL; succeed; } if ( !PL_get_chars(show, &s, CVT_ATOM|CVT_EXCEPTION) ) fail; for(st=types; st->name; st++) { if ( streq(st->name, s) ) { *cmd = st->id; succeed; } } return PL_error(NULL, 0, NULL, ERR_DOMAIN, PL_new_atom("win_show"), show); } static int win_exec(size_t len, const wchar_t *cmd, UINT show) { GET_LD STARTUPINFOW startup; PROCESS_INFORMATION info; int rval; wchar_t *wcmd; memset(&startup, 0, sizeof(startup)); startup.cb = sizeof(startup); startup.wShowWindow = show; /* ensure 0-terminated */ wcmd = PL_malloc((len+1)*sizeof(wchar_t)); memcpy(wcmd, cmd, len*sizeof(wchar_t)); wcmd[len] = 0; rval = CreateProcessW(NULL, /* app */ wcmd, NULL, NULL, /* security */ FALSE, /* inherit handles */ 0, /* flags */ NULL, /* environment */ NULL, /* Directory */ &startup, &info); /* process info */ PL_free(wcmd); if ( rval ) { CloseHandle(info.hProcess); CloseHandle(info.hThread); succeed; } else { term_t tmp = PL_new_term_ref(); return ( PL_unify_wchars(tmp, PL_ATOM, len, cmd) && PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp) ); } } static void utf8towcs_buffer(Buffer b, const char *src) { for( ; *src; ) { int wc; PL_utf8_code_point(&src, NULL, &wc); addWcharBuffer(b, wc); } addWcharBuffer(b, 0); } int System(char *command) /* command is a UTF-8 string */ { STARTUPINFOW sinfo; PROCESS_INFORMATION pinfo; int shell_rval; tmp_buffer buf; wchar_t *wcmd; memset(&sinfo, 0, sizeof(sinfo)); sinfo.cb = sizeof(sinfo); initBuffer(&buf); utf8towcs_buffer((Buffer)&buf, command); wcmd = baseBuffer(&buf, wchar_t); if ( CreateProcessW(NULL, /* module */ wcmd, /* command line */ NULL, /* Security stuff */ NULL, /* Thread security stuff */ FALSE, /* Inherit handles */ CREATE_NO_WINDOW, /* flags */ NULL, /* environment */ NULL, /* CWD */ &sinfo, /* startup info */ &pinfo) ) /* process into */ { BOOL rval; DWORD code; CloseHandle(pinfo.hThread); /* don't need this */ discardBuffer(&buf); do { MSG msg; if ( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) ) { TranslateMessage(&msg); DispatchMessage(&msg); } else Sleep(50); rval = GetExitCodeProcess(pinfo.hProcess, &code); } while(rval == TRUE && code == STILL_ACTIVE); shell_rval = (rval == TRUE ? code : -1); CloseHandle(pinfo.hProcess); } else { discardBuffer(&buf); return shell_rval = -1; } return shell_rval; } word pl_win_exec(term_t cmd, term_t how) { wchar_t *s; size_t len; UINT h; if ( PL_get_wchars(cmd, &len, &s, CVT_ALL|CVT_EXCEPTION) && get_showCmd(how, &h) ) { return win_exec(len, s, h); } else fail; } typedef struct { int eno; const char *message; } shell_error; static const shell_error se_errors[] = { { 0 , "Out of memory or resources" }, { ERROR_FILE_NOT_FOUND, "File not found" }, { ERROR_PATH_NOT_FOUND, "path not found" }, { ERROR_BAD_FORMAT, "Invalid .EXE" }, { SE_ERR_ACCESSDENIED, "Access denied" }, { SE_ERR_ASSOCINCOMPLETE, "Incomplete association" }, { SE_ERR_DDEBUSY, "DDE server busy" }, { SE_ERR_DDEFAIL, "DDE transaction failed" }, { SE_ERR_DDETIMEOUT, "DDE request timed out" }, { SE_ERR_DLLNOTFOUND, "DLL not found" }, { SE_ERR_FNF, "File not found (FNF)" }, { SE_ERR_NOASSOC, "No association" }, { SE_ERR_OOM, "Not enough memory" }, { SE_ERR_PNF, "Path not found (PNF)" }, { SE_ERR_SHARE, "Sharing violation" }, { 0, NULL } }; static int win_shell(term_t op, term_t file, term_t how) { size_t lo, lf; wchar_t *o, *f; UINT h; HINSTANCE instance; if ( !PL_get_wchars(op, &lo, &o, CVT_ALL|CVT_EXCEPTION|BUF_STACK) || !PL_get_wchars(file, &lf, &f, CVT_ALL|CVT_EXCEPTION|BUF_STACK) || !get_showCmd(how, &h) ) fail; instance = ShellExecuteW(NULL, o, f, NULL, NULL, h); if ( (intptr_t)instance <= 32 ) { const shell_error *se; for(se = se_errors; se->message; se++) { if ( se->eno == (int)(intptr_t)instance ) return PL_error(NULL, 0, se->message, ERR_SHELL_FAILED, file); } PL_error(NULL, 0, NULL, ERR_SHELL_FAILED, file); } succeed; } static PRED_IMPL("win_shell", 2, win_shell2, 0) { return win_shell(A1, A2, 0); } static PRED_IMPL("win_shell", 3, win_shell3, 0) { return win_shell(A1, A2, A3); } foreign_t pl_win_module_file(term_t module, term_t file) { char buf[PATH_MAX]; char *m; char *f; if ( !PL_get_chars(module, &m, CVT_ALL|CVT_EXCEPTION) ) fail; if ( (f = findExecutable(m, buf, sizeof(buf))) ) return PL_unify_atom_chars(file, f); fail; } /******************************* * WINDOWS MESSAGES * *******************************/ LRESULT PL_win_message_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) { #ifdef O_PLMT if ( hwnd == NULL && message == WM_SIGNALLED && wParam == 0 && /* or another constant? */ lParam == 0 ) { if ( PL_handle_signals() < 0 ) return PL_MSG_EXCEPTION_RAISED; return PL_MSG_HANDLED; } #endif return PL_MSG_IGNORED; } /******************************* * DLOPEN AND FRIENDS * *******************************/ #ifdef EMULATE_DLOPEN /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - These functions emulate the bits from the ELF shared object interface we need. They are used by pl-load.c, which defines the actual Prolog interface. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifdef HAVE_LIBLOADERAPI_H #include #else #ifndef LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR #define LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR 0x00000100 #endif #ifndef LOAD_LIBRARY_SEARCH_DEFAULT_DIRS #define LOAD_LIBRARY_SEARCH_DEFAULT_DIRS 0x00001000 #endif typedef void * DLL_DIRECTORY_COOKIE; #endif static const char *dlmsg; static DLL_DIRECTORY_COOKIE (WINAPI *f_AddDllDirectoryW)(wchar_t* dir); static BOOL (WINAPI *f_RemoveDllDirectory)(DLL_DIRECTORY_COOKIE); static DWORD load_library_search_flags(void) { static int done = FALSE; static DWORD flags = 0; if ( !done ) { HMODULE kernel = GetModuleHandle(TEXT("kernel32.dll")); if ( (f_AddDllDirectoryW = (void*)GetProcAddress(kernel, "AddDllDirectory")) && (f_RemoveDllDirectory = (void*)GetProcAddress(kernel, "RemoveDllDirectory")) ) { flags = ( LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR| LOAD_LIBRARY_SEARCH_DEFAULT_DIRS ); DEBUG(MSG_WIN_API, Sdprintf("LoadLibraryExW() flags are supported\n")); } else { DEBUG(MSG_WIN_API, Sdprintf("LoadLibraryExW() flags are NOT supported\n")); } done = TRUE; } return flags; } static PRED_IMPL("win_add_dll_directory", 2, win_add_dll_directory, 0) { PRED_LD char *dirs; if ( PL_get_file_name(A1, &dirs, REP_UTF8) ) { wchar_t dirw[PATH_MAX]; DLL_DIRECTORY_COOKIE cookie; if ( _xos_os_filenameW(dirs, dirw, PATH_MAX) == NULL ) return PL_representation_error("file_name"); if ( load_library_search_flags() ) { int eno; /* AddDllDirectoryW() cannot handle "\\?\" */ if ( (cookie = (*f_AddDllDirectoryW)(dirw + _xos_win_prefix_length(dirw))) ) { DEBUG(MSG_WIN_API, SdprintfX("AddDllDirectory(%Ws) ok\n", dirw)); return PL_unify_int64(A2, (int64_t)(uintptr_t)cookie); } switch((eno=GetLastError())) { case ERROR_FILE_NOT_FOUND: return PL_existence_error("directory", A1); case ERROR_INVALID_PARAMETER: return PL_domain_error("absolute_file_name", A1); } return PL_error(NULL, 0, WinErrorNo(eno), ERR_SYSCALL, "AddDllDirectory()"); } else return FALSE; } else return FALSE; } static PRED_IMPL("win_remove_dll_directory", 1, win_remove_dll_directory, 0) { int64_t icookie; if ( PL_get_int64_ex(A1, &icookie) ) { if ( f_RemoveDllDirectory ) { if ( (*f_RemoveDllDirectory)((DLL_DIRECTORY_COOKIE)(uintptr_t)icookie) ) return TRUE; return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "RemoveDllDirectory()"); } else return FALSE; } else return FALSE; } static int is_windows_abs_path(const wchar_t *path) { if ( path[1] == ':' && path[0] < 0x80 && iswalpha(path[0]) ) return TRUE; /* drive */ if ( path[0] == '\\' && path[1] == '\\' ) return TRUE; /* UNC */ return FALSE; } void * PL_dlopen(const char *file, int flags) /* file is in UTF-8, POSIX path */ { HINSTANCE h; DWORD llflags = 0; wchar_t wfile[PATH_MAX]; if ( strchr(file, '/') || strchr(file, '\\' ) ) { if ( _xos_os_filenameW(file, wfile, PATH_MAX) == NULL ) { dlmsg = "Name too long"; return NULL; } } else { wchar_t *w = wfile; wchar_t *e = &w[PATH_MAX-1]; for(const char *s = file; *s; ) { int c; s = utf8_get_char(s, &c); if ( w+2 >= e ) { dlmsg = "Name too long"; return NULL; } w = put_wchar(w, c); } *w = 0; } DEBUG(MSG_WIN_API, SdprintfX("dlopen(%Ws)\n", wfile)); if ( is_windows_abs_path(wfile) ) llflags |= load_library_search_flags(); if ( (h = LoadLibraryExW(wfile, NULL, llflags)) ) { dlmsg = "No Error"; return (void *)h; } dlmsg = WinError(); return NULL; } const char * PL_dlerror(void) { return dlmsg; } void * PL_dlsym(void *handle, char *symbol) { void *addr = GetProcAddress(handle, symbol); if ( addr ) { dlmsg = "No Error"; return addr; } dlmsg = WinError(); return NULL; } int PL_dlclose(void *handle) { FreeLibrary(handle); return 0; } #endif /*EMULATE_DLOPEN*/ static PRED_IMPL("win_process_modules", 1, win_process_modules, 0) { PRED_LD HANDLE hProcess = GetCurrentProcess(); HMODULE lphModule[100]; HMODULE *found=lphModule; DWORD cb = sizeof(lphModule); DWORD lpcbNeeded; int rc; for(;;) { if ( EnumProcessModules(hProcess, found, cb, &lpcbNeeded) ) { if ( lpcbNeeded > cb ) { if ( !(found = malloc(lpcbNeeded)) ) return PL_no_memory(); cb = lpcbNeeded; } else { term_t tail = PL_copy_term_ref(A1); term_t head = PL_new_term_ref(); int i; for(i=0; i 0 ) { name[n] = EOS; char name_utf8[PATH_MAX*2]; char pname[PATH_MAX*2]; if ( _xos_canonical_filenameW(name, name_utf8, sizeof(name_utf8), XOS_DOWNCASE) && PrologPath(name_utf8, pname, sizeof(pname)) ) { if ( !PL_unify_list(tail, head, tail) || !PL_unify_chars(head, PL_ATOM|REP_FN, (size_t)-1, pname) ) { rc = FALSE; goto out; } } else { rc = PL_representation_error("max_path_length"); goto out; } } } rc = PL_unify_nil(tail); break; } } } out: if ( found != lphModule ) free(found); return rc; } /******************************* * SNPRINTF MADNESS * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - MS-Windows _snprintf() may look like C99 snprintf(), but is is not quite the same: on overflow, the buffer is *not* 0-terminated and the return is negative (unspecified how negative). The code below works around this, returning count on overflow. This is still not the same as the C99 version that returns the number of characters that would have been written, but it seems to be enough for our purposes. See http://www.di-mgt.com.au/cprog.html#snprintf The above came from the provided link, but it is even worse (copied from VS2005 docs): - If len < count, then len characters are stored in buffer, a null-terminator is appended, and len is returned. - If len = count, then len characters are stored in buffer, no null-terminator is appended, and len is returned. - If len > count, then count characters are stored in buffer, no null-terminator is appended, and a negative value is returned. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ int ms_snprintf(char *buffer, size_t count, const char *fmt, ...) { va_list ap; int ret; va_start(ap, fmt); ret = _vsnprintf(buffer, count-1, fmt, ap); va_end(ap); if ( ret < 0 || ret == count ) { ret = (int)count; buffer[count-1] = '\0'; } return ret; } /******************************* * FOLDERS * *******************************/ #ifdef HAVE_SHLOBJ_H #include #endif typedef struct folderid { int csidl; const char *name; } folderid; static const folderid folderids[] = { { CSIDL_COMMON_ALTSTARTUP, "common_altstartup" }, { CSIDL_ALTSTARTUP, "altstartup" }, { CSIDL_APPDATA, "appdata" }, { CSIDL_COMMON_APPDATA, "common_appdata" }, { CSIDL_LOCAL_APPDATA, "local_appdata" }, { CSIDL_CONTROLS, "controls" }, { CSIDL_COOKIES, "cookies" }, { CSIDL_DESKTOP, "desktop" }, { CSIDL_COMMON_DESKTOPDIRECTORY, "common_desktopdirectory" }, { CSIDL_DESKTOPDIRECTORY, "desktopdirectory" }, { CSIDL_COMMON_FAVORITES, "common_favorites" }, { CSIDL_FAVORITES, "favorites" }, { CSIDL_FONTS, "fonts" }, { CSIDL_HISTORY, "history" }, { CSIDL_INTERNET_CACHE, "internet_cache" }, { CSIDL_INTERNET, "internet" }, { CSIDL_DRIVES, "drives" }, { CSIDL_PERSONAL, "personal" }, { CSIDL_NETWORK, "network" }, { CSIDL_NETHOOD, "nethood" }, { CSIDL_PERSONAL, "personal" }, { CSIDL_PRINTERS, "printers" }, { CSIDL_PRINTHOOD, "printhood" }, { CSIDL_COMMON_PROGRAMS, "common_programs" }, { CSIDL_PROGRAMS, "programs" }, { CSIDL_RECENT, "recent" }, { CSIDL_BITBUCKET, "bitbucket" }, { CSIDL_SENDTO, "sendto" }, { CSIDL_COMMON_STARTMENU, "common_startmenu" }, { CSIDL_STARTMENU, "startmenu" }, { CSIDL_COMMON_STARTUP, "common_startup" }, { CSIDL_STARTUP, "startup" }, { CSIDL_TEMPLATES, "templates" }, { 0, NULL } }; static int unify_csidl_path(term_t t, int csidl) { wchar_t buf[PATH_MAX]; if ( SHGetSpecialFolderPathW(0, buf, csidl, FALSE) ) { wchar_t *p; for(p=buf; *p; p++) { if ( *p == '\\' ) *p = '/'; } return PL_unify_wchars(t, PL_ATOM, -1, buf); } else return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "SHGetSpecialFolderPath"); } static PRED_IMPL("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC) { GET_LD int n; switch( CTX_CNTRL ) { case FRG_FIRST_CALL: if ( PL_is_variable(A1) ) { n = 0; goto generate; } else { char *s; if ( PL_get_chars(A1, &s, CVT_ATOM|CVT_EXCEPTION) ) { const folderid *fid; for(fid = folderids; fid->name; fid++) { if ( streq(s, fid->name) ) return unify_csidl_path(A2, fid->csidl); } { atom_t dom = PL_new_atom("win_folder"); PL_error(NULL, 0, NULL, ERR_DOMAIN, dom, A1); PL_unregister_atom(dom); return FALSE; } } else return FALSE; } case FRG_REDO: { fid_t fid; n = (int)CTX_INT+1; generate: fid = PL_open_foreign_frame(); for(; folderids[n].name; n++) { if ( unify_csidl_path(A2, folderids[n].csidl) && PL_unify_atom_chars(A1, folderids[n].name) ) { PL_close_foreign_frame(fid); ForeignRedoInt(n); } if ( PL_exception(0) ) PL_clear_exception(); PL_rewind_foreign_frame(fid); } PL_close_foreign_frame(fid); return FALSE; } default: succeed; } } /******************************* * REGISTRY * *******************************/ #define wstreq(s,q) (wcscmp((s), (q)) == 0) static HKEY reg_open_key(const wchar_t *which, int create) { HKEY key = HKEY_CURRENT_USER; DWORD disp; LONG rval; while(*which) { wchar_t buf[256]; wchar_t *s; HKEY tmp; for(s=buf; *which && !(*which == '/' || *which == '\\'); ) *s++ = *which++; *s = '\0'; if ( *which ) which++; if ( wstreq(buf, L"HKEY_CLASSES_ROOT") ) { key = HKEY_CLASSES_ROOT; continue; } else if ( wstreq(buf, L"HKEY_CURRENT_USER") ) { key = HKEY_CURRENT_USER; continue; } else if ( wstreq(buf, L"HKEY_LOCAL_MACHINE") ) { key = HKEY_LOCAL_MACHINE; continue; } else if ( wstreq(buf, L"HKEY_USERS") ) { key = HKEY_USERS; continue; } DEBUG(2, Sdprintf("Trying %s\n", buf)); if ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS ) { RegCloseKey(key); key = tmp; continue; } if ( !create ) return NULL; rval = RegCreateKeyExW(key, buf, 0, L"", 0, KEY_ALL_ACCESS, NULL, &tmp, &disp); RegCloseKey(key); if ( rval == ERROR_SUCCESS ) key = tmp; else return NULL; } return key; } #define MAXREGSTRLEN 1024 static PRED_IMPL("win_registry_get_value", 3, win_registry_get_value, 0) { GET_LD DWORD type; union { BYTE bytes[MAXREGSTRLEN]; wchar_t wchars[MAXREGSTRLEN/sizeof(wchar_t)]; DWORD dword; } data; DWORD len = sizeof(data); size_t klen, namlen; wchar_t *k, *name; HKEY key; term_t Key = A1; term_t Name = A2; term_t Value = A3; if ( !PL_get_wchars(Key, &klen, &k, CVT_ATOM|CVT_EXCEPTION) || !PL_get_wchars(Name, &namlen, &name, CVT_ATOM|CVT_ATOM) ) return FALSE; if ( !(key=reg_open_key(k, FALSE)) ) return PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_key, Key); DEBUG(9, Sdprintf("key = %p, name = %s\n", key, name)); if ( RegQueryValueExW(key, name, NULL, &type, data.bytes, &len) == ERROR_SUCCESS ) { RegCloseKey(key); switch(type) { case REG_SZ: return PL_unify_wchars(Value, PL_ATOM, len/sizeof(wchar_t)-1, data.wchars); case REG_DWORD: return PL_unify_integer(Value, data.dword); default: warning("get_registry_value/2: Unknown registery-type: %d", type); fail; } } return FALSE; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Get the local, global, trail and argument-stack defaults from the registry. They can be on the HKEY_CURRENT_USER as well as the HKEY_LOCAL_MACHINE registries to allow for both user-only and system-wide settings. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static struct regdef { const char *name; size_t *address; } const regdefs[] = { { "stackLimit", &GD->defaults.stack_limit }, { "tableSpace", &GD->defaults.table_space }, { NULL, NULL } }; static void setStacksFromKey(HKEY key) { DWORD type; union { BYTE bytes[128]; DWORD dword; } data; DWORD len = sizeof(data); const struct regdef *rd; for(rd = regdefs; rd->name; rd++) { if ( RegQueryValueEx(key, rd->name, NULL, &type, data.bytes, &len) == ERROR_SUCCESS && type == REG_DWORD ) { DWORD v = data.dword; *rd->address = (size_t)v; } } } void getDefaultsFromRegistry(void) { HKEY key; if ( (key = reg_open_key(L"HKEY_LOCAL_MACHINE/Software/SWI/Prolog", FALSE)) ) { setStacksFromKey(key); RegCloseKey(key); } if ( (key = reg_open_key(L"HKEY_CURRENT_USER/Software/SWI/Prolog", FALSE)) ) { setStacksFromKey(key); RegCloseKey(key); } } const char * PL_w32_running_under_wine(void) { static const char * (CDECL *pwine_get_version)(void); HMODULE hntdll = GetModuleHandle("ntdll.dll"); if ( !hntdll ) { return NULL; } if ( (pwine_get_version = (void *)GetProcAddress(hntdll, "wine_get_version")) ) return pwine_get_version(); return NULL; } /******************************* * MUI * *******************************/ static int langid_num(const wchar_t *s) { int v=0; for(; *s; s++) { v = v<<4; if ( *s >= '0' && *s <= '9' ) v += *s-'0'; else if ( *s >= 'A' && *s <= 'F' ) v += *s-'A'+10; else if ( *s >= 'a' && *s <= 'f' ) v += *s-'a'+10; else assert(0); } return v; } static PRED_IMPL("win_get_user_preferred_ui_languages", 2, win_get_user_preferred_ui_languages, 0) { PRED_LD char *how; DWORD flags; ULONG num, sz = 0; wchar_t store[1024]; wchar_t *buf = store; int rc = TRUE; if ( PL_get_atom_chars(A1, &how) ) { if ( strcmp(how, "id") == 0 ) flags = MUI_LANGUAGE_ID; else if ( strcmp(how, "name") == 0 ) flags = MUI_LANGUAGE_NAME; else return PL_domain_error("format", A1); } else return PL_type_error("atom", A1); if ( (rc=GetUserPreferredUILanguages(flags, &num, NULL, &sz)) ) { if ( sz > sizeof(store)/sizeof(store[0]) ) { if ( !(buf = malloc(sz*sizeof(store[0]))) ) return PL_no_memory(); } if ( (rc=GetUserPreferredUILanguages(flags, &num, buf, &sz)) ) { term_t tail = PL_copy_term_ref(A2); term_t head = PL_new_term_ref(); wchar_t *s = buf; while( rc && *s ) { if ( (rc=PL_unify_list(tail, head, tail)) ) { if ( flags == MUI_LANGUAGE_NAME ) { rc = PL_unify_wchars(head, PL_ATOM, (size_t)-1, s); } else { rc = PL_unify_integer(head, langid_num(s)); } } if ( rc ) { s += wcslen(s); s ++; } } rc = rc && PL_unify_nil(tail); } } if ( buf && buf != store ) free(buf); return rc; } /******************************* * PUBLISH PREDICATES * *******************************/ BeginPredDefs(win) PRED_DEF("win_shell", 2, win_shell2, 0) PRED_DEF("win_shell", 3, win_shell3, 0) PRED_DEF("win_registry_get_value", 3, win_registry_get_value, 0) PRED_DEF("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC) PRED_DEF("win_add_dll_directory", 2, win_add_dll_directory, 0) PRED_DEF("win_remove_dll_directory", 1, win_remove_dll_directory, 0) PRED_DEF("win_process_modules", 1, win_process_modules, 0) PRED_DEF("win_get_user_preferred_ui_languages", 2, win_get_user_preferred_ui_languages, 0) EndPredDefs #endif /*__WINDOWS__*/