cpan/Win32/Win32.xs

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