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