projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Update IPC::Cmd to cpan version 0.54
[p5sagit/p5-mst-13.2.git] / cpan / Win32 / Win32.xs
CommitLineData
8883bb5a 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
22typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathA)(HWND, char*, int, BOOL);\r
23typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathW)(HWND, WCHAR*, int, BOOL);\r
24typedef HRESULT (WINAPI *PFNSHGetFolderPathA)(HWND, int, HANDLE, DWORD, LPTSTR);\r
25typedef HRESULT (WINAPI *PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR);\r
26typedef BOOL (WINAPI *PFNCreateEnvironmentBlock)(void**, HANDLE, BOOL);\r
27typedef BOOL (WINAPI *PFNDestroyEnvironmentBlock)(void*);\r
28typedef int (__stdcall *PFNDllRegisterServer)(void);\r
29typedef int (__stdcall *PFNDllUnregisterServer)(void);\r
30typedef DWORD (__stdcall *PFNNetApiBufferFree)(void*);\r
31typedef DWORD (__stdcall *PFNNetWkstaGetInfo)(LPWSTR, DWORD, void*);\r
32\r
33typedef BOOL (__stdcall *PFNOpenProcessToken)(HANDLE, DWORD, HANDLE*);\r
34typedef BOOL (__stdcall *PFNOpenThreadToken)(HANDLE, DWORD, BOOL, HANDLE*);\r
35typedef BOOL (__stdcall *PFNGetTokenInformation)(HANDLE, TOKEN_INFORMATION_CLASS, void*, DWORD, DWORD*);\r
36typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD,\r
37 DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*);\r
38typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);\r
39typedef void* (__stdcall *PFNFreeSid)(PSID);\r
40typedef 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
114struct {\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
127BOOL g_osver_ex = TRUE;\r
128\r
129#define ONE_K_BUFSIZE 1024\r
130\r
131int\r
132IsWin95(void)\r
133{\r
134 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);\r
135}\r
136\r
137int\r
138IsWinNT(void)\r
139{\r
140 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);\r
141}\r
142\r
143int\r
144IsWin2000(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
152WCHAR*\r
153sv_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
171SV *\r
172wstr_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
200SV*\r
201get_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
300char *\r
301my_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
330SV*\r
331wstr_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
341char*\r
342get_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
361void\r
362free_childdir(char *d)\r
363{\r
364 dTHX;\r
365 Safefree(d);\r
366}\r
367\r
368void*\r
369get_childenv(void)\r
370{\r
371 return NULL;\r
372}\r
373\r
374void\r
375free_childenv(void *d)\r
376{\r
377}\r
378\r
379# define PerlDir_mapA(dir) (dir)\r
380\r
381#endif\r
382\r
383XS(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
405XS(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
524XS(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
558XS(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
591XS(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
633XS(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
673XS(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
705XS(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
720XS(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
732XS(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
741XS(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
762XS(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
784XS(w32_GetArchName)\r
785{\r
786 dXSARGS;\r
787 XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));\r
788}\r
789\r
790XS(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
801XS(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
820XS(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
976XS(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
1028XS(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
1041XS(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
1067XS(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
1090XS(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
1107XS(w32_GetLastError)\r
1108{\r
1109 dXSARGS;\r
1110 EXTEND(SP,1);\r
1111 XSRETURN_IV(GetLastError());\r
1112}\r
1113\r
1114XS(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
1123XS(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
1147XS(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
1162XS(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
1225XS(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
1245XS(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
1267XS(w32_IsWinNT)\r
1268{\r
1269 dXSARGS;\r
1270 EXTEND(SP,1);\r
1271 XSRETURN_IV(IsWinNT());\r
1272}\r
1273\r
1274XS(w32_IsWin95)\r
1275{\r
1276 dXSARGS;\r
1277 EXTEND(SP,1);\r
1278 XSRETURN_IV(IsWin95());\r
1279}\r
1280\r
1281XS(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
1300XS(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
1348XS(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
1358XS(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
1399XS(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
1500XS(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
1538XS(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
1552XS(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
1561XS(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
1576XS(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
1593XS(w32_GetCurrentProcessId)\r
1594{\r
1595 dXSARGS;\r
1596 EXTEND(SP,1);\r
1597 XSRETURN_IV(GetCurrentProcessId());\r
1598}\r
1599\r
1600XS(w32_GetCurrentThreadId)\r
1601{\r
1602 dXSARGS;\r
1603 EXTEND(SP,1);\r
1604 XSRETURN_IV(GetCurrentThreadId());\r
1605}\r
1606\r
1607XS(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
1628XS(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
1654MODULE = Win32 PACKAGE = Win32\r
1655\r
1656PROTOTYPES: DISABLE\r
1657\r
1658BOOT:\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
Unnamed repository; edit this file to name it for gitweb.