5.21.5 has been ticked off
[perl.git] / cpan / Win32 / Win32.xs
1 #define WIN32_LEAN_AND_MEAN
2 #include <wctype.h>
3 #include <windows.h>
4 #include <shlobj.h>
5
6 #define PERL_NO_GET_CONTEXT
7 #include "EXTERN.h"
8 #include "perl.h"
9 #include "XSUB.h"
10
11 #ifndef countof
12 #  define countof(array) (sizeof (array) / sizeof (*(array)))
13 #endif
14
15 #define SE_SHUTDOWN_NAMEA   "SeShutdownPrivilege"
16
17 #ifndef WC_NO_BEST_FIT_CHARS
18 #  define WC_NO_BEST_FIT_CHARS 0x00000400
19 #endif
20
21 #define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn)
22
23 typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathA)(HWND, char*, int, BOOL);
24 typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathW)(HWND, WCHAR*, int, BOOL);
25 typedef HRESULT (WINAPI *PFNSHGetFolderPathA)(HWND, int, HANDLE, DWORD, LPTSTR);
26 typedef HRESULT (WINAPI *PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR);
27 typedef BOOL (WINAPI *PFNCreateEnvironmentBlock)(void**, HANDLE, BOOL);
28 typedef BOOL (WINAPI *PFNDestroyEnvironmentBlock)(void*);
29 typedef int (__stdcall *PFNDllRegisterServer)(void);
30 typedef int (__stdcall *PFNDllUnregisterServer)(void);
31 typedef DWORD (__stdcall *PFNNetApiBufferFree)(void*);
32 typedef DWORD (__stdcall *PFNNetWkstaGetInfo)(LPWSTR, DWORD, void*);
33
34 typedef BOOL (__stdcall *PFNOpenProcessToken)(HANDLE, DWORD, HANDLE*);
35 typedef BOOL (__stdcall *PFNOpenThreadToken)(HANDLE, DWORD, BOOL, HANDLE*);
36 typedef BOOL (__stdcall *PFNGetTokenInformation)(HANDLE, TOKEN_INFORMATION_CLASS, void*, DWORD, DWORD*);
37 typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD,
38                                                       DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*);
39 typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);
40 typedef void* (__stdcall *PFNFreeSid)(PSID);
41 typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);
42 typedef BOOL (WINAPI *PFNGetProductInfo)(DWORD, DWORD, DWORD, DWORD, DWORD*);
43 typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);
44
45 #ifndef CSIDL_MYMUSIC
46 #   define CSIDL_MYMUSIC              0x000D
47 #endif
48 #ifndef CSIDL_MYVIDEO
49 #   define CSIDL_MYVIDEO              0x000E
50 #endif
51 #ifndef CSIDL_LOCAL_APPDATA
52 #   define CSIDL_LOCAL_APPDATA        0x001C
53 #endif
54 #ifndef CSIDL_COMMON_FAVORITES
55 #   define CSIDL_COMMON_FAVORITES     0x001F
56 #endif
57 #ifndef CSIDL_INTERNET_CACHE
58 #   define CSIDL_INTERNET_CACHE       0x0020
59 #endif
60 #ifndef CSIDL_COOKIES
61 #   define CSIDL_COOKIES              0x0021
62 #endif
63 #ifndef CSIDL_HISTORY
64 #   define CSIDL_HISTORY              0x0022
65 #endif
66 #ifndef CSIDL_COMMON_APPDATA
67 #   define CSIDL_COMMON_APPDATA       0x0023
68 #endif
69 #ifndef CSIDL_WINDOWS
70 #   define CSIDL_WINDOWS              0x0024
71 #endif
72 #ifndef CSIDL_PROGRAM_FILES
73 #   define CSIDL_PROGRAM_FILES        0x0026
74 #endif
75 #ifndef CSIDL_MYPICTURES
76 #   define CSIDL_MYPICTURES           0x0027
77 #endif
78 #ifndef CSIDL_PROFILE
79 #   define CSIDL_PROFILE              0x0028
80 #endif
81 #ifndef CSIDL_PROGRAM_FILES_COMMON
82 #   define CSIDL_PROGRAM_FILES_COMMON 0x002B
83 #endif
84 #ifndef CSIDL_COMMON_TEMPLATES
85 #   define CSIDL_COMMON_TEMPLATES     0x002D
86 #endif
87 #ifndef CSIDL_COMMON_DOCUMENTS
88 #   define CSIDL_COMMON_DOCUMENTS     0x002E
89 #endif
90 #ifndef CSIDL_COMMON_ADMINTOOLS
91 #   define CSIDL_COMMON_ADMINTOOLS    0x002F
92 #endif
93 #ifndef CSIDL_ADMINTOOLS
94 #   define CSIDL_ADMINTOOLS           0x0030
95 #endif
96 #ifndef CSIDL_COMMON_MUSIC
97 #   define CSIDL_COMMON_MUSIC         0x0035
98 #endif
99 #ifndef CSIDL_COMMON_PICTURES
100 #   define CSIDL_COMMON_PICTURES      0x0036
101 #endif
102 #ifndef CSIDL_COMMON_VIDEO
103 #   define CSIDL_COMMON_VIDEO         0x0037
104 #endif
105 #ifndef CSIDL_CDBURN_AREA
106 #   define CSIDL_CDBURN_AREA          0x003B
107 #endif
108 #ifndef CSIDL_FLAG_CREATE
109 #   define CSIDL_FLAG_CREATE          0x8000
110 #endif
111
112 /* Use explicit struct definition because wSuiteMask and
113  * wProductType are not defined in the VC++ 6.0 headers.
114  * WORD type has been replaced by unsigned short because
115  * WORD is already used by Perl itself.
116  */
117 struct {
118     DWORD dwOSVersionInfoSize;
119     DWORD dwMajorVersion;
120     DWORD dwMinorVersion;
121     DWORD dwBuildNumber;
122     DWORD dwPlatformId;
123     CHAR  szCSDVersion[128];
124     unsigned short wServicePackMajor;
125     unsigned short wServicePackMinor;
126     unsigned short wSuiteMask;
127     BYTE  wProductType;
128     BYTE  wReserved;
129 }   g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0};
130 BOOL g_osver_ex = TRUE;
131
132 #define ONE_K_BUFSIZE   1024
133
134 int
135 IsWin95(void)
136 {
137     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
138 }
139
140 int
141 IsWinNT(void)
142 {
143     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
144 }
145
146 int
147 IsWin2000(void)
148 {
149     return (g_osver.dwMajorVersion > 4);
150 }
151
152 /* Convert SV to wide character string.  The return value must be
153  * freed using Safefree().
154  */
155 WCHAR*
156 sv_to_wstr(pTHX_ SV *sv)
157 {
158     DWORD wlen;
159     WCHAR *wstr;
160     STRLEN len;
161     char *str = SvPV(sv, len);
162     UINT cp = SvUTF8(sv) ? CP_UTF8 : CP_ACP;
163
164     wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0);
165     New(0, wstr, wlen, WCHAR);
166     MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen);
167
168     return wstr;
169 }
170
171 /* Convert wide character string to mortal SV.  Use UTF8 encoding
172  * if the string cannot be represented in the system codepage.
173  */
174 SV *
175 wstr_to_sv(pTHX_ WCHAR *wstr)
176 {
177     int wlen = (int)wcslen(wstr)+1;
178     BOOL use_default = FALSE;
179     int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, NULL, 0, NULL, NULL);
180     SV *sv = sv_2mortal(newSV(len));
181
182     len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, SvPVX(sv), len, NULL, &use_default);
183     if (use_default) {
184         len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, NULL, 0, NULL, NULL);
185         sv_grow(sv, len);
186         len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, SvPVX(sv), len, NULL, NULL);
187         SvUTF8_on(sv);
188     }
189     /* Shouldn't really ever fail since we ask for the required length first, but who knows... */
190     if (len) {
191         SvPOK_on(sv);
192         SvCUR_set(sv, len-1);
193     }
194     return sv;
195 }
196
197 /* Retrieve a variable from the Unicode environment in a mortal SV.
198  *
199  * Recreates the Unicode environment because a bug in earlier Perl versions
200  * overwrites it with the ANSI version, which contains replacement
201  * characters for the characters not in the ANSI codepage.
202  */
203 SV*
204 get_unicode_env(pTHX_ WCHAR *name)
205 {
206     SV *sv = NULL;
207     void *env;
208     HANDLE token;
209     HMODULE module;
210     PFNOpenProcessToken pfnOpenProcessToken;
211
212     /* Get security token for the current process owner */
213     module = LoadLibrary("advapi32.dll");
214     if (!module)
215         return NULL;
216
217     GETPROC(OpenProcessToken);
218
219     if (pfnOpenProcessToken == NULL ||
220         !pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY | TOKEN_DUPLICATE, &token))
221     {
222         FreeLibrary(module);
223         return NULL;
224     }
225     FreeLibrary(module);
226
227     /* Create a Unicode environment block for this process */
228     module = LoadLibrary("userenv.dll");
229     if (module) {
230         PFNCreateEnvironmentBlock pfnCreateEnvironmentBlock;
231         PFNDestroyEnvironmentBlock pfnDestroyEnvironmentBlock;
232
233         GETPROC(CreateEnvironmentBlock);
234         GETPROC(DestroyEnvironmentBlock);
235
236         if (pfnCreateEnvironmentBlock && pfnDestroyEnvironmentBlock &&
237             pfnCreateEnvironmentBlock(&env, token, FALSE))
238         {
239             size_t name_len = wcslen(name);
240             WCHAR *entry = env;
241             while (*entry) {
242                 size_t i;
243                 size_t entry_len = wcslen(entry);
244                 BOOL equal = (entry_len > name_len) && (entry[name_len] == '=');
245
246                 for (i=0; equal && i < name_len; ++i)
247                     equal = (towupper(entry[i]) == towupper(name[i]));
248
249                 if (equal) {
250                     sv = wstr_to_sv(aTHX_ entry+name_len+1);
251                     break;
252                 }
253                 entry += entry_len+1;
254             }
255             pfnDestroyEnvironmentBlock(env);
256         }
257         FreeLibrary(module);
258     }
259     CloseHandle(token);
260     return sv;
261 }
262
263 /* Define both an ANSI and a Wide version of win32_longpath */
264
265 #define CHAR_T            char
266 #define WIN32_FIND_DATA_T WIN32_FIND_DATAA
267 #define FN_FINDFIRSTFILE  FindFirstFileA
268 #define FN_STRLEN         strlen
269 #define FN_STRCPY         strcpy
270 #define LONGPATH          my_longpathA
271 #include "longpath.inc"
272
273 #define CHAR_T            WCHAR
274 #define WIN32_FIND_DATA_T WIN32_FIND_DATAW
275 #define FN_FINDFIRSTFILE  FindFirstFileW
276 #define FN_STRLEN         wcslen
277 #define FN_STRCPY         wcscpy
278 #define LONGPATH          my_longpathW
279 #include "longpath.inc"
280
281 /* The my_ansipath() function takes a Unicode filename and converts it
282  * into the current Windows codepage. If some characters cannot be mapped,
283  * then it will convert the short name instead.
284  *
285  * The buffer to the ansi pathname must be freed with Safefree() when it
286  * it no longer needed.
287  *
288  * The argument to my_ansipath() must exist before this function is
289  * called; otherwise there is no way to determine the short path name.
290  *
291  * Ideas for future refinement:
292  * - Only convert those segments of the path that are not in the current
293  *   codepage, but leave the other segments in their long form.
294  * - If the resulting name is longer than MAX_PATH, start converting
295  *   additional path segments into short names until the full name
296  *   is shorter than MAX_PATH.  Shorten the filename part last!
297  */
298
299 /* This is a modified version of core Perl win32/win32.c(win32_ansipath).
300  * It uses New() etc. instead of win32_malloc().
301  */
302
303 char *
304 my_ansipath(const WCHAR *widename)
305 {
306     char *name;
307     BOOL use_default = FALSE;
308     int widelen = (int)wcslen(widename)+1;
309     int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
310                                   NULL, 0, NULL, NULL);
311     New(0, name, len, char);
312     WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
313                         name, len, NULL, &use_default);
314     if (use_default) {
315         DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
316         if (shortlen) {
317             WCHAR *shortname;
318             New(0, shortname, shortlen, WCHAR);
319             shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
320
321             len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
322                                       NULL, 0, NULL, NULL);
323             Renew(name, len, char);
324             WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
325                                 name, len, NULL, NULL);
326             Safefree(shortname);
327         }
328     }
329     return name;
330 }
331
332 /* Convert wide character path to ANSI path and return as mortal SV. */
333 SV*
334 wstr_to_ansipath(pTHX_ WCHAR *wstr)
335 {
336     char *ansi = my_ansipath(wstr);
337     SV *sv = sv_2mortal(newSVpvn(ansi, strlen(ansi)));
338     Safefree(ansi);
339     return sv;
340 }
341
342 #ifdef __CYGWIN__
343
344 char*
345 get_childdir(void)
346 {
347     dTHX;
348     char* ptr;
349
350     if (IsWin2000()) {
351         WCHAR filename[MAX_PATH+1];
352         GetCurrentDirectoryW(MAX_PATH+1, filename);
353         ptr = my_ansipath(filename);
354     }
355     else {
356         char filename[MAX_PATH+1];
357         GetCurrentDirectoryA(MAX_PATH+1, filename);
358         New(0, ptr, strlen(filename)+1, char);
359         strcpy(ptr, filename);
360     }
361     return ptr;
362 }
363
364 void
365 free_childdir(char *d)
366 {
367     dTHX;
368     Safefree(d);
369 }
370
371 void*
372 get_childenv(void)
373 {
374     return NULL;
375 }
376
377 void
378 free_childenv(void *d)
379 {
380 }
381
382 #  define PerlDir_mapA(dir) (dir)
383
384 #endif
385
386 XS(w32_ExpandEnvironmentStrings)
387 {
388     dXSARGS;
389
390     if (items != 1)
391         croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
392
393     if (IsWin2000()) {
394         WCHAR value[31*1024];
395         WCHAR *source = sv_to_wstr(aTHX_ ST(0));
396         ExpandEnvironmentStringsW(source, value, countof(value)-1);
397         ST(0) = wstr_to_sv(aTHX_ value);
398         Safefree(source);
399         XSRETURN(1);
400     }
401     else {
402         char value[31*1024];
403         ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), value, countof(value)-2);
404         XSRETURN_PV(value);
405     }
406 }
407
408 XS(w32_IsAdminUser)
409 {
410     dXSARGS;
411     HMODULE                     module;
412     PFNIsUserAnAdmin            pfnIsUserAnAdmin;
413     PFNOpenThreadToken          pfnOpenThreadToken;
414     PFNOpenProcessToken         pfnOpenProcessToken;
415     PFNGetTokenInformation      pfnGetTokenInformation;
416     PFNAllocateAndInitializeSid pfnAllocateAndInitializeSid;
417     PFNEqualSid                 pfnEqualSid;
418     PFNFreeSid                  pfnFreeSid;
419     HANDLE                      hTok;
420     DWORD                       dwTokInfoLen;
421     TOKEN_GROUPS                *lpTokInfo;
422     SID_IDENTIFIER_AUTHORITY    NtAuth = SECURITY_NT_AUTHORITY;
423     PSID                        pAdminSid;
424     int                         iRetVal;
425     unsigned int                i;
426
427     if (items)
428         croak("usage: Win32::IsAdminUser()");
429
430     /* There is no concept of "Administrator" user accounts on Win9x systems,
431        so just return true. */
432     if (IsWin95())
433         XSRETURN_YES;
434
435     /* Use IsUserAnAdmin() when available.  On Vista this will only return TRUE
436      * if the process is running with elevated privileges and not just when the
437      * process owner is a member of the "Administrators" group.
438      */
439     module = LoadLibrary("shell32.dll");
440     if (module) {
441         GETPROC(IsUserAnAdmin);
442         if (pfnIsUserAnAdmin) {
443             EXTEND(SP, 1);
444             ST(0) = sv_2mortal(newSViv(pfnIsUserAnAdmin() ? 1 : 0));
445             FreeLibrary(module);
446             XSRETURN(1);
447         }
448         FreeLibrary(module);
449     }
450
451     module = LoadLibrary("advapi32.dll");
452     if (!module) {
453         warn("Cannot load advapi32.dll library");
454         XSRETURN_UNDEF;
455     }
456
457     GETPROC(OpenThreadToken);
458     GETPROC(OpenProcessToken);
459     GETPROC(GetTokenInformation);
460     GETPROC(AllocateAndInitializeSid);
461     GETPROC(EqualSid);
462     GETPROC(FreeSid);
463
464     if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
465           pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
466           pfnEqualSid && pfnFreeSid))
467     {
468         warn("Cannot load functions from advapi32.dll library");
469         FreeLibrary(module);
470         XSRETURN_UNDEF;
471     }
472
473     if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
474         if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
475             warn("Cannot open thread token or process token");
476             FreeLibrary(module);
477             XSRETURN_UNDEF;
478         }
479     }
480
481     pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
482     if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
483         warn("Cannot allocate token information structure");
484         CloseHandle(hTok);
485         FreeLibrary(module);
486         XSRETURN_UNDEF;
487     }
488
489     if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
490             &dwTokInfoLen))
491     {
492         warn("Cannot get token information");
493         Safefree(lpTokInfo);
494         CloseHandle(hTok);
495         FreeLibrary(module);
496         XSRETURN_UNDEF;
497     }
498
499     if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
500             DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))
501     {
502         warn("Cannot allocate administrators' SID");
503         Safefree(lpTokInfo);
504         CloseHandle(hTok);
505         FreeLibrary(module);
506         XSRETURN_UNDEF;
507     }
508
509     iRetVal = 0;
510     for (i = 0; i < lpTokInfo->GroupCount; ++i) {
511         if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {
512             iRetVal = 1;
513             break;
514         }
515     }
516
517     pfnFreeSid(pAdminSid);
518     Safefree(lpTokInfo);
519     CloseHandle(hTok);
520     FreeLibrary(module);
521
522     EXTEND(SP, 1);
523     ST(0) = sv_2mortal(newSViv(iRetVal));
524     XSRETURN(1);
525 }
526
527 XS(w32_LookupAccountName)
528 {
529     dXSARGS;
530     char SID[400];
531     DWORD SIDLen;
532     SID_NAME_USE snu;
533     char Domain[256];
534     DWORD DomLen;
535     BOOL bResult;
536
537     if (items != 5)
538         croak("usage: Win32::LookupAccountName($system, $account, $domain, "
539               "$sid, $sidtype);\n");
540
541     SIDLen = sizeof(SID);
542     DomLen = sizeof(Domain);
543
544     bResult = LookupAccountNameA(SvPV_nolen(ST(0)),     /* System */
545                                  SvPV_nolen(ST(1)),     /* Account name */
546                                  &SID,                  /* SID structure */
547                                  &SIDLen,               /* Size of SID buffer */
548                                  Domain,                /* Domain buffer */
549                                  &DomLen,               /* Domain buffer size */
550                                  &snu);                 /* SID name type */
551     if (bResult) {
552         sv_setpv(ST(2), Domain);
553         sv_setpvn(ST(3), SID, SIDLen);
554         sv_setiv(ST(4), snu);
555         XSRETURN_YES;
556     }
557     XSRETURN_NO;
558 }
559
560
561 XS(w32_LookupAccountSID)
562 {
563     dXSARGS;
564     PSID sid;
565     char Account[256];
566     DWORD AcctLen = sizeof(Account);
567     char Domain[256];
568     DWORD DomLen = sizeof(Domain);
569     SID_NAME_USE snu;
570     BOOL bResult;
571
572     if (items != 5)
573         croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
574
575     sid = SvPV_nolen(ST(1));
576     if (IsValidSid(sid)) {
577         bResult = LookupAccountSidA(SvPV_nolen(ST(0)),  /* System */
578                                     sid,                /* SID structure */
579                                     Account,            /* Account name buffer */
580                                     &AcctLen,           /* name buffer length */
581                                     Domain,             /* Domain buffer */
582                                     &DomLen,            /* Domain buffer length */
583                                     &snu);              /* SID name type */
584         if (bResult) {
585             sv_setpv(ST(2), Account);
586             sv_setpv(ST(3), Domain);
587             sv_setiv(ST(4), (IV)snu);
588             XSRETURN_YES;
589         }
590     }
591     XSRETURN_NO;
592 }
593
594 XS(w32_InitiateSystemShutdown)
595 {
596     dXSARGS;
597     HANDLE hToken;              /* handle to process token   */
598     TOKEN_PRIVILEGES tkp;       /* pointer to token structure  */
599     BOOL bRet;
600     char *machineName, *message;
601
602     if (items != 5)
603         croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
604               "$timeOut, $forceClose, $reboot);\n");
605
606     machineName = SvPV_nolen(ST(0));
607
608     if (OpenProcessToken(GetCurrentProcess(),
609                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
610                          &hToken))
611     {
612         LookupPrivilegeValueA(machineName,
613                               SE_SHUTDOWN_NAMEA,
614                               &tkp.Privileges[0].Luid);
615
616         tkp.PrivilegeCount = 1; /* only setting one */
617         tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
618
619         /* Get shutdown privilege for this process. */
620         AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
621                               (PTOKEN_PRIVILEGES)NULL, 0);
622     }
623
624     message = SvPV_nolen(ST(1));
625     bRet = InitiateSystemShutdownA(machineName, message, (DWORD)SvIV(ST(2)),
626                                    (BOOL)SvIV(ST(3)), (BOOL)SvIV(ST(4)));
627
628     /* Disable shutdown privilege. */
629     tkp.Privileges[0].Attributes = 0; 
630     AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
631                           (PTOKEN_PRIVILEGES)NULL, 0); 
632     CloseHandle(hToken);
633     XSRETURN_IV(bRet);
634 }
635
636 XS(w32_AbortSystemShutdown)
637 {
638     dXSARGS;
639     HANDLE hToken;              /* handle to process token   */
640     TOKEN_PRIVILEGES tkp;       /* pointer to token structure  */
641     BOOL bRet;
642     char *machineName;
643
644     if (items != 1)
645         croak("usage: Win32::AbortSystemShutdown($machineName);\n");
646
647     machineName = SvPV_nolen(ST(0));
648
649     if (OpenProcessToken(GetCurrentProcess(),
650                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
651                          &hToken))
652     {
653         LookupPrivilegeValueA(machineName,
654                               SE_SHUTDOWN_NAMEA,
655                               &tkp.Privileges[0].Luid);
656
657         tkp.PrivilegeCount = 1; /* only setting one */
658         tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
659
660         /* Get shutdown privilege for this process. */
661         AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
662                               (PTOKEN_PRIVILEGES)NULL, 0);
663     }
664
665     bRet = AbortSystemShutdownA(machineName);
666
667     /* Disable shutdown privilege. */
668     tkp.Privileges[0].Attributes = 0;
669     AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
670                           (PTOKEN_PRIVILEGES)NULL, 0);
671     CloseHandle(hToken);
672     XSRETURN_IV(bRet);
673 }
674
675
676 XS(w32_MsgBox)
677 {
678     dXSARGS;
679     DWORD flags = MB_ICONEXCLAMATION;
680     I32 result;
681
682     if (items < 1 || items > 3)
683         croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
684
685     if (items > 1)
686         flags = (DWORD)SvIV(ST(1));
687
688     if (IsWin2000()) {
689         WCHAR *title = NULL;
690         WCHAR *msg = sv_to_wstr(aTHX_ ST(0));
691         if (items > 2)
692             title = sv_to_wstr(aTHX_ ST(2));
693         result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags);
694         Safefree(msg);
695         if (title)
696             Safefree(title);
697     }
698     else {
699         char *title = "Perl";
700         char *msg = SvPV_nolen(ST(0));
701         if (items > 2)
702             title = SvPV_nolen(ST(2));
703         result = MessageBoxA(GetActiveWindow(), msg, title, flags);
704     }
705     XSRETURN_IV(result);
706 }
707
708 XS(w32_LoadLibrary)
709 {
710     dXSARGS;
711     HANDLE hHandle;
712
713     if (items != 1)
714         croak("usage: Win32::LoadLibrary($libname)\n");
715     hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
716 #ifdef _WIN64
717     XSRETURN_IV((DWORD_PTR)hHandle);
718 #else
719     XSRETURN_IV((DWORD)hHandle);
720 #endif
721 }
722
723 XS(w32_FreeLibrary)
724 {
725     dXSARGS;
726
727     if (items != 1)
728         croak("usage: Win32::FreeLibrary($handle)\n");
729     if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
730         XSRETURN_YES;
731     }
732     XSRETURN_NO;
733 }
734
735 XS(w32_GetProcAddress)
736 {
737     dXSARGS;
738
739     if (items != 2)
740         croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
741     XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
742 }
743
744 XS(w32_RegisterServer)
745 {
746     dXSARGS;
747     BOOL result = FALSE;
748     HMODULE module;
749
750     if (items != 1)
751         croak("usage: Win32::RegisterServer($libname)\n");
752
753     module = LoadLibraryA(SvPV_nolen(ST(0)));
754     if (module) {
755         PFNDllRegisterServer pfnDllRegisterServer;
756         GETPROC(DllRegisterServer);
757         if (pfnDllRegisterServer && pfnDllRegisterServer() == 0)
758             result = TRUE;
759         FreeLibrary(module);
760     }
761     ST(0) = boolSV(result);
762     XSRETURN(1);
763 }
764
765 XS(w32_UnregisterServer)
766 {
767     dXSARGS;
768     BOOL result = FALSE;
769     HINSTANCE module;
770
771     if (items != 1)
772         croak("usage: Win32::UnregisterServer($libname)\n");
773
774     module = LoadLibraryA(SvPV_nolen(ST(0)));
775     if (module) {
776         PFNDllUnregisterServer pfnDllUnregisterServer;
777         GETPROC(DllUnregisterServer);
778         if (pfnDllUnregisterServer && pfnDllUnregisterServer() == 0)
779             result = TRUE;
780         FreeLibrary(module);
781     }
782     ST(0) = boolSV(result);
783     XSRETURN(1);
784 }
785
786 /* XXX rather bogus */
787 XS(w32_GetArchName)
788 {
789     dXSARGS;
790     XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
791 }
792
793 XS(w32_GetChipName)
794 {
795     dXSARGS;
796     SYSTEM_INFO sysinfo;
797     HMODULE module;
798     PFNGetNativeSystemInfo pfnGetNativeSystemInfo;
799
800     Zero(&sysinfo,1,SYSTEM_INFO);
801     module = GetModuleHandle("kernel32.dll");
802     GETPROC(GetNativeSystemInfo);
803     if (pfnGetNativeSystemInfo)
804         pfnGetNativeSystemInfo(&sysinfo);
805     else
806         GetSystemInfo(&sysinfo);
807
808     /* XXX docs say dwProcessorType is deprecated on NT */
809     XSRETURN_IV(sysinfo.dwProcessorType);
810 }
811
812 XS(w32_GuidGen)
813 {
814     dXSARGS;
815     GUID guid;
816     char szGUID[50] = {'\0'};
817     HRESULT  hr     = CoCreateGuid(&guid);
818
819     if (SUCCEEDED(hr)) {
820         LPOLESTR pStr = NULL;
821         if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
822             WideCharToMultiByte(CP_ACP, 0, pStr, (int)wcslen(pStr), szGUID,
823                                 sizeof(szGUID), NULL, NULL);
824             CoTaskMemFree(pStr);
825             XSRETURN_PV(szGUID);
826         }
827     }
828     XSRETURN_UNDEF;
829 }
830
831 XS(w32_GetFolderPath)
832 {
833     dXSARGS;
834     char path[MAX_PATH+1];
835     WCHAR wpath[MAX_PATH+1];
836     int folder;
837     int create = 0;
838     HMODULE module;
839
840     if (items != 1 && items != 2)
841         croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
842
843     folder = (int)SvIV(ST(0));
844     if (items == 2)
845         create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
846
847     module = LoadLibrary("shfolder.dll");
848     if (module) {
849         PFNSHGetFolderPathA pfna;
850         if (IsWin2000()) {
851             PFNSHGetFolderPathW pfnw;
852             pfnw = (PFNSHGetFolderPathW)GetProcAddress(module, "SHGetFolderPathW");
853             if (pfnw && SUCCEEDED(pfnw(NULL, folder|create, NULL, 0, wpath))) {
854                 FreeLibrary(module);
855                 ST(0) = wstr_to_ansipath(aTHX_ wpath);
856                 XSRETURN(1);
857             }
858         }
859         pfna = (PFNSHGetFolderPathA)GetProcAddress(module, "SHGetFolderPathA");
860         if (pfna && SUCCEEDED(pfna(NULL, folder|create, NULL, 0, path))) {
861             FreeLibrary(module);
862             XSRETURN_PV(path);
863         }
864         FreeLibrary(module);
865     }
866
867     module = LoadLibrary("shell32.dll");
868     if (module) {
869         PFNSHGetSpecialFolderPathA pfna;
870         if (IsWin2000()) {
871             PFNSHGetSpecialFolderPathW pfnw;
872             pfnw = (PFNSHGetSpecialFolderPathW)GetProcAddress(module, "SHGetSpecialFolderPathW");
873             if (pfnw && pfnw(NULL, wpath, folder, !!create)) {
874                 FreeLibrary(module);
875                 ST(0) = wstr_to_ansipath(aTHX_ wpath);
876                 XSRETURN(1);
877             }
878         }
879         pfna = (PFNSHGetSpecialFolderPathA)GetProcAddress(module, "SHGetSpecialFolderPathA");
880         if (pfna && pfna(NULL, path, folder, !!create)) {
881             FreeLibrary(module);
882             XSRETURN_PV(path);
883         }
884         FreeLibrary(module);
885     }
886
887     /* SHGetFolderPathW() and SHGetSpecialFolderPathW() may fail on older
888      * Perl versions that have replaced the Unicode environment with an
889      * ANSI version.  Let's go spelunking in the registry now...
890      */
891     if (IsWin2000()) {
892         SV *sv;
893         HKEY hkey;
894         HKEY root = HKEY_CURRENT_USER;
895         WCHAR *name = NULL;
896
897         switch (folder) {
898         case CSIDL_ADMINTOOLS:                  name = L"Administrative Tools";        break;
899         case CSIDL_APPDATA:                     name = L"AppData";                     break;
900         case CSIDL_CDBURN_AREA:                 name = L"CD Burning";                  break;
901         case CSIDL_COOKIES:                     name = L"Cookies";                     break;
902         case CSIDL_DESKTOP:
903         case CSIDL_DESKTOPDIRECTORY:            name = L"Desktop";                     break;
904         case CSIDL_FAVORITES:                   name = L"Favorites";                   break;
905         case CSIDL_FONTS:                       name = L"Fonts";                       break;
906         case CSIDL_HISTORY:                     name = L"History";                     break;
907         case CSIDL_INTERNET_CACHE:              name = L"Cache";                       break;
908         case CSIDL_LOCAL_APPDATA:               name = L"Local AppData";               break;
909         case CSIDL_MYMUSIC:                     name = L"My Music";                    break;
910         case CSIDL_MYPICTURES:                  name = L"My Pictures";                 break;
911         case CSIDL_MYVIDEO:                     name = L"My Video";                    break;
912         case CSIDL_NETHOOD:                     name = L"NetHood";                     break;
913         case CSIDL_PERSONAL:                    name = L"Personal";                    break;
914         case CSIDL_PRINTHOOD:                   name = L"PrintHood";                   break;
915         case CSIDL_PROGRAMS:                    name = L"Programs";                    break;
916         case CSIDL_RECENT:                      name = L"Recent";                      break;
917         case CSIDL_SENDTO:                      name = L"SendTo";                      break;
918         case CSIDL_STARTMENU:                   name = L"Start Menu";                  break;
919         case CSIDL_STARTUP:                     name = L"Startup";                     break;
920         case CSIDL_TEMPLATES:                   name = L"Templates";                   break;
921             /* XXX L"Local Settings" */
922         }
923
924         if (!name) {
925             root = HKEY_LOCAL_MACHINE;
926             switch (folder) {
927             case CSIDL_COMMON_ADMINTOOLS:       name = L"Common Administrative Tools"; break;
928             case CSIDL_COMMON_APPDATA:          name = L"Common AppData";              break;
929             case CSIDL_COMMON_DESKTOPDIRECTORY: name = L"Common Desktop";              break;
930             case CSIDL_COMMON_DOCUMENTS:        name = L"Common Documents";            break;
931             case CSIDL_COMMON_FAVORITES:        name = L"Common Favorites";            break;
932             case CSIDL_COMMON_PROGRAMS:         name = L"Common Programs";             break;
933             case CSIDL_COMMON_STARTMENU:        name = L"Common Start Menu";           break;
934             case CSIDL_COMMON_STARTUP:          name = L"Common Startup";              break;
935             case CSIDL_COMMON_TEMPLATES:        name = L"Common Templates";            break;
936             case CSIDL_COMMON_MUSIC:            name = L"CommonMusic";                 break;
937             case CSIDL_COMMON_PICTURES:         name = L"CommonPictures";              break;
938             case CSIDL_COMMON_VIDEO:            name = L"CommonVideo";                 break;
939             }
940         }
941         /* XXX todo
942          * case CSIDL_SYSTEM               # GetSystemDirectory()
943          * case CSIDL_RESOURCES            # %windir%\Resources\, For theme and other windows resources.
944          * case CSIDL_RESOURCES_LOCALIZED  # %windir%\Resources\<LangID>, for theme and other windows specific resources.
945          */
946
947 #define SHELL_FOLDERS "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"
948
949         if (name && RegOpenKeyEx(root, SHELL_FOLDERS, 0, KEY_QUERY_VALUE, &hkey) == ERROR_SUCCESS) {
950             WCHAR data[MAX_PATH+1];
951             DWORD cb = sizeof(data)-sizeof(WCHAR);
952             DWORD type = REG_NONE;
953             long rc = RegQueryValueExW(hkey, name, NULL, &type, (BYTE*)&data, &cb);
954             RegCloseKey(hkey);
955             if (rc == ERROR_SUCCESS && type == REG_SZ && cb > sizeof(WCHAR) && data[0]) {
956                 /* Make sure the string is properly terminated */
957                 data[cb/sizeof(WCHAR)] = '\0';
958                 ST(0) = wstr_to_ansipath(aTHX_ data);
959                 XSRETURN(1);
960             }
961         }
962
963 #undef SHELL_FOLDERS
964
965         /* Unders some circumstances the registry entries seem to have a null string
966          * as their value even when the directory already exists.  The environment
967          * variables do get set though, so try re-create a Unicode environment and
968          * check if they are there.
969          */
970         sv = NULL;
971         switch (folder) {
972         case CSIDL_APPDATA:              sv = get_unicode_env(aTHX_ L"APPDATA");            break;
973         case CSIDL_PROFILE:              sv = get_unicode_env(aTHX_ L"USERPROFILE");        break;
974         case CSIDL_PROGRAM_FILES:        sv = get_unicode_env(aTHX_ L"ProgramFiles");       break;
975         case CSIDL_PROGRAM_FILES_COMMON: sv = get_unicode_env(aTHX_ L"CommonProgramFiles"); break;
976         case CSIDL_WINDOWS:              sv = get_unicode_env(aTHX_ L"SystemRoot");         break;
977         }
978         if (sv) {
979             ST(0) = sv;
980             XSRETURN(1);
981         }
982     }
983
984     XSRETURN_UNDEF;
985 }
986
987 XS(w32_GetFileVersion)
988 {
989     dXSARGS;
990     DWORD size;
991     DWORD handle;
992     char *filename;
993     char *data;
994
995     if (items != 1)
996         croak("usage: Win32::GetFileVersion($filename)\n");
997
998     filename = SvPV_nolen(ST(0));
999     size = GetFileVersionInfoSize(filename, &handle);
1000     if (!size)
1001         XSRETURN_UNDEF;
1002
1003     New(0, data, size, char);
1004     if (!data)
1005         XSRETURN_UNDEF;
1006
1007     if (GetFileVersionInfo(filename, handle, size, data)) {
1008         VS_FIXEDFILEINFO *info;
1009         UINT len;
1010         if (VerQueryValue(data, "\\", (void**)&info, &len)) {
1011             int dwValueMS1 = (info->dwFileVersionMS>>16);
1012             int dwValueMS2 = (info->dwFileVersionMS&0xffff);
1013             int dwValueLS1 = (info->dwFileVersionLS>>16);
1014             int dwValueLS2 = (info->dwFileVersionLS&0xffff);
1015
1016             if (GIMME_V == G_ARRAY) {
1017                 EXTEND(SP, 4);
1018                 XST_mIV(0, dwValueMS1);
1019                 XST_mIV(1, dwValueMS2);
1020                 XST_mIV(2, dwValueLS1);
1021                 XST_mIV(3, dwValueLS2);
1022                 items = 4;
1023             }
1024             else {
1025                 char version[50];
1026                 sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
1027                 XST_mPV(0, version);
1028             }
1029         }
1030     }
1031     else
1032         items = 0;
1033
1034     Safefree(data);
1035     XSRETURN(items);
1036 }
1037
1038 #ifdef __CYGWIN__
1039 XS(w32_SetChildShowWindow)
1040 {
1041     /* This function doesn't do anything useful for cygwin.  In the
1042      * MSWin32 case it modifies w32_showwindow, which is used by
1043      * win32_spawnvp().  Since w32_showwindow is an internal variable
1044      * inside the thread_intern structure, the MSWin32 implementation
1045      * lives in win32/win32.c in the core Perl distribution.
1046      */
1047     dXSARGS;
1048     XSRETURN_UNDEF;
1049 }
1050 #endif
1051
1052 XS(w32_GetCwd)
1053 {
1054     dXSARGS;
1055     /* Make the host for current directory */
1056     char* ptr = PerlEnv_get_childdir();
1057     /*
1058      * If ptr != Nullch
1059      *   then it worked, set PV valid,
1060      *   else return 'undef'
1061      */
1062     if (ptr) {
1063         SV *sv = sv_newmortal();
1064         sv_setpv(sv, ptr);
1065         PerlEnv_free_childdir(ptr);
1066
1067 #ifndef INCOMPLETE_TAINTS
1068         SvTAINTED_on(sv);
1069 #endif
1070
1071         EXTEND(SP,1);
1072         ST(0) = sv;
1073         XSRETURN(1);
1074     }
1075     XSRETURN_UNDEF;
1076 }
1077
1078 XS(w32_SetCwd)
1079 {
1080     dXSARGS;
1081     if (items != 1)
1082         Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)");
1083
1084     if (IsWin2000() && SvUTF8(ST(0))) {
1085         WCHAR *wide = sv_to_wstr(aTHX_ ST(0));
1086         char *ansi = my_ansipath(wide);
1087         int rc = PerlDir_chdir(ansi);
1088         Safefree(wide);
1089         Safefree(ansi);
1090         if (!rc)
1091             XSRETURN_YES;
1092     }
1093     else {
1094         if (!PerlDir_chdir(SvPV_nolen(ST(0))))
1095             XSRETURN_YES;
1096     }
1097
1098     XSRETURN_NO;
1099 }
1100
1101 XS(w32_GetNextAvailDrive)
1102 {
1103     dXSARGS;
1104     char ix = 'C';
1105     char root[] = "_:\\";
1106
1107     EXTEND(SP,1);
1108     while (ix <= 'Z') {
1109         root[0] = ix++;
1110         if (GetDriveType(root) == 1) {
1111             root[2] = '\0';
1112             XSRETURN_PV(root);
1113         }
1114     }
1115     XSRETURN_UNDEF;
1116 }
1117
1118 XS(w32_GetLastError)
1119 {
1120     dXSARGS;
1121     EXTEND(SP,1);
1122     XSRETURN_IV(GetLastError());
1123 }
1124
1125 XS(w32_SetLastError)
1126 {
1127     dXSARGS;
1128     if (items != 1)
1129         Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
1130     SetLastError((DWORD)SvIV(ST(0)));
1131     XSRETURN_EMPTY;
1132 }
1133
1134 XS(w32_LoginName)
1135 {
1136     dXSARGS;
1137     EXTEND(SP,1);
1138     if (IsWin2000()) {
1139         WCHAR name[128];
1140         DWORD size = countof(name);
1141         if (GetUserNameW(name, &size)) {
1142             ST(0) = wstr_to_sv(aTHX_ name);
1143             XSRETURN(1);
1144         }
1145     }
1146     else {
1147         char name[128];
1148         DWORD size = countof(name);
1149         if (GetUserNameA(name, &size)) {
1150             /* size includes NULL */
1151             ST(0) = sv_2mortal(newSVpvn(name, size-1));
1152             XSRETURN(1);
1153         }
1154     }
1155     XSRETURN_UNDEF;
1156 }
1157
1158 XS(w32_NodeName)
1159 {
1160     dXSARGS;
1161     char name[MAX_COMPUTERNAME_LENGTH+1];
1162     DWORD size = sizeof(name);
1163     EXTEND(SP,1);
1164     if (GetComputerName(name,&size)) {
1165         /* size does NOT include NULL :-( */
1166         ST(0) = sv_2mortal(newSVpvn(name,size));
1167         XSRETURN(1);
1168     }
1169     XSRETURN_UNDEF;
1170 }
1171
1172
1173 XS(w32_DomainName)
1174 {
1175     dXSARGS;
1176     HMODULE module = LoadLibrary("netapi32.dll");
1177     PFNNetApiBufferFree pfnNetApiBufferFree;
1178     PFNNetWkstaGetInfo pfnNetWkstaGetInfo;
1179
1180     if (module) {
1181         GETPROC(NetApiBufferFree);
1182         GETPROC(NetWkstaGetInfo);
1183     }
1184     EXTEND(SP,1);
1185     if (module && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
1186         /* this way is more reliable, in case user has a local account. */
1187         char dname[256];
1188         DWORD dnamelen = sizeof(dname);
1189         struct {
1190             DWORD   wki100_platform_id;
1191             LPWSTR  wki100_computername;
1192             LPWSTR  wki100_langroup;
1193             DWORD   wki100_ver_major;
1194             DWORD   wki100_ver_minor;
1195         } *pwi;
1196         DWORD retval;
1197         retval = pfnNetWkstaGetInfo(NULL, 100, &pwi);
1198         /* NERR_Success *is* 0*/
1199         if (retval == 0) {
1200             if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
1201                 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
1202                                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
1203             }
1204             else {
1205                 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
1206                                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
1207             }
1208             pfnNetApiBufferFree(pwi);
1209             FreeLibrary(module);
1210             XSRETURN_PV(dname);
1211         }
1212         FreeLibrary(module);
1213         SetLastError(retval);
1214     }
1215     else {
1216         /* Win95 doesn't have NetWksta*(), so do it the old way */
1217         char name[256];
1218         DWORD size = sizeof(name);
1219         if (module)
1220             FreeLibrary(module);
1221         if (GetUserName(name,&size)) {
1222             char sid[ONE_K_BUFSIZE];
1223             DWORD sidlen = sizeof(sid);
1224             char dname[256];
1225             DWORD dnamelen = sizeof(dname);
1226             SID_NAME_USE snu;
1227             if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
1228                                   dname, &dnamelen, &snu)) {
1229                 XSRETURN_PV(dname);             /* all that for this */
1230             }
1231         }
1232     }
1233     XSRETURN_UNDEF;
1234 }
1235
1236 XS(w32_FsType)
1237 {
1238     dXSARGS;
1239     char fsname[256];
1240     DWORD flags, filecomplen;
1241     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
1242                          &flags, fsname, sizeof(fsname))) {
1243         if (GIMME_V == G_ARRAY) {
1244             XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
1245             XPUSHs(sv_2mortal(newSViv(flags)));
1246             XPUSHs(sv_2mortal(newSViv(filecomplen)));
1247             PUTBACK;
1248             return;
1249         }
1250         EXTEND(SP,1);
1251         XSRETURN_PV(fsname);
1252     }
1253     XSRETURN_EMPTY;
1254 }
1255
1256 XS(w32_GetOSVersion)
1257 {
1258     dXSARGS;
1259
1260     if (GIMME_V == G_SCALAR) {
1261         XSRETURN_IV(g_osver.dwPlatformId);
1262     }
1263     XPUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));
1264
1265     XPUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));
1266     XPUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));
1267     XPUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));
1268     XPUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
1269     if (g_osver_ex) {
1270         XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));
1271         XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));
1272         XPUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));
1273         XPUSHs(sv_2mortal(newSViv(g_osver.wProductType)));
1274     }
1275     PUTBACK;
1276 }
1277
1278 XS(w32_IsWinNT)
1279 {
1280     dXSARGS;
1281     EXTEND(SP,1);
1282     XSRETURN_IV(IsWinNT());
1283 }
1284
1285 XS(w32_IsWin95)
1286 {
1287     dXSARGS;
1288     EXTEND(SP,1);
1289     XSRETURN_IV(IsWin95());
1290 }
1291
1292 XS(w32_FormatMessage)
1293 {
1294     dXSARGS;
1295     DWORD source = 0;
1296     char msgbuf[ONE_K_BUFSIZE];
1297
1298     if (items != 1)
1299         Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
1300
1301     if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
1302                        &source, (DWORD)SvIV(ST(0)), 0,
1303                        msgbuf, sizeof(msgbuf)-1, NULL))
1304     {
1305         XSRETURN_PV(msgbuf);
1306     }
1307
1308     XSRETURN_UNDEF;
1309 }
1310
1311 XS(w32_Spawn)
1312 {
1313     dXSARGS;
1314     char *cmd, *args;
1315     void *env;
1316     char *dir;
1317     PROCESS_INFORMATION stProcInfo;
1318     STARTUPINFO stStartInfo;
1319     BOOL bSuccess = FALSE;
1320
1321     if (items != 3)
1322         Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
1323
1324     cmd = SvPV_nolen(ST(0));
1325     args = SvPV_nolen(ST(1));
1326
1327     env = PerlEnv_get_childenv();
1328     dir = PerlEnv_get_childdir();
1329
1330     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
1331     stStartInfo.cb = sizeof(stStartInfo);           /* Set the structure size */
1332     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;     /* Enable wShowWindow control */
1333     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
1334
1335     if (CreateProcess(
1336                 cmd,                    /* Image path */
1337                 args,                   /* Arguments for command line */
1338                 NULL,                   /* Default process security */
1339                 NULL,                   /* Default thread security */
1340                 FALSE,                  /* Must be TRUE to use std handles */
1341                 NORMAL_PRIORITY_CLASS,  /* No special scheduling */
1342                 env,                    /* Inherit our environment block */
1343                 dir,                    /* Inherit our currrent directory */
1344                 &stStartInfo,           /* -> Startup info */
1345                 &stProcInfo))           /* <- Process info (if OK) */
1346     {
1347         int pid = (int)stProcInfo.dwProcessId;
1348         if (IsWin95() && pid < 0)
1349             pid = -pid;
1350         sv_setiv(ST(2), pid);
1351         CloseHandle(stProcInfo.hThread);/* library source code does this. */
1352         bSuccess = TRUE;
1353     }
1354     PerlEnv_free_childenv(env);
1355     PerlEnv_free_childdir(dir);
1356     XSRETURN_IV(bSuccess);
1357 }
1358
1359 XS(w32_GetTickCount)
1360 {
1361     dXSARGS;
1362     DWORD msec = GetTickCount();
1363     EXTEND(SP,1);
1364     if ((IV)msec > 0)
1365         XSRETURN_IV(msec);
1366     XSRETURN_NV(msec);
1367 }
1368
1369 XS(w32_GetShortPathName)
1370 {
1371     dXSARGS;
1372     SV *shortpath;
1373     DWORD len;
1374
1375     if (items != 1)
1376         Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
1377
1378     if (IsWin2000()) {
1379         WCHAR wshort[MAX_PATH+1];
1380         WCHAR *wlong = sv_to_wstr(aTHX_ ST(0));
1381         len = GetShortPathNameW(wlong, wshort, countof(wshort));
1382         Safefree(wlong);
1383         if (len && len < sizeof(wshort)) {
1384             ST(0) = wstr_to_sv(aTHX_ wshort);
1385             XSRETURN(1);
1386         }
1387         XSRETURN_UNDEF;
1388     }
1389
1390     shortpath = sv_mortalcopy(ST(0));
1391     SvUPGRADE(shortpath, SVt_PV);
1392     if (!SvPVX(shortpath) || !SvLEN(shortpath))
1393         XSRETURN_UNDEF;
1394
1395     /* src == target is allowed */
1396     do {
1397         len = GetShortPathName(SvPVX(shortpath),
1398                                SvPVX(shortpath),
1399                                (DWORD)SvLEN(shortpath));
1400     } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
1401     if (len) {
1402         SvCUR_set(shortpath,len);
1403         *SvEND(shortpath) = '\0';
1404         ST(0) = shortpath;
1405         XSRETURN(1);
1406     }
1407     XSRETURN_UNDEF;
1408 }
1409
1410 XS(w32_GetFullPathName)
1411 {
1412     dXSARGS;
1413     char *fullname;
1414     char *ansi = NULL;
1415
1416 /* The code below relies on the fact that PerlDir_mapX() returns an
1417  * absolute path, which is only true under PERL_IMPLICIT_SYS when
1418  * we use the virtualization code from win32/vdir.h.
1419  * Without it PerlDir_mapX() is a no-op and we need to use the same
1420  * code as we use for Cygwin.
1421  */
1422 #if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
1423     char buffer[2*MAX_PATH];
1424 #endif
1425
1426     if (items != 1)
1427         Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
1428
1429 #if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
1430     if (IsWin2000()) {
1431         WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
1432         WCHAR full[2*MAX_PATH];
1433         DWORD len = GetFullPathNameW(filename, countof(full), full, NULL);
1434         Safefree(filename);
1435         if (len == 0 || len >= countof(full))
1436             XSRETURN_EMPTY;
1437         ansi = fullname = my_ansipath(full);
1438     }
1439     else {
1440         DWORD len = GetFullPathNameA(SvPV_nolen(ST(0)), countof(buffer), buffer, NULL);
1441         if (len == 0 || len >= countof(buffer))
1442             XSRETURN_EMPTY;
1443         fullname = buffer;
1444     }
1445 #else
1446     /* Don't use my_ansipath() unless the $filename argument is in Unicode.
1447      * If the relative path doesn't exist, GetShortPathName() will fail and
1448      * my_ansipath() will use the long name with replacement characters.
1449      * In that case we will be better off using PerlDir_mapA(), which
1450      * already uses the ANSI name of the current directory.
1451      *
1452      * XXX The one missing case is where we could downgrade $filename
1453      * XXX from UTF8 into the current codepage.
1454      */
1455     if (IsWin2000() && SvUTF8(ST(0))) {
1456         WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
1457         WCHAR *mappedname = PerlDir_mapW(filename);
1458         Safefree(filename);
1459         ansi = fullname = my_ansipath(mappedname);
1460     }
1461     else {
1462         fullname = PerlDir_mapA(SvPV_nolen(ST(0)));
1463     }
1464 #  if PERL_VERSION < 8
1465     {
1466         /* PerlDir_mapX() in Perl 5.6 used to return forward slashes */
1467         char *str = fullname;
1468         while (*str) {
1469             if (*str == '/')
1470                 *str = '\\';
1471             ++str;
1472         }
1473     }
1474 #  endif
1475 #endif
1476
1477     /* GetFullPathName() on Windows NT drops trailing backslash */
1478     if (g_osver.dwMajorVersion == 4 && *fullname) {
1479         STRLEN len;
1480         char *pv = SvPV(ST(0), len);
1481         char *lastchar = fullname + strlen(fullname) - 1;
1482         /* If ST(0) ends with a slash, but fullname doesn't ... */
1483         if (len && (pv[len-1] == '/' || pv[len-1] == '\\') && *lastchar != '\\') {
1484             /* fullname is the MAX_PATH+1 sized buffer returned from PerlDir_mapA()
1485              * or the 2*MAX_PATH sized local buffer in the __CYGWIN__ case.
1486              */
1487             if (lastchar - fullname < MAX_PATH - 1)
1488                 strcpy(lastchar+1, "\\");
1489         }
1490     }
1491
1492     if (GIMME_V == G_ARRAY) {
1493         char *filepart = strrchr(fullname, '\\');
1494
1495         EXTEND(SP,1);
1496         if (filepart) {
1497             XST_mPV(1, ++filepart);
1498             *filepart = '\0';
1499         }
1500         else {
1501             XST_mPVN(1, "", 0);
1502         }
1503         items = 2;
1504     }
1505     XST_mPV(0, fullname);
1506
1507     if (ansi)
1508         Safefree(ansi);
1509     XSRETURN(items);
1510 }
1511
1512 XS(w32_GetLongPathName)
1513 {
1514     dXSARGS;
1515
1516     if (items != 1)
1517         Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
1518
1519     if (IsWin2000()) {
1520         WCHAR *wstr = sv_to_wstr(aTHX_ ST(0));
1521         WCHAR wide_path[MAX_PATH+1];
1522         WCHAR *long_path;
1523
1524         if (wcslen(wstr) < countof(wide_path)) {
1525             wcscpy(wide_path, wstr);
1526             long_path = my_longpathW(wide_path);
1527             if (long_path) {
1528                 Safefree(wstr);
1529                 ST(0) = wstr_to_sv(aTHX_ long_path);
1530                 XSRETURN(1);
1531             }
1532         }
1533         Safefree(wstr);
1534     }
1535     else {
1536         SV *path;
1537         char tmpbuf[MAX_PATH+1];
1538         char *pathstr;
1539         STRLEN len;
1540
1541         path = ST(0);
1542         pathstr = SvPV(path,len);
1543         if (len < sizeof(tmpbuf)) {
1544             strcpy(tmpbuf, pathstr);
1545             pathstr = my_longpathA(tmpbuf);
1546             if (pathstr) {
1547                 ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
1548                 XSRETURN(1);
1549             }
1550         }
1551     }
1552     XSRETURN_EMPTY;
1553 }
1554
1555 XS(w32_GetANSIPathName)
1556 {
1557     dXSARGS;
1558     WCHAR *wide_path;
1559
1560     if (items != 1)
1561         Perl_croak(aTHX_ "usage: Win32::GetANSIPathName($pathname)");
1562
1563     wide_path = sv_to_wstr(aTHX_ ST(0));
1564     ST(0) = wstr_to_ansipath(aTHX_ wide_path);
1565     Safefree(wide_path);
1566     XSRETURN(1);
1567 }
1568
1569 XS(w32_Sleep)
1570 {
1571     dXSARGS;
1572     if (items != 1)
1573         Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
1574     Sleep((DWORD)SvIV(ST(0)));
1575     XSRETURN_YES;
1576 }
1577
1578 XS(w32_CopyFile)
1579 {
1580     dXSARGS;
1581     BOOL bResult;
1582     char *pszSourceFile;
1583     char szSourceFile[MAX_PATH+1];
1584
1585     if (items != 3)
1586         Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
1587
1588     pszSourceFile = PerlDir_mapA(SvPV_nolen(ST(0)));
1589     if (strlen(pszSourceFile) < sizeof(szSourceFile)) {
1590         strcpy(szSourceFile, pszSourceFile);
1591         bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
1592         if (bResult)
1593             XSRETURN_YES;
1594     }
1595     XSRETURN_NO;
1596 }
1597
1598 XS(w32_OutputDebugString)
1599 {
1600     dXSARGS;
1601     if (items != 1)
1602         Perl_croak(aTHX_ "usage: Win32::OutputDebugString($string)");
1603
1604     if (SvUTF8(ST(0))) {
1605         WCHAR *str = sv_to_wstr(aTHX_ ST(0));
1606         OutputDebugStringW(str);
1607         Safefree(str);
1608     }
1609     else
1610         OutputDebugStringA(SvPV_nolen(ST(0)));
1611
1612     XSRETURN_EMPTY;
1613 }
1614
1615 XS(w32_GetCurrentProcessId)
1616 {
1617     dXSARGS;
1618     EXTEND(SP,1);
1619     XSRETURN_IV(GetCurrentProcessId());
1620 }
1621
1622 XS(w32_GetCurrentThreadId)
1623 {
1624     dXSARGS;
1625     EXTEND(SP,1);
1626     XSRETURN_IV(GetCurrentThreadId());
1627 }
1628
1629 XS(w32_CreateDirectory)
1630 {
1631     dXSARGS;
1632     BOOL result;
1633
1634     if (items != 1)
1635         Perl_croak(aTHX_ "usage: Win32::CreateDirectory($dir)");
1636
1637     if (IsWin2000() && SvUTF8(ST(0))) {
1638         WCHAR *dir = sv_to_wstr(aTHX_ ST(0));
1639         result = CreateDirectoryW(dir, NULL);
1640         Safefree(dir);
1641     }
1642     else {
1643         result = CreateDirectoryA(SvPV_nolen(ST(0)), NULL);
1644     }
1645
1646     ST(0) = boolSV(result);
1647     XSRETURN(1);
1648 }
1649
1650 XS(w32_CreateFile)
1651 {
1652     dXSARGS;
1653     HANDLE handle;
1654
1655     if (items != 1)
1656         Perl_croak(aTHX_ "usage: Win32::CreateFile($file)");
1657
1658     if (IsWin2000() && SvUTF8(ST(0))) {
1659         WCHAR *file = sv_to_wstr(aTHX_ ST(0));
1660         handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_WRITE,
1661                              NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
1662         Safefree(file);
1663     }
1664     else {
1665         handle = CreateFileA(SvPV_nolen(ST(0)), GENERIC_WRITE, FILE_SHARE_WRITE,
1666                              NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
1667     }
1668
1669     if (handle != INVALID_HANDLE_VALUE)
1670         CloseHandle(handle);
1671
1672     ST(0) = boolSV(handle != INVALID_HANDLE_VALUE);
1673     XSRETURN(1);
1674 }
1675
1676 XS(w32_GetSystemMetrics)
1677 {
1678     dXSARGS;
1679
1680     if (items != 1)
1681         Perl_croak(aTHX_ "usage: Win32::GetSystemMetrics($index)");
1682
1683     XSRETURN_IV(GetSystemMetrics((int)SvIV(ST(0))));
1684 }
1685
1686 XS(w32_GetProductInfo)
1687 {
1688     dXSARGS;
1689     DWORD type;
1690     HMODULE module;
1691     PFNGetProductInfo pfnGetProductInfo;
1692
1693     if (items != 4)
1694         Perl_croak(aTHX_ "usage: Win32::GetProductInfo($major,$minor,$spmajor,$spminor)");
1695
1696     module = GetModuleHandle("kernel32.dll");
1697     GETPROC(GetProductInfo);
1698     if (pfnGetProductInfo &&
1699         pfnGetProductInfo((DWORD)SvIV(ST(0)), (DWORD)SvIV(ST(1)),
1700                           (DWORD)SvIV(ST(2)), (DWORD)SvIV(ST(3)), &type))
1701     {
1702         XSRETURN_IV(type);
1703     }
1704
1705     /* PRODUCT_UNDEFINED */
1706     XSRETURN_IV(0);
1707 }
1708
1709 XS(w32_GetACP)
1710 {
1711     dXSARGS;
1712     EXTEND(SP,1);
1713     XSRETURN_IV(GetACP());
1714 }
1715
1716 XS(w32_GetConsoleCP)
1717 {
1718     dXSARGS;
1719     EXTEND(SP,1);
1720     XSRETURN_IV(GetConsoleCP());
1721 }
1722
1723 XS(w32_GetConsoleOutputCP)
1724 {
1725     dXSARGS;
1726     EXTEND(SP,1);
1727     XSRETURN_IV(GetConsoleOutputCP());
1728 }
1729
1730 XS(w32_GetOEMCP)
1731 {
1732     dXSARGS;
1733     EXTEND(SP,1);
1734     XSRETURN_IV(GetOEMCP());
1735 }
1736
1737 XS(w32_SetConsoleCP)
1738 {
1739     dXSARGS;
1740
1741     if (items != 1)
1742         Perl_croak(aTHX_ "usage: Win32::SetConsoleCP($id)");
1743
1744     XSRETURN_IV(SetConsoleCP((int)SvIV(ST(0))));
1745 }
1746
1747 XS(w32_SetConsoleOutputCP)
1748 {
1749     dXSARGS;
1750
1751     if (items != 1)
1752         Perl_croak(aTHX_ "usage: Win32::SetConsoleOutputCP($id)");
1753
1754     XSRETURN_IV(SetConsoleOutputCP((int)SvIV(ST(0))));
1755 }
1756
1757 MODULE = Win32            PACKAGE = Win32
1758
1759 PROTOTYPES: DISABLE
1760
1761 BOOT:
1762 {
1763     char *file = __FILE__;
1764
1765     if (g_osver.dwOSVersionInfoSize == 0) {
1766         g_osver.dwOSVersionInfoSize = sizeof(g_osver);
1767         if (!GetVersionExA((OSVERSIONINFOA*)&g_osver)) {
1768             g_osver_ex = FALSE;
1769             g_osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
1770             GetVersionExA((OSVERSIONINFOA*)&g_osver);
1771         }
1772     }
1773
1774     newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
1775     newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
1776     newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);
1777     newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file);
1778     newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file);
1779     newXS("Win32::MsgBox", w32_MsgBox, file);
1780     newXS("Win32::LoadLibrary", w32_LoadLibrary, file);
1781     newXS("Win32::FreeLibrary", w32_FreeLibrary, file);
1782     newXS("Win32::GetProcAddress", w32_GetProcAddress, file);
1783     newXS("Win32::RegisterServer", w32_RegisterServer, file);
1784     newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
1785     newXS("Win32::GetArchName", w32_GetArchName, file);
1786     newXS("Win32::GetChipName", w32_GetChipName, file);
1787     newXS("Win32::GuidGen", w32_GuidGen, file);
1788     newXS("Win32::GetFolderPath", w32_GetFolderPath, file);
1789     newXS("Win32::IsAdminUser", w32_IsAdminUser, file);
1790     newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
1791
1792     newXS("Win32::GetCwd", w32_GetCwd, file);
1793     newXS("Win32::SetCwd", w32_SetCwd, file);
1794     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
1795     newXS("Win32::GetLastError", w32_GetLastError, file);
1796     newXS("Win32::SetLastError", w32_SetLastError, file);
1797     newXS("Win32::LoginName", w32_LoginName, file);
1798     newXS("Win32::NodeName", w32_NodeName, file);
1799     newXS("Win32::DomainName", w32_DomainName, file);
1800     newXS("Win32::FsType", w32_FsType, file);
1801     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
1802     newXS("Win32::IsWinNT", w32_IsWinNT, file);
1803     newXS("Win32::IsWin95", w32_IsWin95, file);
1804     newXS("Win32::FormatMessage", w32_FormatMessage, file);
1805     newXS("Win32::Spawn", w32_Spawn, file);
1806     newXS("Win32::GetTickCount", w32_GetTickCount, file);
1807     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
1808     newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
1809     newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
1810     newXS("Win32::GetANSIPathName", w32_GetANSIPathName, file);
1811     newXS("Win32::CopyFile", w32_CopyFile, file);
1812     newXS("Win32::Sleep", w32_Sleep, file);
1813     newXS("Win32::OutputDebugString", w32_OutputDebugString, file);
1814     newXS("Win32::GetCurrentProcessId", w32_GetCurrentProcessId, file);
1815     newXS("Win32::GetCurrentThreadId", w32_GetCurrentThreadId, file);
1816     newXS("Win32::CreateDirectory", w32_CreateDirectory, file);
1817     newXS("Win32::CreateFile", w32_CreateFile, file);
1818     newXS("Win32::GetSystemMetrics", w32_GetSystemMetrics, file);
1819     newXS("Win32::GetProductInfo", w32_GetProductInfo, file);
1820     newXS("Win32::GetACP", w32_GetACP, file);
1821     newXS("Win32::GetConsoleCP", w32_GetConsoleCP, file);
1822     newXS("Win32::GetConsoleOutputCP", w32_GetConsoleOutputCP, file);
1823     newXS("Win32::GetOEMCP", w32_GetOEMCP, file);
1824     newXS("Win32::SetConsoleCP", w32_SetConsoleCP, file);
1825     newXS("Win32::SetConsoleOutputCP", w32_SetConsoleOutputCP, file);
1826 #ifdef __CYGWIN__
1827     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
1828 #endif
1829     XSRETURN_YES;
1830 }