cpan/Win32/Win32.xs

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