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