ext/Win32/Win32.xs

   1 #include <windows.h>
   2
   3 #include "EXTERN.h"
   4 #include "perl.h"
   5 #include "XSUB.h"
   6
   7 #define SE_SHUTDOWN_NAMEA   "SeShutdownPrivilege"
   8
   9 typedef BOOL (WINAPI *PFNSHGetSpecialFolderPath)(HWND, char*, int, BOOL);
  10 typedef HRESULT (WINAPI *PFNSHGetFolderPath)(HWND, int, HANDLE, DWORD, LPTSTR);
  11 typedef int (__stdcall *PFNDllRegisterServer)(void);
  12 typedef int (__stdcall *PFNDllUnregisterServer)(void);
  13 #ifndef CSIDL_FLAG_CREATE
  14 #   define CSIDL_FLAG_CREATE               0x8000
  15 #endif
  16
  17 static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
  18
  19 #define ONE_K_BUFSIZE   1024
  20
  21 int
  22 IsWin95(void)
  23 {
  24     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
  25 }
  26
  27 int
  28 IsWinNT(void)
  29 {
  30     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
  31 }
  32
  33 XS(w32_ExpandEnvironmentStrings)
  34 {
  35     dXSARGS;
  36     BYTE buffer[4096];
  37
  38     if (items != 1)
  39         croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
  40
  41     ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), (char*)buffer, sizeof(buffer));
  42     XSRETURN_PV((char*)buffer);
  43 }
  44
  45 XS(w32_IsAdminUser)
  46 {
  47     dXSARGS;
  48     HINSTANCE                   hAdvApi32;
  49     BOOL (__stdcall *pfnOpenThreadToken)(HANDLE hThr, DWORD dwDesiredAccess,
  50                                 BOOL bOpenAsSelf, PHANDLE phTok);
  51     BOOL (__stdcall *pfnOpenProcessToken)(HANDLE hProc, DWORD dwDesiredAccess,
  52                                 PHANDLE phTok);
  53     BOOL (__stdcall *pfnGetTokenInformation)(HANDLE hTok,
  54                                 TOKEN_INFORMATION_CLASS TokenInformationClass,
  55                                 LPVOID lpTokInfo, DWORD dwTokInfoLen,
  56                                 PDWORD pdwRetLen);
  57     BOOL (__stdcall *pfnAllocateAndInitializeSid)(
  58                                 PSID_IDENTIFIER_AUTHORITY pIdAuth,
  59                                 BYTE nSubAuthCount, DWORD dwSubAuth0,
  60                                 DWORD dwSubAuth1, DWORD dwSubAuth2,
  61                                 DWORD dwSubAuth3, DWORD dwSubAuth4,
  62                                 DWORD dwSubAuth5, DWORD dwSubAuth6,
  63                                 DWORD dwSubAuth7, PSID pSid);
  64     BOOL (__stdcall *pfnEqualSid)(PSID pSid1, PSID pSid2);
  65     PVOID (__stdcall *pfnFreeSid)(PSID pSid);
  66     HANDLE                      hTok;
  67     DWORD                       dwTokInfoLen;
  68     TOKEN_GROUPS                *lpTokInfo;
  69     SID_IDENTIFIER_AUTHORITY    NtAuth = SECURITY_NT_AUTHORITY;
  70     PSID                        pAdminSid;
  71     int                         iRetVal;
  72     unsigned int                i;
  73     OSVERSIONINFO               osver;
  74
  75     if (items)
  76         croak("usage: Win32::IsAdminUser()");
  77
  78     /* There is no concept of "Administrator" user accounts on Win9x systems,
  79        so just return true. */
  80     memset(&osver, 0, sizeof(OSVERSIONINFO));
  81     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
  82     GetVersionEx(&osver);
  83     if (osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS)
  84         XSRETURN_YES;
  85
  86     hAdvApi32 = LoadLibrary("advapi32.dll");
  87     if (!hAdvApi32) {
  88         warn("Cannot load advapi32.dll library");
  89         XSRETURN_UNDEF;
  90     }
  91
  92     pfnOpenThreadToken = (BOOL (__stdcall *)(HANDLE, DWORD, BOOL, PHANDLE))
  93         GetProcAddress(hAdvApi32, "OpenThreadToken");
  94     pfnOpenProcessToken = (BOOL (__stdcall *)(HANDLE, DWORD, PHANDLE))
  95         GetProcAddress(hAdvApi32, "OpenProcessToken");
  96     pfnGetTokenInformation = (BOOL (__stdcall *)(HANDLE,
  97         TOKEN_INFORMATION_CLASS, LPVOID, DWORD, PDWORD))
  98         GetProcAddress(hAdvApi32, "GetTokenInformation");
  99     pfnAllocateAndInitializeSid = (BOOL (__stdcall *)(
 100         PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD, DWORD, DWORD, DWORD,
 101         DWORD, DWORD, DWORD, PSID))
 102         GetProcAddress(hAdvApi32, "AllocateAndInitializeSid");
 103     pfnEqualSid = (BOOL (__stdcall *)(PSID, PSID))
 104         GetProcAddress(hAdvApi32, "EqualSid");
 105     pfnFreeSid = (PVOID (__stdcall *)(PSID))
 106         GetProcAddress(hAdvApi32, "FreeSid");
 107
 108     if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
 109           pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
 110           pfnEqualSid && pfnFreeSid))
 111     {
 112         warn("Cannot load functions from advapi32.dll library");
 113         FreeLibrary(hAdvApi32);
 114         XSRETURN_UNDEF;
 115     }
 116
 117     if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
 118         if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
 119             warn("Cannot open thread token or process token");
 120             FreeLibrary(hAdvApi32);
 121             XSRETURN_UNDEF;
 122         }
 123     }
 124
 125     pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
 126     if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
 127         warn("Cannot allocate token information structure");
 128         CloseHandle(hTok);
 129         FreeLibrary(hAdvApi32);
 130         XSRETURN_UNDEF;
 131     }
 132
 133     if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
 134             &dwTokInfoLen))
 135     {
 136         warn("Cannot get token information");
 137         Safefree(lpTokInfo);
 138         CloseHandle(hTok);
 139         FreeLibrary(hAdvApi32);
 140         XSRETURN_UNDEF;
 141     }
 142
 143     if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
 144             DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))
 145     {
 146         warn("Cannot allocate administrators' SID");
 147         Safefree(lpTokInfo);
 148         CloseHandle(hTok);
 149         FreeLibrary(hAdvApi32);
 150         XSRETURN_UNDEF;
 151     }
 152
 153     iRetVal = 0;
 154     for (i = 0; i < lpTokInfo->GroupCount; ++i) {
 155         if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {
 156             iRetVal = 1;
 157             break;
 158         }
 159     }
 160
 161     pfnFreeSid(pAdminSid);
 162     Safefree(lpTokInfo);
 163     CloseHandle(hTok);
 164     FreeLibrary(hAdvApi32);
 165
 166     EXTEND(SP, 1);
 167     ST(0) = sv_2mortal(newSViv(iRetVal));
 168     XSRETURN(1);
 169 }
 170
 171 XS(w32_LookupAccountName)
 172 {
 173     dXSARGS;
 174     char SID[400];
 175     DWORD SIDLen;
 176     SID_NAME_USE snu;
 177     char Domain[256];
 178     DWORD DomLen;
 179     BOOL bResult;
 180
 181     if (items != 5)
 182         croak("usage: Win32::LookupAccountName($system, $account, $domain, "
 183               "$sid, $sidtype);\n");
 184
 185     SIDLen = sizeof(SID);
 186     DomLen = sizeof(Domain);
 187
 188     bResult = LookupAccountNameA(SvPV_nolen(ST(0)),     /* System */
 189                                  SvPV_nolen(ST(1)),     /* Account name */
 190                                  &SID,                  /* SID structure */
 191                                  &SIDLen,               /* Size of SID buffer */
 192                                  Domain,                /* Domain buffer */
 193                                  &DomLen,               /* Domain buffer size */
 194                                  &snu);                 /* SID name type */
 195     if (bResult) {
 196         sv_setpv(ST(2), Domain);
 197         sv_setpvn(ST(3), SID, SIDLen);
 198         sv_setiv(ST(4), snu);
 199         XSRETURN_YES;
 200     }
 201     XSRETURN_NO;
 202 }
 203
 204
 205 XS(w32_LookupAccountSID)
 206 {
 207     dXSARGS;
 208     PSID sid;
 209     char Account[256];
 210     DWORD AcctLen = sizeof(Account);
 211     char Domain[256];
 212     DWORD DomLen = sizeof(Domain);
 213     SID_NAME_USE snu;
 214     BOOL bResult;
 215
 216     if (items != 5)
 217         croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
 218
 219     sid = SvPV_nolen(ST(1));
 220     if (IsValidSid(sid)) {
 221         bResult = LookupAccountSidA(SvPV_nolen(ST(0)),  /* System */
 222                                     sid,                /* SID structure */
 223                                     Account,            /* Account name buffer */
 224                                     &AcctLen,           /* name buffer length */
 225                                     Domain,             /* Domain buffer */
 226                                     &DomLen,            /* Domain buffer length */
 227                                     &snu);              /* SID name type */
 228         if (bResult) {
 229             sv_setpv(ST(2), Account);
 230             sv_setpv(ST(3), Domain);
 231             sv_setiv(ST(4), (IV)snu);
 232             XSRETURN_YES;
 233         }
 234     }
 235     XSRETURN_NO;
 236 }
 237
 238 XS(w32_InitiateSystemShutdown)
 239 {
 240     dXSARGS;
 241     HANDLE hToken;              /* handle to process token   */
 242     TOKEN_PRIVILEGES tkp;       /* pointer to token structure  */
 243     BOOL bRet;
 244     char *machineName, *message;
 245
 246     if (items != 5)
 247         croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
 248               "$timeOut, $forceClose, $reboot);\n");
 249
 250     machineName = SvPV_nolen(ST(0));
 251
 252     if (OpenProcessToken(GetCurrentProcess(),
 253                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
 254                          &hToken))
 255     {
 256         LookupPrivilegeValueA(machineName,
 257                               SE_SHUTDOWN_NAMEA,
 258                               &tkp.Privileges[0].Luid);
 259
 260         tkp.PrivilegeCount = 1; /* only setting one */
 261         tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
 262
 263         /* Get shutdown privilege for this process. */
 264         AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 265                               (PTOKEN_PRIVILEGES)NULL, 0);
 266     }
 267
 268     message = SvPV_nolen(ST(1));
 269     bRet = InitiateSystemShutdownA(machineName, message,
 270                                    SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
 271
 272     /* Disable shutdown privilege. */
 273     tkp.Privileges[0].Attributes = 0;
 274     AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 275                           (PTOKEN_PRIVILEGES)NULL, 0);
 276     CloseHandle(hToken);
 277     XSRETURN_IV(bRet);
 278 }
 279
 280 XS(w32_AbortSystemShutdown)
 281 {
 282     dXSARGS;
 283     HANDLE hToken;              /* handle to process token   */
 284     TOKEN_PRIVILEGES tkp;       /* pointer to token structure  */
 285     BOOL bRet;
 286     char *machineName;
 287
 288     if (items != 1)
 289         croak("usage: Win32::AbortSystemShutdown($machineName);\n");
 290
 291     machineName = SvPV_nolen(ST(0));
 292
 293     if (OpenProcessToken(GetCurrentProcess(),
 294                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
 295                          &hToken))
 296     {
 297         LookupPrivilegeValueA(machineName,
 298                               SE_SHUTDOWN_NAMEA,
 299                               &tkp.Privileges[0].Luid);
 300
 301         tkp.PrivilegeCount = 1; /* only setting one */
 302         tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
 303
 304         /* Get shutdown privilege for this process. */
 305         AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 306                               (PTOKEN_PRIVILEGES)NULL, 0);
 307     }
 308
 309     bRet = AbortSystemShutdownA(machineName);
 310
 311     /* Disable shutdown privilege. */
 312     tkp.Privileges[0].Attributes = 0;
 313     AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 314                           (PTOKEN_PRIVILEGES)NULL, 0);
 315     CloseHandle(hToken);
 316     XSRETURN_IV(bRet);
 317 }
 318
 319
 320 XS(w32_MsgBox)
 321 {
 322     dXSARGS;
 323     char *msg;
 324     char *title = "Perl";
 325     DWORD flags = MB_ICONEXCLAMATION;
 326     I32 result;
 327
 328     if (items < 1 || items > 3)
 329         croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
 330
 331     msg = SvPV_nolen(ST(0));
 332     if (items > 1) {
 333         flags = SvIV(ST(1));
 334         if (items > 2)
 335             title = SvPV_nolen(ST(2));
 336     }
 337     result = MessageBoxA(GetActiveWindow(), msg, title, flags);
 338     XSRETURN_IV(result);
 339 }
 340
 341 XS(w32_LoadLibrary)
 342 {
 343     dXSARGS;
 344     HANDLE hHandle;
 345
 346     if (items != 1)
 347         croak("usage: Win32::LoadLibrary($libname)\n");
 348     hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
 349     XSRETURN_IV((long)hHandle);
 350 }
 351
 352 XS(w32_FreeLibrary)
 353 {
 354     dXSARGS;
 355
 356     if (items != 1)
 357         croak("usage: Win32::FreeLibrary($handle)\n");
 358     if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
 359         XSRETURN_YES;
 360     }
 361     XSRETURN_NO;
 362 }
 363
 364 XS(w32_GetProcAddress)
 365 {
 366     dXSARGS;
 367
 368     if (items != 2)
 369         croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
 370     XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
 371 }
 372
 373 XS(w32_RegisterServer)
 374 {
 375     dXSARGS;
 376     BOOL result = FALSE;
 377     HINSTANCE hnd;
 378
 379     if (items != 1)
 380         croak("usage: Win32::RegisterServer($libname)\n");
 381
 382     hnd = LoadLibraryA(SvPV_nolen(ST(0)));
 383     if (hnd) {
 384         PFNDllRegisterServer func;
 385         func = (PFNDllRegisterServer)GetProcAddress(hnd, "DllRegisterServer");
 386         if (func && func() == 0)
 387             result = TRUE;
 388         FreeLibrary(hnd);
 389     }
 390     ST(0) = boolSV(result);
 391     XSRETURN(1);
 392 }
 393
 394 XS(w32_UnregisterServer)
 395 {
 396     dXSARGS;
 397     BOOL result = FALSE;
 398     HINSTANCE hnd;
 399
 400     if (items != 1)
 401         croak("usage: Win32::UnregisterServer($libname)\n");
 402
 403     hnd = LoadLibraryA(SvPV_nolen(ST(0)));
 404     if (hnd) {
 405         PFNDllUnregisterServer func;
 406         func = (PFNDllUnregisterServer)GetProcAddress(hnd, "DllUnregisterServer");
 407         if (func && func() == 0)
 408             result = TRUE;
 409         FreeLibrary(hnd);
 410     }
 411     ST(0) = boolSV(result);
 412     XSRETURN(1);
 413 }
 414
 415 /* XXX rather bogus */
 416 XS(w32_GetArchName)
 417 {
 418     dXSARGS;
 419     XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
 420 }
 421
 422 XS(w32_GetChipName)
 423 {
 424     dXSARGS;
 425     SYSTEM_INFO sysinfo;
 426
 427     Zero(&sysinfo,1,SYSTEM_INFO);
 428     GetSystemInfo(&sysinfo);
 429     /* XXX docs say dwProcessorType is deprecated on NT */
 430     XSRETURN_IV(sysinfo.dwProcessorType);
 431 }
 432
 433 XS(w32_GuidGen)
 434 {
 435     dXSARGS;
 436     GUID guid;
 437     char szGUID[50] = {'\0'};
 438     HRESULT  hr     = CoCreateGuid(&guid);
 439
 440     if (SUCCEEDED(hr)) {
 441         LPOLESTR pStr = NULL;
 442         if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
 443             WideCharToMultiByte(CP_ACP, 0, pStr, wcslen(pStr), szGUID,
 444                                 sizeof(szGUID), NULL, NULL);
 445             CoTaskMemFree(pStr);
 446             XSRETURN_PV(szGUID);
 447         }
 448     }
 449     XSRETURN_UNDEF;
 450 }
 451
 452 XS(w32_GetFolderPath)
 453 {
 454     dXSARGS;
 455     char path[MAX_PATH+1];
 456     int folder;
 457     int create = 0;
 458     HMODULE module;
 459
 460     if (items != 1 && items != 2)
 461         croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
 462
 463     folder = SvIV(ST(0));
 464     if (items == 2)
 465         create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
 466
 467     module = LoadLibrary("shfolder.dll");
 468     if (module) {
 469         PFNSHGetFolderPath pfn;
 470         pfn = (PFNSHGetFolderPath)GetProcAddress(module, "SHGetFolderPathA");
 471         if (pfn && SUCCEEDED(pfn(NULL, folder|create, NULL, 0, path))) {
 472             FreeLibrary(module);
 473             XSRETURN_PV(path);
 474         }
 475         FreeLibrary(module);
 476     }
 477
 478     module = LoadLibrary("shell32.dll");
 479     if (module) {
 480         PFNSHGetSpecialFolderPath pfn;
 481         pfn = (PFNSHGetSpecialFolderPath)
 482             GetProcAddress(module, "SHGetSpecialFolderPathA");
 483         if (pfn && pfn(NULL, path, folder, !!create)) {
 484             FreeLibrary(module);
 485             XSRETURN_PV(path);
 486         }
 487         FreeLibrary(module);
 488     }
 489     XSRETURN_UNDEF;
 490 }
 491
 492 XS(w32_GetFileVersion)
 493 {
 494     dXSARGS;
 495     DWORD size;
 496     DWORD handle;
 497     char *filename;
 498     char *data;
 499
 500     if (items != 1)
 501         croak("usage: Win32::GetFileVersion($filename)\n");
 502
 503     filename = SvPV_nolen(ST(0));
 504     size = GetFileVersionInfoSize(filename, &handle);
 505     if (!size)
 506         XSRETURN_UNDEF;
 507
 508     New(0, data, size, char);
 509     if (!data)
 510         XSRETURN_UNDEF;
 511
 512     if (GetFileVersionInfo(filename, handle, size, data)) {
 513         VS_FIXEDFILEINFO *info;
 514         UINT len;
 515         if (VerQueryValue(data, "\\", (void**)&info, &len)) {
 516             int dwValueMS1 = (info->dwFileVersionMS>>16);
 517             int dwValueMS2 = (info->dwFileVersionMS&0xffff);
 518             int dwValueLS1 = (info->dwFileVersionLS>>16);
 519             int dwValueLS2 = (info->dwFileVersionLS&0xffff);
 520
 521             if (GIMME_V == G_ARRAY) {
 522                 EXTEND(SP, 4);
 523                 XST_mIV(0, dwValueMS1);
 524                 XST_mIV(1, dwValueMS2);
 525                 XST_mIV(2, dwValueLS1);
 526                 XST_mIV(3, dwValueLS2);
 527                 items = 4;
 528             }
 529             else {
 530                 char version[50];
 531                 sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
 532                 XST_mPV(0, version);
 533             }
 534         }
 535     }
 536     else
 537         items = 0;
 538
 539     Safefree(data);
 540     XSRETURN(items);
 541 }
 542
 543 /*
 544  * Extras.
 545  */
 546
 547 static
 548 XS(w32_SetChildShowWindow)
 549 {
 550     dXSARGS;
 551     BOOL use_showwindow = w32_use_showwindow;
 552     /* use "unsigned short" because Perl has redefined "WORD" */
 553     unsigned short showwindow = w32_showwindow;
 554
 555     if (items > 1)
 556         Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)");
 557
 558     if (items == 0 || !SvOK(ST(0)))
 559         w32_use_showwindow = FALSE;
 560     else {
 561         w32_use_showwindow = TRUE;
 562         w32_showwindow = (unsigned short)SvIV(ST(0));
 563     }
 564
 565     EXTEND(SP, 1);
 566     if (use_showwindow)
 567         ST(0) = sv_2mortal(newSViv(showwindow));
 568     else
 569         ST(0) = &PL_sv_undef;
 570     XSRETURN(1);
 571 }
 572
 573 static
 574 XS(w32_GetCwd)
 575 {
 576     dXSARGS;
 577     /* Make the host for current directory */
 578     char* ptr = PerlEnv_get_childdir();
 579     /*
 580      * If ptr != Nullch
 581      *   then it worked, set PV valid,
 582      *   else return 'undef'
 583      */
 584     if (ptr) {
 585         SV *sv = sv_newmortal();
 586         sv_setpv(sv, ptr);
 587         PerlEnv_free_childdir(ptr);
 588
 589 #ifndef INCOMPLETE_TAINTS
 590         SvTAINTED_on(sv);
 591 #endif
 592
 593         EXTEND(SP,1);
 594         SvPOK_on(sv);
 595         ST(0) = sv;
 596         XSRETURN(1);
 597     }
 598     XSRETURN_UNDEF;
 599 }
 600
 601 static
 602 XS(w32_SetCwd)
 603 {
 604     dXSARGS;
 605     if (items != 1)
 606         Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
 607     if (!PerlDir_chdir(SvPV_nolen(ST(0))))
 608         XSRETURN_YES;
 609
 610     XSRETURN_NO;
 611 }
 612
 613 static
 614 XS(w32_GetNextAvailDrive)
 615 {
 616     dXSARGS;
 617     char ix = 'C';
 618     char root[] = "_:\\";
 619
 620     EXTEND(SP,1);
 621     while (ix <= 'Z') {
 622         root[0] = ix++;
 623         if (GetDriveType(root) == 1) {
 624             root[2] = '\0';
 625             XSRETURN_PV(root);
 626         }
 627     }
 628     XSRETURN_UNDEF;
 629 }
 630
 631 static
 632 XS(w32_GetLastError)
 633 {
 634     dXSARGS;
 635     EXTEND(SP,1);
 636     XSRETURN_IV(GetLastError());
 637 }
 638
 639 static
 640 XS(w32_SetLastError)
 641 {
 642     dXSARGS;
 643     if (items != 1)
 644         Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
 645     SetLastError(SvIV(ST(0)));
 646     XSRETURN_EMPTY;
 647 }
 648
 649 static
 650 XS(w32_LoginName)
 651 {
 652     dXSARGS;
 653     char *name = w32_getlogin_buffer;
 654     DWORD size = sizeof(w32_getlogin_buffer);
 655     EXTEND(SP,1);
 656     if (GetUserName(name,&size)) {
 657         /* size includes NULL */
 658         ST(0) = sv_2mortal(newSVpvn(name,size-1));
 659         XSRETURN(1);
 660     }
 661     XSRETURN_UNDEF;
 662 }
 663
 664 static
 665 XS(w32_NodeName)
 666 {
 667     dXSARGS;
 668     char name[MAX_COMPUTERNAME_LENGTH+1];
 669     DWORD size = sizeof(name);
 670     EXTEND(SP,1);
 671     if (GetComputerName(name,&size)) {
 672         /* size does NOT include NULL :-( */
 673         ST(0) = sv_2mortal(newSVpvn(name,size));
 674         XSRETURN(1);
 675     }
 676     XSRETURN_UNDEF;
 677 }
 678
 679
 680 static
 681 XS(w32_DomainName)
 682 {
 683     dXSARGS;
 684     HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
 685     DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
 686     DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
 687                                           void *bufptr);
 688
 689     if (hNetApi32) {
 690         pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
 691             GetProcAddress(hNetApi32, "NetApiBufferFree");
 692         pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
 693             GetProcAddress(hNetApi32, "NetWkstaGetInfo");
 694     }
 695     EXTEND(SP,1);
 696     if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
 697         /* this way is more reliable, in case user has a local account. */
 698         char dname[256];
 699         DWORD dnamelen = sizeof(dname);
 700         struct {
 701             DWORD   wki100_platform_id;
 702             LPWSTR  wki100_computername;
 703             LPWSTR  wki100_langroup;
 704             DWORD   wki100_ver_major;
 705             DWORD   wki100_ver_minor;
 706         } *pwi;
 707         /* NERR_Success *is* 0*/
 708         if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
 709             if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
 710                 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
 711                                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
 712             }
 713             else {
 714                 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
 715                                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
 716             }
 717             pfnNetApiBufferFree(pwi);
 718             FreeLibrary(hNetApi32);
 719             XSRETURN_PV(dname);
 720         }
 721         FreeLibrary(hNetApi32);
 722     }
 723     else {
 724         /* Win95 doesn't have NetWksta*(), so do it the old way */
 725         char name[256];
 726         DWORD size = sizeof(name);
 727         if (hNetApi32)
 728             FreeLibrary(hNetApi32);
 729         if (GetUserName(name,&size)) {
 730             char sid[ONE_K_BUFSIZE];
 731             DWORD sidlen = sizeof(sid);
 732             char dname[256];
 733             DWORD dnamelen = sizeof(dname);
 734             SID_NAME_USE snu;
 735             if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
 736                                   dname, &dnamelen, &snu)) {
 737                 XSRETURN_PV(dname);             /* all that for this */
 738             }
 739         }
 740     }
 741     XSRETURN_UNDEF;
 742 }
 743
 744 static
 745 XS(w32_FsType)
 746 {
 747     dXSARGS;
 748     char fsname[256];
 749     DWORD flags, filecomplen;
 750     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
 751                          &flags, fsname, sizeof(fsname))) {
 752         if (GIMME_V == G_ARRAY) {
 753             XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
 754             XPUSHs(sv_2mortal(newSViv(flags)));
 755             XPUSHs(sv_2mortal(newSViv(filecomplen)));
 756             PUTBACK;
 757             return;
 758         }
 759         EXTEND(SP,1);
 760         XSRETURN_PV(fsname);
 761     }
 762     XSRETURN_EMPTY;
 763 }
 764
 765 static
 766 XS(w32_GetOSVersion)
 767 {
 768     dXSARGS;
 769     /* Use explicit struct definition because wSuiteMask and
 770      * wProductType are not defined in the VC++ 6.0 headers.
 771      * WORD type has been replaced by unsigned short because
 772      * WORD is already used by Perl itself.
 773      */
 774     struct {
 775         DWORD dwOSVersionInfoSize;
 776         DWORD dwMajorVersion;
 777         DWORD dwMinorVersion;
 778         DWORD dwBuildNumber;
 779         DWORD dwPlatformId;
 780         CHAR  szCSDVersion[128];
 781         unsigned short wServicePackMajor;
 782         unsigned short wServicePackMinor;
 783         unsigned short wSuiteMask;
 784         BYTE  wProductType;
 785         BYTE  wReserved;
 786     }   osver;
 787     BOOL bEx = TRUE;
 788
 789     osver.dwOSVersionInfoSize = sizeof(osver);
 790     if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
 791         bEx = FALSE;
 792         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
 793         if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
 794             XSRETURN_EMPTY;
 795         }
 796     }
 797     if (GIMME_V == G_SCALAR) {
 798         XSRETURN_IV(osver.dwPlatformId);
 799     }
 800     XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
 801
 802     XPUSHs(newSViv(osver.dwMajorVersion));
 803     XPUSHs(newSViv(osver.dwMinorVersion));
 804     XPUSHs(newSViv(osver.dwBuildNumber));
 805     XPUSHs(newSViv(osver.dwPlatformId));
 806     if (bEx) {
 807         XPUSHs(newSViv(osver.wServicePackMajor));
 808         XPUSHs(newSViv(osver.wServicePackMinor));
 809         XPUSHs(newSViv(osver.wSuiteMask));
 810         XPUSHs(newSViv(osver.wProductType));
 811     }
 812     PUTBACK;
 813 }
 814
 815 static
 816 XS(w32_IsWinNT)
 817 {
 818     dXSARGS;
 819     EXTEND(SP,1);
 820     XSRETURN_IV(IsWinNT());
 821 }
 822
 823 static
 824 XS(w32_IsWin95)
 825 {
 826     dXSARGS;
 827     EXTEND(SP,1);
 828     XSRETURN_IV(IsWin95());
 829 }
 830
 831 static
 832 XS(w32_FormatMessage)
 833 {
 834     dXSARGS;
 835     DWORD source = 0;
 836     char msgbuf[ONE_K_BUFSIZE];
 837
 838     if (items != 1)
 839         Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
 840
 841     if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
 842                        &source, SvIV(ST(0)), 0,
 843                        msgbuf, sizeof(msgbuf)-1, NULL))
 844     {
 845         XSRETURN_PV(msgbuf);
 846     }
 847
 848     XSRETURN_UNDEF;
 849 }
 850
 851 static
 852 XS(w32_Spawn)
 853 {
 854     dXSARGS;
 855     char *cmd, *args;
 856     void *env;
 857     char *dir;
 858     PROCESS_INFORMATION stProcInfo;
 859     STARTUPINFO stStartInfo;
 860     BOOL bSuccess = FALSE;
 861
 862     if (items != 3)
 863         Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
 864
 865     cmd = SvPV_nolen(ST(0));
 866     args = SvPV_nolen(ST(1));
 867
 868     env = PerlEnv_get_childenv();
 869     dir = PerlEnv_get_childdir();
 870
 871     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
 872     stStartInfo.cb = sizeof(stStartInfo);           /* Set the structure size */
 873     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;     /* Enable wShowWindow control */
 874     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
 875
 876     if (CreateProcess(
 877                 cmd,                    /* Image path */
 878                 args,                   /* Arguments for command line */
 879                 NULL,                   /* Default process security */
 880                 NULL,                   /* Default thread security */
 881                 FALSE,                  /* Must be TRUE to use std handles */
 882                 NORMAL_PRIORITY_CLASS,  /* No special scheduling */
 883                 env,                    /* Inherit our environment block */
 884                 dir,                    /* Inherit our currrent directory */
 885                 &stStartInfo,           /* -> Startup info */
 886                 &stProcInfo))           /* <- Process info (if OK) */
 887     {
 888         int pid = (int)stProcInfo.dwProcessId;
 889         if (IsWin95() && pid < 0)
 890             pid = -pid;
 891         sv_setiv(ST(2), pid);
 892         CloseHandle(stProcInfo.hThread);/* library source code does this. */
 893         bSuccess = TRUE;
 894     }
 895     PerlEnv_free_childenv(env);
 896     PerlEnv_free_childdir(dir);
 897     XSRETURN_IV(bSuccess);
 898 }
 899
 900 static
 901 XS(w32_GetTickCount)
 902 {
 903     dXSARGS;
 904     DWORD msec = GetTickCount();
 905     EXTEND(SP,1);
 906     if ((IV)msec > 0)
 907         XSRETURN_IV(msec);
 908     XSRETURN_NV(msec);
 909 }
 910
 911 static
 912 XS(w32_GetShortPathName)
 913 {
 914     dXSARGS;
 915     SV *shortpath;
 916     DWORD len;
 917
 918     if (items != 1)
 919         Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
 920
 921     shortpath = sv_mortalcopy(ST(0));
 922     SvUPGRADE(shortpath, SVt_PV);
 923     if (!SvPVX(shortpath) || !SvLEN(shortpath))
 924         XSRETURN_UNDEF;
 925
 926     /* src == target is allowed */
 927     do {
 928         len = GetShortPathName(SvPVX(shortpath),
 929                                SvPVX(shortpath),
 930                                SvLEN(shortpath));
 931     } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
 932     if (len) {
 933         SvCUR_set(shortpath,len);
 934         *SvEND(shortpath) = '\0';
 935         ST(0) = shortpath;
 936         XSRETURN(1);
 937     }
 938     XSRETURN_UNDEF;
 939 }
 940
 941 static
 942 XS(w32_GetFullPathName)
 943 {
 944     dXSARGS;
 945     SV *filename;
 946     SV *fullpath;
 947     char *filepart;
 948     DWORD len;
 949     STRLEN filename_len;
 950     char *filename_p;
 951
 952     if (items != 1)
 953         Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
 954
 955     filename = ST(0);
 956     filename_p = SvPV(filename, filename_len);
 957     fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
 958     if (!SvPVX(fullpath) || !SvLEN(fullpath))
 959         XSRETURN_UNDEF;
 960
 961     do {
 962         len = GetFullPathName(SvPVX(filename),
 963                               SvLEN(fullpath),
 964                               SvPVX(fullpath),
 965                               &filepart);
 966     } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
 967     if (len) {
 968         if (GIMME_V == G_ARRAY) {
 969             EXTEND(SP,1);
 970             if (filepart) {
 971                 XST_mPV(1,filepart);
 972                 len = filepart - SvPVX(fullpath);
 973             }
 974             else {
 975                 XST_mPVN(1,"",0);
 976             }
 977             items = 2;
 978         }
 979         SvCUR_set(fullpath,len);
 980         *SvEND(fullpath) = '\0';
 981         ST(0) = fullpath;
 982         XSRETURN(items);
 983     }
 984     XSRETURN_EMPTY;
 985 }
 986
 987 static
 988 XS(w32_GetLongPathName)
 989 {
 990     dXSARGS;
 991     SV *path;
 992     char tmpbuf[MAX_PATH+1];
 993     char *pathstr;
 994     STRLEN len;
 995
 996     if (items != 1)
 997         Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
 998
 999     path = ST(0);
1000     pathstr = SvPV(path,len);
1001     strcpy(tmpbuf, pathstr);
1002     pathstr = win32_longpath(tmpbuf);
1003     if (pathstr) {
1004         ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
1005         XSRETURN(1);
1006     }
1007     XSRETURN_EMPTY;
1008 }
1009
1010 static
1011 XS(w32_Sleep)
1012 {
1013     dXSARGS;
1014     if (items != 1)
1015         Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
1016     Sleep(SvIV(ST(0)));
1017     XSRETURN_YES;
1018 }
1019
1020 static
1021 XS(w32_CopyFile)
1022 {
1023     dXSARGS;
1024     BOOL bResult;
1025     char szSourceFile[MAX_PATH+1];
1026
1027     if (items != 3)
1028         Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
1029     strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
1030     bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
1031     if (bResult)
1032         XSRETURN_YES;
1033     XSRETURN_NO;
1034 }
1035
1036 XS(boot_Win32)
1037 {
1038     dXSARGS;
1039     char *file = __FILE__;
1040
1041     if (g_osver.dwOSVersionInfoSize == 0) {
1042         g_osver.dwOSVersionInfoSize = sizeof(g_osver);
1043         GetVersionEx(&g_osver);
1044     }
1045
1046     newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
1047     newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
1048     newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);
1049     newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file);
1050     newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file);
1051     newXS("Win32::MsgBox", w32_MsgBox, file);
1052     newXS("Win32::LoadLibrary", w32_LoadLibrary, file);
1053     newXS("Win32::FreeLibrary", w32_FreeLibrary, file);
1054     newXS("Win32::GetProcAddress", w32_GetProcAddress, file);
1055     newXS("Win32::RegisterServer", w32_RegisterServer, file);
1056     newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
1057     newXS("Win32::GetArchName", w32_GetArchName, file);
1058     newXS("Win32::GetChipName", w32_GetChipName, file);
1059     newXS("Win32::GuidGen", w32_GuidGen, file);
1060     newXS("Win32::GetFolderPath", w32_GetFolderPath, file);
1061     newXS("Win32::IsAdminUser", w32_IsAdminUser, file);
1062     newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
1063
1064     newXS("Win32::GetCwd", w32_GetCwd, file);
1065     newXS("Win32::SetCwd", w32_SetCwd, file);
1066     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
1067     newXS("Win32::GetLastError", w32_GetLastError, file);
1068     newXS("Win32::SetLastError", w32_SetLastError, file);
1069     newXS("Win32::LoginName", w32_LoginName, file);
1070     newXS("Win32::NodeName", w32_NodeName, file);
1071     newXS("Win32::DomainName", w32_DomainName, file);
1072     newXS("Win32::FsType", w32_FsType, file);
1073     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
1074     newXS("Win32::IsWinNT", w32_IsWinNT, file);
1075     newXS("Win32::IsWin95", w32_IsWin95, file);
1076     newXS("Win32::FormatMessage", w32_FormatMessage, file);
1077     newXS("Win32::Spawn", w32_Spawn, file);
1078     newXS("Win32::GetTickCount", w32_GetTickCount, file);
1079     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
1080     newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
1081     newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
1082     newXS("Win32::CopyFile", w32_CopyFile, file);
1083     newXS("Win32::Sleep", w32_Sleep, file);
1084     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
1085
1086     XSRETURN_YES;
1087 }