5 #define PERL_NO_GET_CONTEXT
\r
11 # define countof(array) (sizeof (array) / sizeof (*(array)))
\r
14 #define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege"
\r
16 #ifndef WC_NO_BEST_FIT_CHARS
\r
17 # define WC_NO_BEST_FIT_CHARS 0x00000400
\r
20 #define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn)
\r
22 typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathA)(HWND, char*, int, BOOL);
\r
23 typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathW)(HWND, WCHAR*, int, BOOL);
\r
24 typedef HRESULT (WINAPI *PFNSHGetFolderPathA)(HWND, int, HANDLE, DWORD, LPTSTR);
\r
25 typedef HRESULT (WINAPI *PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR);
\r
26 typedef BOOL (WINAPI *PFNCreateEnvironmentBlock)(void**, HANDLE, BOOL);
\r
27 typedef BOOL (WINAPI *PFNDestroyEnvironmentBlock)(void*);
\r
28 typedef int (__stdcall *PFNDllRegisterServer)(void);
\r
29 typedef int (__stdcall *PFNDllUnregisterServer)(void);
\r
30 typedef DWORD (__stdcall *PFNNetApiBufferFree)(void*);
\r
31 typedef DWORD (__stdcall *PFNNetWkstaGetInfo)(LPWSTR, DWORD, void*);
\r
33 typedef BOOL (__stdcall *PFNOpenProcessToken)(HANDLE, DWORD, HANDLE*);
\r
34 typedef BOOL (__stdcall *PFNOpenThreadToken)(HANDLE, DWORD, BOOL, HANDLE*);
\r
35 typedef BOOL (__stdcall *PFNGetTokenInformation)(HANDLE, TOKEN_INFORMATION_CLASS, void*, DWORD, DWORD*);
\r
36 typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD,
\r
37 DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*);
\r
38 typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);
\r
39 typedef void* (__stdcall *PFNFreeSid)(PSID);
\r
40 typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);
\r
42 #ifndef CSIDL_MYMUSIC
\r
43 # define CSIDL_MYMUSIC 0x000D
\r
45 #ifndef CSIDL_MYVIDEO
\r
46 # define CSIDL_MYVIDEO 0x000E
\r
48 #ifndef CSIDL_LOCAL_APPDATA
\r
49 # define CSIDL_LOCAL_APPDATA 0x001C
\r
51 #ifndef CSIDL_COMMON_FAVORITES
\r
52 # define CSIDL_COMMON_FAVORITES 0x001F
\r
54 #ifndef CSIDL_INTERNET_CACHE
\r
55 # define CSIDL_INTERNET_CACHE 0x0020
\r
57 #ifndef CSIDL_COOKIES
\r
58 # define CSIDL_COOKIES 0x0021
\r
60 #ifndef CSIDL_HISTORY
\r
61 # define CSIDL_HISTORY 0x0022
\r
63 #ifndef CSIDL_COMMON_APPDATA
\r
64 # define CSIDL_COMMON_APPDATA 0x0023
\r
66 #ifndef CSIDL_WINDOWS
\r
67 # define CSIDL_WINDOWS 0x0024
\r
69 #ifndef CSIDL_PROGRAM_FILES
\r
70 # define CSIDL_PROGRAM_FILES 0x0026
\r
72 #ifndef CSIDL_MYPICTURES
\r
73 # define CSIDL_MYPICTURES 0x0027
\r
75 #ifndef CSIDL_PROFILE
\r
76 # define CSIDL_PROFILE 0x0028
\r
78 #ifndef CSIDL_PROGRAM_FILES_COMMON
\r
79 # define CSIDL_PROGRAM_FILES_COMMON 0x002B
\r
81 #ifndef CSIDL_COMMON_TEMPLATES
\r
82 # define CSIDL_COMMON_TEMPLATES 0x002D
\r
84 #ifndef CSIDL_COMMON_DOCUMENTS
\r
85 # define CSIDL_COMMON_DOCUMENTS 0x002E
\r
87 #ifndef CSIDL_COMMON_ADMINTOOLS
\r
88 # define CSIDL_COMMON_ADMINTOOLS 0x002F
\r
90 #ifndef CSIDL_ADMINTOOLS
\r
91 # define CSIDL_ADMINTOOLS 0x0030
\r
93 #ifndef CSIDL_COMMON_MUSIC
\r
94 # define CSIDL_COMMON_MUSIC 0x0035
\r
96 #ifndef CSIDL_COMMON_PICTURES
\r
97 # define CSIDL_COMMON_PICTURES 0x0036
\r
99 #ifndef CSIDL_COMMON_VIDEO
\r
100 # define CSIDL_COMMON_VIDEO 0x0037
\r
102 #ifndef CSIDL_CDBURN_AREA
\r
103 # define CSIDL_CDBURN_AREA 0x003B
\r
105 #ifndef CSIDL_FLAG_CREATE
\r
106 # define CSIDL_FLAG_CREATE 0x8000
\r
109 /* Use explicit struct definition because wSuiteMask and
\r
110 * wProductType are not defined in the VC++ 6.0 headers.
\r
111 * WORD type has been replaced by unsigned short because
\r
112 * WORD is already used by Perl itself.
\r
115 DWORD dwOSVersionInfoSize;
\r
116 DWORD dwMajorVersion;
\r
117 DWORD dwMinorVersion;
\r
118 DWORD dwBuildNumber;
\r
119 DWORD dwPlatformId;
\r
120 CHAR szCSDVersion[128];
\r
121 unsigned short wServicePackMajor;
\r
122 unsigned short wServicePackMinor;
\r
123 unsigned short wSuiteMask;
\r
126 } g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0};
\r
127 BOOL g_osver_ex = TRUE;
\r
129 #define ONE_K_BUFSIZE 1024
\r
134 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
\r
140 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
\r
146 return (g_osver.dwMajorVersion > 4);
\r
149 /* Convert SV to wide character string. The return value must be
\r
150 * freed using Safefree().
\r
153 sv_to_wstr(pTHX_ SV *sv)
\r
158 char *str = SvPV(sv, len);
\r
159 UINT cp = SvUTF8(sv) ? CP_UTF8 : CP_ACP;
\r
161 wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0);
\r
162 New(0, wstr, wlen, WCHAR);
\r
163 MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen);
\r
168 /* Convert wide character string to mortal SV. Use UTF8 encoding
\r
169 * if the string cannot be represented in the system codepage.
\r
172 wstr_to_sv(pTHX_ WCHAR *wstr)
\r
174 int wlen = (int)wcslen(wstr)+1;
\r
175 BOOL use_default = FALSE;
\r
176 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, NULL, 0, NULL, NULL);
\r
177 SV *sv = sv_2mortal(newSV(len));
\r
179 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, SvPVX(sv), len, NULL, &use_default);
\r
181 len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, NULL, 0, NULL, NULL);
\r
183 len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, SvPVX(sv), len, NULL, NULL);
\r
186 /* Shouldn't really ever fail since we ask for the required length first, but who knows... */
\r
189 SvCUR_set(sv, len-1);
\r
194 /* Retrieve a variable from the Unicode environment in a mortal SV.
\r
196 * Recreates the Unicode environment because a bug in earlier Perl versions
\r
197 * overwrites it with the ANSI version, which contains replacement
\r
198 * characters for the characters not in the ANSI codepage.
\r
201 get_unicode_env(pTHX_ WCHAR *name)
\r
207 PFNOpenProcessToken pfnOpenProcessToken;
\r
209 /* Get security token for the current process owner */
\r
210 module = LoadLibrary("advapi32.dll");
\r
214 GETPROC(OpenProcessToken);
\r
216 if (pfnOpenProcessToken == NULL ||
\r
217 !pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY | TOKEN_DUPLICATE, &token))
\r
219 FreeLibrary(module);
\r
222 FreeLibrary(module);
\r
224 /* Create a Unicode environment block for this process */
\r
225 module = LoadLibrary("userenv.dll");
\r
227 PFNCreateEnvironmentBlock pfnCreateEnvironmentBlock;
\r
228 PFNDestroyEnvironmentBlock pfnDestroyEnvironmentBlock;
\r
230 GETPROC(CreateEnvironmentBlock);
\r
231 GETPROC(DestroyEnvironmentBlock);
\r
233 if (pfnCreateEnvironmentBlock && pfnDestroyEnvironmentBlock &&
\r
234 pfnCreateEnvironmentBlock(&env, token, FALSE))
\r
236 size_t name_len = wcslen(name);
\r
237 WCHAR *entry = env;
\r
240 size_t entry_len = wcslen(entry);
\r
241 BOOL equal = (entry_len > name_len) && (entry[name_len] == '=');
\r
243 for (i=0; equal && i < name_len; ++i)
\r
244 equal = (towupper(entry[i]) == towupper(name[i]));
\r
247 sv = wstr_to_sv(aTHX_ entry+name_len+1);
\r
250 entry += entry_len+1;
\r
252 pfnDestroyEnvironmentBlock(env);
\r
254 FreeLibrary(module);
\r
256 CloseHandle(token);
\r
260 /* Define both an ANSI and a Wide version of win32_longpath */
\r
262 #define CHAR_T char
\r
263 #define WIN32_FIND_DATA_T WIN32_FIND_DATAA
\r
264 #define FN_FINDFIRSTFILE FindFirstFileA
\r
265 #define FN_STRLEN strlen
\r
266 #define FN_STRCPY strcpy
\r
267 #define LONGPATH my_longpathA
\r
268 #include "longpath.inc"
\r
270 #define CHAR_T WCHAR
\r
271 #define WIN32_FIND_DATA_T WIN32_FIND_DATAW
\r
272 #define FN_FINDFIRSTFILE FindFirstFileW
\r
273 #define FN_STRLEN wcslen
\r
274 #define FN_STRCPY wcscpy
\r
275 #define LONGPATH my_longpathW
\r
276 #include "longpath.inc"
\r
278 /* The my_ansipath() function takes a Unicode filename and converts it
\r
279 * into the current Windows codepage. If some characters cannot be mapped,
\r
280 * then it will convert the short name instead.
\r
282 * The buffer to the ansi pathname must be freed with Safefree() when it
\r
283 * it no longer needed.
\r
285 * The argument to my_ansipath() must exist before this function is
\r
286 * called; otherwise there is no way to determine the short path name.
\r
288 * Ideas for future refinement:
\r
289 * - Only convert those segments of the path that are not in the current
\r
290 * codepage, but leave the other segments in their long form.
\r
291 * - If the resulting name is longer than MAX_PATH, start converting
\r
292 * additional path segments into short names until the full name
\r
293 * is shorter than MAX_PATH. Shorten the filename part last!
\r
296 /* This is a modified version of core Perl win32/win32.c(win32_ansipath).
\r
297 * It uses New() etc. instead of win32_malloc().
\r
301 my_ansipath(const WCHAR *widename)
\r
304 BOOL use_default = FALSE;
\r
305 int widelen = (int)wcslen(widename)+1;
\r
306 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
\r
307 NULL, 0, NULL, NULL);
\r
308 New(0, name, len, char);
\r
309 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
\r
310 name, len, NULL, &use_default);
\r
312 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
\r
315 New(0, shortname, shortlen, WCHAR);
\r
316 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
\r
318 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
\r
319 NULL, 0, NULL, NULL);
\r
320 Renew(name, len, char);
\r
321 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
\r
322 name, len, NULL, NULL);
\r
323 Safefree(shortname);
\r
329 /* Convert wide character path to ANSI path and return as mortal SV. */
\r
331 wstr_to_ansipath(pTHX_ WCHAR *wstr)
\r
333 char *ansi = my_ansipath(wstr);
\r
334 SV *sv = sv_2mortal(newSVpvn(ansi, strlen(ansi)));
\r
348 WCHAR filename[MAX_PATH+1];
\r
349 GetCurrentDirectoryW(MAX_PATH+1, filename);
\r
350 ptr = my_ansipath(filename);
\r
353 char filename[MAX_PATH+1];
\r
354 GetCurrentDirectoryA(MAX_PATH+1, filename);
\r
355 New(0, ptr, strlen(filename)+1, char);
\r
356 strcpy(ptr, filename);
\r
362 free_childdir(char *d)
\r
375 free_childenv(void *d)
\r
379 # define PerlDir_mapA(dir) (dir)
\r
383 XS(w32_ExpandEnvironmentStrings)
\r
388 croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
\r
391 WCHAR value[31*1024];
\r
392 WCHAR *source = sv_to_wstr(aTHX_ ST(0));
\r
393 ExpandEnvironmentStringsW(source, value, countof(value)-1);
\r
394 ST(0) = wstr_to_sv(aTHX_ value);
\r
399 char value[31*1024];
\r
400 ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), value, countof(value)-2);
\r
401 XSRETURN_PV(value);
\r
405 XS(w32_IsAdminUser)
\r
409 PFNIsUserAnAdmin pfnIsUserAnAdmin;
\r
410 PFNOpenThreadToken pfnOpenThreadToken;
\r
411 PFNOpenProcessToken pfnOpenProcessToken;
\r
412 PFNGetTokenInformation pfnGetTokenInformation;
\r
413 PFNAllocateAndInitializeSid pfnAllocateAndInitializeSid;
\r
414 PFNEqualSid pfnEqualSid;
\r
415 PFNFreeSid pfnFreeSid;
\r
417 DWORD dwTokInfoLen;
\r
418 TOKEN_GROUPS *lpTokInfo;
\r
419 SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY;
\r
425 croak("usage: Win32::IsAdminUser()");
\r
427 /* There is no concept of "Administrator" user accounts on Win9x systems,
\r
428 so just return true. */
\r
432 /* Use IsUserAnAdmin() when available. On Vista this will only return TRUE
\r
433 * if the process is running with elevated privileges and not just when the
\r
434 * process owner is a member of the "Administrators" group.
\r
436 module = LoadLibrary("shell32.dll");
\r
438 GETPROC(IsUserAnAdmin);
\r
439 if (pfnIsUserAnAdmin) {
\r
441 ST(0) = sv_2mortal(newSViv(pfnIsUserAnAdmin() ? 1 : 0));
\r
442 FreeLibrary(module);
\r
445 FreeLibrary(module);
\r
448 module = LoadLibrary("advapi32.dll");
\r
450 warn("Cannot load advapi32.dll library");
\r
454 GETPROC(OpenThreadToken);
\r
455 GETPROC(OpenProcessToken);
\r
456 GETPROC(GetTokenInformation);
\r
457 GETPROC(AllocateAndInitializeSid);
\r
461 if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
\r
462 pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
\r
463 pfnEqualSid && pfnFreeSid))
\r
465 warn("Cannot load functions from advapi32.dll library");
\r
466 FreeLibrary(module);
\r
470 if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
\r
471 if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
\r
472 warn("Cannot open thread token or process token");
\r
473 FreeLibrary(module);
\r
478 pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
\r
479 if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
\r
480 warn("Cannot allocate token information structure");
\r
482 FreeLibrary(module);
\r
486 if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
\r
489 warn("Cannot get token information");
\r
490 Safefree(lpTokInfo);
\r
492 FreeLibrary(module);
\r
496 if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
\r
497 DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))
\r
499 warn("Cannot allocate administrators' SID");
\r
500 Safefree(lpTokInfo);
\r
502 FreeLibrary(module);
\r
507 for (i = 0; i < lpTokInfo->GroupCount; ++i) {
\r
508 if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {
\r
514 pfnFreeSid(pAdminSid);
\r
515 Safefree(lpTokInfo);
\r
517 FreeLibrary(module);
\r
520 ST(0) = sv_2mortal(newSViv(iRetVal));
\r
524 XS(w32_LookupAccountName)
\r
535 croak("usage: Win32::LookupAccountName($system, $account, $domain, "
\r
536 "$sid, $sidtype);\n");
\r
538 SIDLen = sizeof(SID);
\r
539 DomLen = sizeof(Domain);
\r
541 bResult = LookupAccountNameA(SvPV_nolen(ST(0)), /* System */
\r
542 SvPV_nolen(ST(1)), /* Account name */
\r
543 &SID, /* SID structure */
\r
544 &SIDLen, /* Size of SID buffer */
\r
545 Domain, /* Domain buffer */
\r
546 &DomLen, /* Domain buffer size */
\r
547 &snu); /* SID name type */
\r
549 sv_setpv(ST(2), Domain);
\r
550 sv_setpvn(ST(3), SID, SIDLen);
\r
551 sv_setiv(ST(4), snu);
\r
558 XS(w32_LookupAccountSID)
\r
563 DWORD AcctLen = sizeof(Account);
\r
565 DWORD DomLen = sizeof(Domain);
\r
570 croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
\r
572 sid = SvPV_nolen(ST(1));
\r
573 if (IsValidSid(sid)) {
\r
574 bResult = LookupAccountSidA(SvPV_nolen(ST(0)), /* System */
\r
575 sid, /* SID structure */
\r
576 Account, /* Account name buffer */
\r
577 &AcctLen, /* name buffer length */
\r
578 Domain, /* Domain buffer */
\r
579 &DomLen, /* Domain buffer length */
\r
580 &snu); /* SID name type */
\r
582 sv_setpv(ST(2), Account);
\r
583 sv_setpv(ST(3), Domain);
\r
584 sv_setiv(ST(4), (IV)snu);
\r
591 XS(w32_InitiateSystemShutdown)
\r
594 HANDLE hToken; /* handle to process token */
\r
595 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
\r
597 char *machineName, *message;
\r
600 croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
\r
601 "$timeOut, $forceClose, $reboot);\n");
\r
603 machineName = SvPV_nolen(ST(0));
\r
605 if (OpenProcessToken(GetCurrentProcess(),
\r
606 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
\r
609 LookupPrivilegeValueA(machineName,
\r
611 &tkp.Privileges[0].Luid);
\r
613 tkp.PrivilegeCount = 1; /* only setting one */
\r
614 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
\r
616 /* Get shutdown privilege for this process. */
\r
617 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
\r
618 (PTOKEN_PRIVILEGES)NULL, 0);
\r
621 message = SvPV_nolen(ST(1));
\r
622 bRet = InitiateSystemShutdownA(machineName, message, (DWORD)SvIV(ST(2)),
\r
623 (BOOL)SvIV(ST(3)), (BOOL)SvIV(ST(4)));
\r
625 /* Disable shutdown privilege. */
\r
626 tkp.Privileges[0].Attributes = 0;
\r
627 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
\r
628 (PTOKEN_PRIVILEGES)NULL, 0);
\r
629 CloseHandle(hToken);
\r
633 XS(w32_AbortSystemShutdown)
\r
636 HANDLE hToken; /* handle to process token */
\r
637 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
\r
642 croak("usage: Win32::AbortSystemShutdown($machineName);\n");
\r
644 machineName = SvPV_nolen(ST(0));
\r
646 if (OpenProcessToken(GetCurrentProcess(),
\r
647 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
\r
650 LookupPrivilegeValueA(machineName,
\r
652 &tkp.Privileges[0].Luid);
\r
654 tkp.PrivilegeCount = 1; /* only setting one */
\r
655 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
\r
657 /* Get shutdown privilege for this process. */
\r
658 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
\r
659 (PTOKEN_PRIVILEGES)NULL, 0);
\r
662 bRet = AbortSystemShutdownA(machineName);
\r
664 /* Disable shutdown privilege. */
\r
665 tkp.Privileges[0].Attributes = 0;
\r
666 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
\r
667 (PTOKEN_PRIVILEGES)NULL, 0);
\r
668 CloseHandle(hToken);
\r
676 DWORD flags = MB_ICONEXCLAMATION;
\r
679 if (items < 1 || items > 3)
\r
680 croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
\r
683 flags = (DWORD)SvIV(ST(1));
\r
686 WCHAR *title = NULL;
\r
687 WCHAR *msg = sv_to_wstr(aTHX_ ST(0));
\r
689 title = sv_to_wstr(aTHX_ ST(2));
\r
690 result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags);
\r
696 char *title = "Perl";
\r
697 char *msg = SvPV_nolen(ST(0));
\r
699 title = SvPV_nolen(ST(2));
\r
700 result = MessageBoxA(GetActiveWindow(), msg, title, flags);
\r
702 XSRETURN_IV(result);
\r
705 XS(w32_LoadLibrary)
\r
711 croak("usage: Win32::LoadLibrary($libname)\n");
\r
712 hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
\r
714 XSRETURN_IV((DWORD_PTR)hHandle);
\r
716 XSRETURN_IV((DWORD)hHandle);
\r
720 XS(w32_FreeLibrary)
\r
725 croak("usage: Win32::FreeLibrary($handle)\n");
\r
726 if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
\r
732 XS(w32_GetProcAddress)
\r
737 croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
\r
738 XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
\r
741 XS(w32_RegisterServer)
\r
744 BOOL result = FALSE;
\r
748 croak("usage: Win32::RegisterServer($libname)\n");
\r
750 module = LoadLibraryA(SvPV_nolen(ST(0)));
\r
752 PFNDllRegisterServer pfnDllRegisterServer;
\r
753 GETPROC(DllRegisterServer);
\r
754 if (pfnDllRegisterServer && pfnDllRegisterServer() == 0)
\r
756 FreeLibrary(module);
\r
758 ST(0) = boolSV(result);
\r
762 XS(w32_UnregisterServer)
\r
765 BOOL result = FALSE;
\r
769 croak("usage: Win32::UnregisterServer($libname)\n");
\r
771 module = LoadLibraryA(SvPV_nolen(ST(0)));
\r
773 PFNDllUnregisterServer pfnDllUnregisterServer;
\r
774 GETPROC(DllUnregisterServer);
\r
775 if (pfnDllUnregisterServer && pfnDllUnregisterServer() == 0)
\r
777 FreeLibrary(module);
\r
779 ST(0) = boolSV(result);
\r
783 /* XXX rather bogus */
\r
784 XS(w32_GetArchName)
\r
787 XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
\r
790 XS(w32_GetChipName)
\r
793 SYSTEM_INFO sysinfo;
\r
795 Zero(&sysinfo,1,SYSTEM_INFO);
\r
796 GetSystemInfo(&sysinfo);
\r
797 /* XXX docs say dwProcessorType is deprecated on NT */
\r
798 XSRETURN_IV(sysinfo.dwProcessorType);
\r
805 char szGUID[50] = {'\0'};
\r
806 HRESULT hr = CoCreateGuid(&guid);
\r
808 if (SUCCEEDED(hr)) {
\r
809 LPOLESTR pStr = NULL;
\r
810 if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
\r
811 WideCharToMultiByte(CP_ACP, 0, pStr, (int)wcslen(pStr), szGUID,
\r
812 sizeof(szGUID), NULL, NULL);
\r
813 CoTaskMemFree(pStr);
\r
814 XSRETURN_PV(szGUID);
\r
820 XS(w32_GetFolderPath)
\r
823 char path[MAX_PATH+1];
\r
824 WCHAR wpath[MAX_PATH+1];
\r
829 if (items != 1 && items != 2)
\r
830 croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
\r
832 folder = (int)SvIV(ST(0));
\r
834 create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
\r
836 module = LoadLibrary("shfolder.dll");
\r
838 PFNSHGetFolderPathA pfna;
\r
840 PFNSHGetFolderPathW pfnw;
\r
841 pfnw = (PFNSHGetFolderPathW)GetProcAddress(module, "SHGetFolderPathW");
\r
842 if (pfnw && SUCCEEDED(pfnw(NULL, folder|create, NULL, 0, wpath))) {
\r
843 FreeLibrary(module);
\r
844 ST(0) = wstr_to_ansipath(aTHX_ wpath);
\r
848 pfna = (PFNSHGetFolderPathA)GetProcAddress(module, "SHGetFolderPathA");
\r
849 if (pfna && SUCCEEDED(pfna(NULL, folder|create, NULL, 0, path))) {
\r
850 FreeLibrary(module);
\r
853 FreeLibrary(module);
\r
856 module = LoadLibrary("shell32.dll");
\r
858 PFNSHGetSpecialFolderPathA pfna;
\r
860 PFNSHGetSpecialFolderPathW pfnw;
\r
861 pfnw = (PFNSHGetSpecialFolderPathW)GetProcAddress(module, "SHGetSpecialFolderPathW");
\r
862 if (pfnw && pfnw(NULL, wpath, folder, !!create)) {
\r
863 FreeLibrary(module);
\r
864 ST(0) = wstr_to_ansipath(aTHX_ wpath);
\r
868 pfna = (PFNSHGetSpecialFolderPathA)GetProcAddress(module, "SHGetSpecialFolderPathA");
\r
869 if (pfna && pfna(NULL, path, folder, !!create)) {
\r
870 FreeLibrary(module);
\r
873 FreeLibrary(module);
\r
876 /* SHGetFolderPathW() and SHGetSpecialFolderPathW() may fail on older
\r
877 * Perl versions that have replaced the Unicode environment with an
\r
878 * ANSI version. Let's go spelunking in the registry now...
\r
883 HKEY root = HKEY_CURRENT_USER;
\r
884 WCHAR *name = NULL;
\r
887 case CSIDL_ADMINTOOLS: name = L"Administrative Tools"; break;
\r
888 case CSIDL_APPDATA: name = L"AppData"; break;
\r
889 case CSIDL_CDBURN_AREA: name = L"CD Burning"; break;
\r
890 case CSIDL_COOKIES: name = L"Cookies"; break;
\r
891 case CSIDL_DESKTOP:
\r
892 case CSIDL_DESKTOPDIRECTORY: name = L"Desktop"; break;
\r
893 case CSIDL_FAVORITES: name = L"Favorites"; break;
\r
894 case CSIDL_FONTS: name = L"Fonts"; break;
\r
895 case CSIDL_HISTORY: name = L"History"; break;
\r
896 case CSIDL_INTERNET_CACHE: name = L"Cache"; break;
\r
897 case CSIDL_LOCAL_APPDATA: name = L"Local AppData"; break;
\r
898 case CSIDL_MYMUSIC: name = L"My Music"; break;
\r
899 case CSIDL_MYPICTURES: name = L"My Pictures"; break;
\r
900 case CSIDL_MYVIDEO: name = L"My Video"; break;
\r
901 case CSIDL_NETHOOD: name = L"NetHood"; break;
\r
902 case CSIDL_PERSONAL: name = L"Personal"; break;
\r
903 case CSIDL_PRINTHOOD: name = L"PrintHood"; break;
\r
904 case CSIDL_PROGRAMS: name = L"Programs"; break;
\r
905 case CSIDL_RECENT: name = L"Recent"; break;
\r
906 case CSIDL_SENDTO: name = L"SendTo"; break;
\r
907 case CSIDL_STARTMENU: name = L"Start Menu"; break;
\r
908 case CSIDL_STARTUP: name = L"Startup"; break;
\r
909 case CSIDL_TEMPLATES: name = L"Templates"; break;
\r
910 /* XXX L"Local Settings" */
\r
914 root = HKEY_LOCAL_MACHINE;
\r
916 case CSIDL_COMMON_ADMINTOOLS: name = L"Common Administrative Tools"; break;
\r
917 case CSIDL_COMMON_APPDATA: name = L"Common AppData"; break;
\r
918 case CSIDL_COMMON_DESKTOPDIRECTORY: name = L"Common Desktop"; break;
\r
919 case CSIDL_COMMON_DOCUMENTS: name = L"Common Documents"; break;
\r
920 case CSIDL_COMMON_FAVORITES: name = L"Common Favorites"; break;
\r
921 case CSIDL_COMMON_PROGRAMS: name = L"Common Programs"; break;
\r
922 case CSIDL_COMMON_STARTMENU: name = L"Common Start Menu"; break;
\r
923 case CSIDL_COMMON_STARTUP: name = L"Common Startup"; break;
\r
924 case CSIDL_COMMON_TEMPLATES: name = L"Common Templates"; break;
\r
925 case CSIDL_COMMON_MUSIC: name = L"CommonMusic"; break;
\r
926 case CSIDL_COMMON_PICTURES: name = L"CommonPictures"; break;
\r
927 case CSIDL_COMMON_VIDEO: name = L"CommonVideo"; break;
\r
931 * case CSIDL_SYSTEM # GetSystemDirectory()
\r
932 * case CSIDL_RESOURCES # %windir%\Resources\, For theme and other windows resources.
\r
933 * case CSIDL_RESOURCES_LOCALIZED # %windir%\Resources\<LangID>, for theme and other windows specific resources.
\r
936 #define SHELL_FOLDERS "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"
\r
938 if (name && RegOpenKeyEx(root, SHELL_FOLDERS, 0, KEY_QUERY_VALUE, &hkey) == ERROR_SUCCESS) {
\r
939 WCHAR data[MAX_PATH+1];
\r
940 DWORD cb = sizeof(data)-sizeof(WCHAR);
\r
941 DWORD type = REG_NONE;
\r
942 long rc = RegQueryValueExW(hkey, name, NULL, &type, (BYTE*)&data, &cb);
\r
944 if (rc == ERROR_SUCCESS && type == REG_SZ && cb > sizeof(WCHAR) && data[0]) {
\r
945 /* Make sure the string is properly terminated */
\r
946 data[cb/sizeof(WCHAR)] = '\0';
\r
947 ST(0) = wstr_to_ansipath(aTHX_ data);
\r
952 #undef SHELL_FOLDERS
\r
954 /* Unders some circumstances the registry entries seem to have a null string
\r
955 * as their value even when the directory already exists. The environment
\r
956 * variables do get set though, so try re-create a Unicode environment and
\r
957 * check if they are there.
\r
961 case CSIDL_APPDATA: sv = get_unicode_env(aTHX_ L"APPDATA"); break;
\r
962 case CSIDL_PROFILE: sv = get_unicode_env(aTHX_ L"USERPROFILE"); break;
\r
963 case CSIDL_PROGRAM_FILES: sv = get_unicode_env(aTHX_ L"ProgramFiles"); break;
\r
964 case CSIDL_PROGRAM_FILES_COMMON: sv = get_unicode_env(aTHX_ L"CommonProgramFiles"); break;
\r
965 case CSIDL_WINDOWS: sv = get_unicode_env(aTHX_ L"SystemRoot"); break;
\r
976 XS(w32_GetFileVersion)
\r
985 croak("usage: Win32::GetFileVersion($filename)\n");
\r
987 filename = SvPV_nolen(ST(0));
\r
988 size = GetFileVersionInfoSize(filename, &handle);
\r
992 New(0, data, size, char);
\r
996 if (GetFileVersionInfo(filename, handle, size, data)) {
\r
997 VS_FIXEDFILEINFO *info;
\r
999 if (VerQueryValue(data, "\\", (void**)&info, &len)) {
\r
1000 int dwValueMS1 = (info->dwFileVersionMS>>16);
\r
1001 int dwValueMS2 = (info->dwFileVersionMS&0xffff);
\r
1002 int dwValueLS1 = (info->dwFileVersionLS>>16);
\r
1003 int dwValueLS2 = (info->dwFileVersionLS&0xffff);
\r
1005 if (GIMME_V == G_ARRAY) {
\r
1007 XST_mIV(0, dwValueMS1);
\r
1008 XST_mIV(1, dwValueMS2);
\r
1009 XST_mIV(2, dwValueLS1);
\r
1010 XST_mIV(3, dwValueLS2);
\r
1015 sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
\r
1016 XST_mPV(0, version);
\r
1028 XS(w32_SetChildShowWindow)
\r
1030 /* This function doesn't do anything useful for cygwin. In the
\r
1031 * MSWin32 case it modifies w32_showwindow, which is used by
\r
1032 * win32_spawnvp(). Since w32_showwindow is an internal variable
\r
1033 * inside the thread_intern structure, the MSWin32 implementation
\r
1034 * lives in win32/win32.c in the core Perl distribution.
\r
1044 /* Make the host for current directory */
\r
1045 char* ptr = PerlEnv_get_childdir();
\r
1047 * If ptr != Nullch
\r
1048 * then it worked, set PV valid,
\r
1049 * else return 'undef'
\r
1052 SV *sv = sv_newmortal();
\r
1053 sv_setpv(sv, ptr);
\r
1054 PerlEnv_free_childdir(ptr);
\r
1056 #ifndef INCOMPLETE_TAINTS
\r
1071 Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)");
\r
1073 if (IsWin2000() && SvUTF8(ST(0))) {
\r
1074 WCHAR *wide = sv_to_wstr(aTHX_ ST(0));
\r
1075 char *ansi = my_ansipath(wide);
\r
1076 int rc = PerlDir_chdir(ansi);
\r
1083 if (!PerlDir_chdir(SvPV_nolen(ST(0))))
\r
1090 XS(w32_GetNextAvailDrive)
\r
1094 char root[] = "_:\\";
\r
1097 while (ix <= 'Z') {
\r
1099 if (GetDriveType(root) == 1) {
\r
1101 XSRETURN_PV(root);
\r
1107 XS(w32_GetLastError)
\r
1111 XSRETURN_IV(GetLastError());
\r
1114 XS(w32_SetLastError)
\r
1118 Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
\r
1119 SetLastError((DWORD)SvIV(ST(0)));
\r
1127 if (IsWin2000()) {
\r
1129 DWORD size = countof(name);
\r
1130 if (GetUserNameW(name, &size)) {
\r
1131 ST(0) = wstr_to_sv(aTHX_ name);
\r
1137 DWORD size = countof(name);
\r
1138 if (GetUserNameA(name, &size)) {
\r
1139 /* size includes NULL */
\r
1140 ST(0) = sv_2mortal(newSVpvn(name, size-1));
\r
1150 char name[MAX_COMPUTERNAME_LENGTH+1];
\r
1151 DWORD size = sizeof(name);
\r
1153 if (GetComputerName(name,&size)) {
\r
1154 /* size does NOT include NULL :-( */
\r
1155 ST(0) = sv_2mortal(newSVpvn(name,size));
\r
1162 XS(w32_DomainName)
\r
1165 HMODULE module = LoadLibrary("netapi32.dll");
\r
1166 PFNNetApiBufferFree pfnNetApiBufferFree;
\r
1167 PFNNetWkstaGetInfo pfnNetWkstaGetInfo;
\r
1170 GETPROC(NetApiBufferFree);
\r
1171 GETPROC(NetWkstaGetInfo);
\r
1174 if (module && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
\r
1175 /* this way is more reliable, in case user has a local account. */
\r
1177 DWORD dnamelen = sizeof(dname);
\r
1179 DWORD wki100_platform_id;
\r
1180 LPWSTR wki100_computername;
\r
1181 LPWSTR wki100_langroup;
\r
1182 DWORD wki100_ver_major;
\r
1183 DWORD wki100_ver_minor;
\r
1186 retval = pfnNetWkstaGetInfo(NULL, 100, &pwi);
\r
1187 /* NERR_Success *is* 0*/
\r
1188 if (retval == 0) {
\r
1189 if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
\r
1190 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
\r
1191 -1, (LPSTR)dname, dnamelen, NULL, NULL);
\r
1194 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
\r
1195 -1, (LPSTR)dname, dnamelen, NULL, NULL);
\r
1197 pfnNetApiBufferFree(pwi);
\r
1198 FreeLibrary(module);
\r
1199 XSRETURN_PV(dname);
\r
1201 FreeLibrary(module);
\r
1202 SetLastError(retval);
\r
1205 /* Win95 doesn't have NetWksta*(), so do it the old way */
\r
1207 DWORD size = sizeof(name);
\r
1209 FreeLibrary(module);
\r
1210 if (GetUserName(name,&size)) {
\r
1211 char sid[ONE_K_BUFSIZE];
\r
1212 DWORD sidlen = sizeof(sid);
\r
1214 DWORD dnamelen = sizeof(dname);
\r
1216 if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
\r
1217 dname, &dnamelen, &snu)) {
\r
1218 XSRETURN_PV(dname); /* all that for this */
\r
1229 DWORD flags, filecomplen;
\r
1230 if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
\r
1231 &flags, fsname, sizeof(fsname))) {
\r
1232 if (GIMME_V == G_ARRAY) {
\r
1233 XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
\r
1234 XPUSHs(sv_2mortal(newSViv(flags)));
\r
1235 XPUSHs(sv_2mortal(newSViv(filecomplen)));
\r
1240 XSRETURN_PV(fsname);
\r
1245 XS(w32_GetOSVersion)
\r
1249 if (GIMME_V == G_SCALAR) {
\r
1250 XSRETURN_IV(g_osver.dwPlatformId);
\r
1252 XPUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));
\r
1254 XPUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));
\r
1255 XPUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));
\r
1256 XPUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));
\r
1257 XPUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
\r
1259 XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));
\r
1260 XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));
\r
1261 XPUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));
\r
1262 XPUSHs(sv_2mortal(newSViv(g_osver.wProductType)));
\r
1271 XSRETURN_IV(IsWinNT());
\r
1278 XSRETURN_IV(IsWin95());
\r
1281 XS(w32_FormatMessage)
\r
1285 char msgbuf[ONE_K_BUFSIZE];
\r
1288 Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
\r
1290 if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
\r
1291 &source, (DWORD)SvIV(ST(0)), 0,
\r
1292 msgbuf, sizeof(msgbuf)-1, NULL))
\r
1294 XSRETURN_PV(msgbuf);
\r
1306 PROCESS_INFORMATION stProcInfo;
\r
1307 STARTUPINFO stStartInfo;
\r
1308 BOOL bSuccess = FALSE;
\r
1311 Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
\r
1313 cmd = SvPV_nolen(ST(0));
\r
1314 args = SvPV_nolen(ST(1));
\r
1316 env = PerlEnv_get_childenv();
\r
1317 dir = PerlEnv_get_childdir();
\r
1319 memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
\r
1320 stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
\r
1321 stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
\r
1322 stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
\r
1324 if (CreateProcess(
\r
1325 cmd, /* Image path */
\r
1326 args, /* Arguments for command line */
\r
1327 NULL, /* Default process security */
\r
1328 NULL, /* Default thread security */
\r
1329 FALSE, /* Must be TRUE to use std handles */
\r
1330 NORMAL_PRIORITY_CLASS, /* No special scheduling */
\r
1331 env, /* Inherit our environment block */
\r
1332 dir, /* Inherit our currrent directory */
\r
1333 &stStartInfo, /* -> Startup info */
\r
1334 &stProcInfo)) /* <- Process info (if OK) */
\r
1336 int pid = (int)stProcInfo.dwProcessId;
\r
1337 if (IsWin95() && pid < 0)
\r
1339 sv_setiv(ST(2), pid);
\r
1340 CloseHandle(stProcInfo.hThread);/* library source code does this. */
\r
1343 PerlEnv_free_childenv(env);
\r
1344 PerlEnv_free_childdir(dir);
\r
1345 XSRETURN_IV(bSuccess);
\r
1348 XS(w32_GetTickCount)
\r
1351 DWORD msec = GetTickCount();
\r
1354 XSRETURN_IV(msec);
\r
1355 XSRETURN_NV(msec);
\r
1358 XS(w32_GetShortPathName)
\r
1365 Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
\r
1367 if (IsWin2000()) {
\r
1368 WCHAR wshort[MAX_PATH+1];
\r
1369 WCHAR *wlong = sv_to_wstr(aTHX_ ST(0));
\r
1370 len = GetShortPathNameW(wlong, wshort, countof(wshort));
\r
1372 if (len && len < sizeof(wshort)) {
\r
1373 ST(0) = wstr_to_sv(aTHX_ wshort);
\r
1379 shortpath = sv_mortalcopy(ST(0));
\r
1380 SvUPGRADE(shortpath, SVt_PV);
\r
1381 if (!SvPVX(shortpath) || !SvLEN(shortpath))
\r
1384 /* src == target is allowed */
\r
1386 len = GetShortPathName(SvPVX(shortpath),
\r
1388 (DWORD)SvLEN(shortpath));
\r
1389 } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
\r
1391 SvCUR_set(shortpath,len);
\r
1392 *SvEND(shortpath) = '\0';
\r
1393 ST(0) = shortpath;
\r
1399 XS(w32_GetFullPathName)
\r
1403 char *ansi = NULL;
\r
1405 /* The code below relies on the fact that PerlDir_mapX() returns an
\r
1406 * absolute path, which is only true under PERL_IMPLICIT_SYS when
\r
1407 * we use the virtualization code from win32/vdir.h.
\r
1408 * Without it PerlDir_mapX() is a no-op and we need to use the same
\r
1409 * code as we use for Cygwin.
\r
1411 #if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
\r
1412 char buffer[2*MAX_PATH];
\r
1416 Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
\r
1418 #if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
\r
1419 if (IsWin2000()) {
\r
1420 WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
\r
1421 WCHAR full[2*MAX_PATH];
\r
1422 DWORD len = GetFullPathNameW(filename, countof(full), full, NULL);
\r
1423 Safefree(filename);
\r
1424 if (len == 0 || len >= countof(full))
\r
1426 ansi = fullname = my_ansipath(full);
\r
1429 DWORD len = GetFullPathNameA(SvPV_nolen(ST(0)), countof(buffer), buffer, NULL);
\r
1430 if (len == 0 || len >= countof(buffer))
\r
1432 fullname = buffer;
\r
1435 /* Don't use my_ansipath() unless the $filename argument is in Unicode.
\r
1436 * If the relative path doesn't exist, GetShortPathName() will fail and
\r
1437 * my_ansipath() will use the long name with replacement characters.
\r
1438 * In that case we will be better off using PerlDir_mapA(), which
\r
1439 * already uses the ANSI name of the current directory.
\r
1441 * XXX The one missing case is where we could downgrade $filename
\r
1442 * XXX from UTF8 into the current codepage.
\r
1444 if (IsWin2000() && SvUTF8(ST(0))) {
\r
1445 WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
\r
1446 WCHAR *mappedname = PerlDir_mapW(filename);
\r
1447 Safefree(filename);
\r
1448 ansi = fullname = my_ansipath(mappedname);
\r
1451 fullname = PerlDir_mapA(SvPV_nolen(ST(0)));
\r
1453 # if PERL_VERSION < 8
\r
1455 /* PerlDir_mapX() in Perl 5.6 used to return forward slashes */
\r
1456 char *str = fullname;
\r
1466 /* GetFullPathName() on Windows NT drops trailing backslash */
\r
1467 if (g_osver.dwMajorVersion == 4 && *fullname) {
\r
1469 char *pv = SvPV(ST(0), len);
\r
1470 char *lastchar = fullname + strlen(fullname) - 1;
\r
1471 /* If ST(0) ends with a slash, but fullname doesn't ... */
\r
1472 if (len && (pv[len-1] == '/' || pv[len-1] == '\\') && *lastchar != '\\') {
\r
1473 /* fullname is the MAX_PATH+1 sized buffer returned from PerlDir_mapA()
\r
1474 * or the 2*MAX_PATH sized local buffer in the __CYGWIN__ case.
\r
1476 strcpy(lastchar+1, "\\");
\r
1480 if (GIMME_V == G_ARRAY) {
\r
1481 char *filepart = strrchr(fullname, '\\');
\r
1485 XST_mPV(1, ++filepart);
\r
1489 XST_mPVN(1, "", 0);
\r
1493 XST_mPV(0, fullname);
\r
1500 XS(w32_GetLongPathName)
\r
1505 Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
\r
1507 if (IsWin2000()) {
\r
1508 WCHAR *wstr = sv_to_wstr(aTHX_ ST(0));
\r
1509 WCHAR wide_path[MAX_PATH+1];
\r
1512 wcscpy(wide_path, wstr);
\r
1514 long_path = my_longpathW(wide_path);
\r
1516 ST(0) = wstr_to_sv(aTHX_ long_path);
\r
1522 char tmpbuf[MAX_PATH+1];
\r
1527 pathstr = SvPV(path,len);
\r
1528 strcpy(tmpbuf, pathstr);
\r
1529 pathstr = my_longpathA(tmpbuf);
\r
1531 ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
\r
1538 XS(w32_GetANSIPathName)
\r
1544 Perl_croak(aTHX_ "usage: Win32::GetANSIPathName($pathname)");
\r
1546 wide_path = sv_to_wstr(aTHX_ ST(0));
\r
1547 ST(0) = wstr_to_ansipath(aTHX_ wide_path);
\r
1548 Safefree(wide_path);
\r
1556 Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
\r
1557 Sleep((DWORD)SvIV(ST(0)));
\r
1565 char szSourceFile[MAX_PATH+1];
\r
1568 Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
\r
1569 strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
\r
1570 bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
\r
1576 XS(w32_OutputDebugString)
\r
1580 Perl_croak(aTHX_ "usage: Win32::OutputDebugString($string)");
\r
1582 if (SvUTF8(ST(0))) {
\r
1583 WCHAR *str = sv_to_wstr(aTHX_ ST(0));
\r
1584 OutputDebugStringW(str);
\r
1588 OutputDebugStringA(SvPV_nolen(ST(0)));
\r
1593 XS(w32_GetCurrentProcessId)
\r
1597 XSRETURN_IV(GetCurrentProcessId());
\r
1600 XS(w32_GetCurrentThreadId)
\r
1604 XSRETURN_IV(GetCurrentThreadId());
\r
1607 XS(w32_CreateDirectory)
\r
1613 Perl_croak(aTHX_ "usage: Win32::CreateDirectory($dir)");
\r
1615 if (IsWin2000() && SvUTF8(ST(0))) {
\r
1616 WCHAR *dir = sv_to_wstr(aTHX_ ST(0));
\r
1617 result = CreateDirectoryW(dir, NULL);
\r
1621 result = CreateDirectoryA(SvPV_nolen(ST(0)), NULL);
\r
1624 ST(0) = boolSV(result);
\r
1628 XS(w32_CreateFile)
\r
1634 Perl_croak(aTHX_ "usage: Win32::CreateFile($file)");
\r
1636 if (IsWin2000() && SvUTF8(ST(0))) {
\r
1637 WCHAR *file = sv_to_wstr(aTHX_ ST(0));
\r
1638 handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_WRITE,
\r
1639 NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
\r
1643 handle = CreateFileA(SvPV_nolen(ST(0)), GENERIC_WRITE, FILE_SHARE_WRITE,
\r
1644 NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
\r
1647 if (handle != INVALID_HANDLE_VALUE)
\r
1648 CloseHandle(handle);
\r
1650 ST(0) = boolSV(handle != INVALID_HANDLE_VALUE);
\r
1654 MODULE = Win32 PACKAGE = Win32
\r
1656 PROTOTYPES: DISABLE
\r
1660 char *file = __FILE__;
\r
1662 if (g_osver.dwOSVersionInfoSize == 0) {
\r
1663 g_osver.dwOSVersionInfoSize = sizeof(g_osver);
\r
1664 if (!GetVersionExA((OSVERSIONINFOA*)&g_osver)) {
\r
1665 g_osver_ex = FALSE;
\r
1666 g_osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
\r
1667 GetVersionExA((OSVERSIONINFOA*)&g_osver);
\r
1671 newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
\r
1672 newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
\r
1673 newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);
\r
1674 newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file);
\r
1675 newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file);
\r
1676 newXS("Win32::MsgBox", w32_MsgBox, file);
\r
1677 newXS("Win32::LoadLibrary", w32_LoadLibrary, file);
\r
1678 newXS("Win32::FreeLibrary", w32_FreeLibrary, file);
\r
1679 newXS("Win32::GetProcAddress", w32_GetProcAddress, file);
\r
1680 newXS("Win32::RegisterServer", w32_RegisterServer, file);
\r
1681 newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
\r
1682 newXS("Win32::GetArchName", w32_GetArchName, file);
\r
1683 newXS("Win32::GetChipName", w32_GetChipName, file);
\r
1684 newXS("Win32::GuidGen", w32_GuidGen, file);
\r
1685 newXS("Win32::GetFolderPath", w32_GetFolderPath, file);
\r
1686 newXS("Win32::IsAdminUser", w32_IsAdminUser, file);
\r
1687 newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
\r
1689 newXS("Win32::GetCwd", w32_GetCwd, file);
\r
1690 newXS("Win32::SetCwd", w32_SetCwd, file);
\r
1691 newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
\r
1692 newXS("Win32::GetLastError", w32_GetLastError, file);
\r
1693 newXS("Win32::SetLastError", w32_SetLastError, file);
\r
1694 newXS("Win32::LoginName", w32_LoginName, file);
\r
1695 newXS("Win32::NodeName", w32_NodeName, file);
\r
1696 newXS("Win32::DomainName", w32_DomainName, file);
\r
1697 newXS("Win32::FsType", w32_FsType, file);
\r
1698 newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
\r
1699 newXS("Win32::IsWinNT", w32_IsWinNT, file);
\r
1700 newXS("Win32::IsWin95", w32_IsWin95, file);
\r
1701 newXS("Win32::FormatMessage", w32_FormatMessage, file);
\r
1702 newXS("Win32::Spawn", w32_Spawn, file);
\r
1703 newXS("Win32::GetTickCount", w32_GetTickCount, file);
\r
1704 newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
\r
1705 newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
\r
1706 newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
\r
1707 newXS("Win32::GetANSIPathName", w32_GetANSIPathName, file);
\r
1708 newXS("Win32::CopyFile", w32_CopyFile, file);
\r
1709 newXS("Win32::Sleep", w32_Sleep, file);
\r
1710 newXS("Win32::OutputDebugString", w32_OutputDebugString, file);
\r
1711 newXS("Win32::GetCurrentProcessId", w32_GetCurrentProcessId, file);
\r
1712 newXS("Win32::GetCurrentThreadId", w32_GetCurrentThreadId, file);
\r
1713 newXS("Win32::CreateDirectory", w32_CreateDirectory, file);
\r
1714 newXS("Win32::CreateFile", w32_CreateFile, file);
\r
1716 newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
\r