/* $Id$ Part of SWI-Prolog Author: Jan Wielemaker E-mail: jan@swi.psy.uva.nl WWW: http://www.swi-prolog.org Copyright (C): 1985-2002, University of Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef __MINGW32__ #define __WINDOWS__ 1 #endif #ifdef __WINDOWS__ #define WINVER 0x0501 #if (_MSC_VER >= 1300) || __MINGW32__ #include /* Needed on VC8 */ #include #else #include /* Needed for MSVC 5&6 */ #include #endif #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-incl.h" #ifdef __YAP_PROLOG__ #include "pl-utf8.h" #else #include "os/pl-utf8.h" #endif #include #ifdef __YAP_PROLOG__ #include "pl-ctype.h" #else #include "os/pl-ctype.h" #endif #include #include #ifdef __YAP_PROLOG__ #include "SWI-Stream.h" #else #include "os/SWI-Stream.h" #endif #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 { 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]; vsprintf(buf, fm, args); MessageBox(NULL, buf, "SWI-Prolog", MB_OK|MB_TASKMODAL); } va_end(args); } /******************************* * WinAPI ERROR CODES * *******************************/ const char * WinError(void) { int id = GetLastError(); 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"; } } /******************************* * SLEEP/1 SUPPORT * *******************************/ int Pause(double t) { HANDLE h; 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_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; } static int CpuCount(void) { SYSTEM_INFO si; GetSystemInfo(&si); return si.dwNumberOfProcessors; } void setOSPrologFlags(void) { PL_set_prolog_flag("cpu_count", PL_INTEGER, CpuCount()); } char * findExecutable(const char *module, char *exe) { int n; wchar_t wbuf[MAXPATHLEN]; HMODULE hmod; if ( module ) { if ( !(hmod = GetModuleHandle(module)) ) { hmod = GetModuleHandle("libswipl.dll"); DEBUG(0, 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, MAXPATHLEN)) > 0 ) { wbuf[n] = EOS; return _xos_long_file_name_toA(wbuf, exe, MAXPATHLEN); } else if ( module ) { char buf[MAXPATHLEN]; PrologPath(module, buf, sizeof(buf)); strcpy(exe, buf); } else *exe = EOS; return exe; } /******************************* * 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(wchar_t *o, const char *src) { for( ; *src; ) { int wc; src = utf8_get_char(src, &wc); *o++ = wc; } *o = 0; } int System(char *command) /* command is a UTF-8 string */ { STARTUPINFOW sinfo; PROCESS_INFORMATION pinfo; int shell_rval; size_t len; wchar_t *wcmd; memset(&sinfo, 0, sizeof(sinfo)); sinfo.cb = sizeof(sinfo); len = utf8_strlen(command, strlen(command)); wcmd = PL_malloc((len+1)*sizeof(wchar_t)); utf8towcs(wcmd, command); 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 */ PL_free(wcmd); 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 { PL_free(wcmd); 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_RING) || !PL_get_wchars(file, &lf, &f, CVT_ALL|CVT_EXCEPTION|BUF_RING) || !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[MAXPATHLEN]; char *m; char *f; if ( !PL_get_chars(module, &m, CVT_ALL|CVT_EXCEPTION) ) fail; if ( (f = findExecutable(m, 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 ); } 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) ) { size_t len = utf8_strlen(dirs, strlen(dirs)); wchar_t *dirw = alloca((len+10)*sizeof(wchar_t)); DLL_DIRECTORY_COOKIE cookie; if ( _xos_os_filenameW(dirs, dirw, len+10) == NULL ) return PL_representation_error("file_name"); if ( load_library_search_flags() ) { if ( (cookie = (*f_AddDllDirectoryW)(dirw)) ) return PL_unify_int64(A2, (int64_t)cookie); return PL_error(NULL, 0, WinError(), 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)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 * dlopen(const char *file, int flags) /* file is in UTF-8, POSIX path */ { HINSTANCE h; DWORD llflags = 0; size_t len = utf8_strlen(file, strlen(file)); wchar_t *wfile = alloca((len+10)*sizeof(wchar_t)); if ( !wfile ) { dlmsg = "No memory"; return NULL; } if ( _xos_os_filenameW(file, wfile, len+10) == NULL ) { dlmsg = "Name too long"; return NULL; } 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 * dlerror(void) { return dlmsg; } void * dlsym(void *handle, char *symbol) { void *addr = GetProcAddress(handle, symbol); if ( addr ) { dlmsg = "No Error"; return addr; } dlmsg = WinError(); return NULL; } int dlclose(void *handle) { FreeLibrary(handle); return 0; } #endif /*EMULATE_DLOPEN*/ /******************************* * 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_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[MAX_PATH]; 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); } 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; BYTE data[MAXREGSTRLEN]; 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, PL_new_atom("key"), Key); DEBUG(9, Sdprintf("key = %p, name = %s\n", key, name)); if ( RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) { RegCloseKey(key); DWORD *datap; switch(type) { case REG_SZ: return PL_unify_wchars(Value, PL_ATOM, len/sizeof(wchar_t)-1, (wchar_t*)data); case REG_DWORD: { datap = (DWORD *)data; return PL_unify_integer(Value, datap[0]); } default: warning("get_registry_value/2: Unknown registry-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; int *address; } const regdefs[] = { { "localSize", &GD->defaults.local }, { "globalSize", &GD->defaults.global }, { "trailSize", &GD->defaults.trail }, { NULL, NULL } }; static void setStacksFromKey(HKEY key) { DWORD type; BYTE data[128]; DWORD len = sizeof(data); const struct regdef *rd; for(rd = regdefs; rd->name; rd++) { if ( RegQueryValueEx(key, rd->name, NULL, &type, data, &len) == ERROR_SUCCESS && type == REG_DWORD ) { DWORD v, *datap = (DWORD *)data; v = datap[0]; *rd->address = (int)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); } } /******************************* * 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) #ifdef EMULATE_DLOPEN PRED_DEF("win_add_dll_directory", 2, win_add_dll_directory, 0) PRED_DEF("win_remove_dll_directory", 1, win_remove_dll_directory, 0) #endif EndPredDefs #endif /*__WINDOWS__*/