Updated perldiag.pod entry for "Can't use subscript..."
[p5sagit/p5-mst-13.2.git] / win32 / 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"
8#define SE_SHUTDOWN_NAMEW L"SeShutdownPrivilege"
9
10typedef BOOL (WINAPI *PFNSHGetSpecialFolderPath)(HWND, char*, int, BOOL);
11typedef HRESULT (WINAPI *PFNSHGetFolderPath)(HWND, int, HANDLE, DWORD, LPTSTR);
12#ifndef CSIDL_FLAG_CREATE
13# define CSIDL_FLAG_CREATE 0x8000
14#endif
15
16XS(w32_ExpandEnvironmentStrings)
17{
18 dXSARGS;
19 char *lpSource;
20 BYTE buffer[4096];
21 DWORD dwDataLen;
22 STRLEN n_a;
23
24 if (items != 1)
25 croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
26
27 lpSource = (char *)SvPV(ST(0), n_a);
28
29 if (USING_WIDE()) {
30 WCHAR wSource[MAX_PATH+1];
31 WCHAR wbuffer[4096];
32 A2WHELPER(lpSource, wSource, sizeof(wSource));
33 dwDataLen = ExpandEnvironmentStringsW(wSource, wbuffer, sizeof(wbuffer)/2);
34 W2AHELPER(wbuffer, buffer, sizeof(buffer));
35 }
36 else
37 dwDataLen = ExpandEnvironmentStringsA(lpSource, (char*)buffer, sizeof(buffer));
38
39 XSRETURN_PV((char*)buffer);
40}
41
42XS(w32_IsAdminUser)
43{
44 dXSARGS;
45 HINSTANCE hAdvApi32;
46 BOOL (__stdcall *pfnOpenThreadToken)(HANDLE hThr, DWORD dwDesiredAccess,
47 BOOL bOpenAsSelf, PHANDLE phTok);
48 BOOL (__stdcall *pfnOpenProcessToken)(HANDLE hProc, DWORD dwDesiredAccess,
49 PHANDLE phTok);
50 BOOL (__stdcall *pfnGetTokenInformation)(HANDLE hTok,
51 TOKEN_INFORMATION_CLASS TokenInformationClass,
52 LPVOID lpTokInfo, DWORD dwTokInfoLen,
53 PDWORD pdwRetLen);
54 BOOL (__stdcall *pfnAllocateAndInitializeSid)(
55 PSID_IDENTIFIER_AUTHORITY pIdAuth,
56 BYTE nSubAuthCount, DWORD dwSubAuth0,
57 DWORD dwSubAuth1, DWORD dwSubAuth2,
58 DWORD dwSubAuth3, DWORD dwSubAuth4,
59 DWORD dwSubAuth5, DWORD dwSubAuth6,
60 DWORD dwSubAuth7, PSID pSid);
61 BOOL (__stdcall *pfnEqualSid)(PSID pSid1, PSID pSid2);
62 PVOID (__stdcall *pfnFreeSid)(PSID pSid);
63 HANDLE hTok;
64 DWORD dwTokInfoLen;
65 TOKEN_GROUPS *lpTokInfo;
66 SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY;
67 PSID pAdminSid;
68 int iRetVal;
69 unsigned int i;
70 OSVERSIONINFO osver;
71
72 if (items)
73 croak("usage: Win32::IsAdminUser()");
74
75 /* There is no concept of "Administrator" user accounts on Win9x systems,
76 so just return true. */
77 memset(&osver, 0, sizeof(OSVERSIONINFO));
78 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
79 GetVersionEx(&osver);
80 if (osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS)
81 XSRETURN_YES;
82
83 hAdvApi32 = LoadLibrary("advapi32.dll");
84 if (!hAdvApi32) {
85 warn("Cannot load advapi32.dll library");
86 XSRETURN_UNDEF;
87 }
88
89 pfnOpenThreadToken = (BOOL (__stdcall *)(HANDLE, DWORD, BOOL, PHANDLE))
90 GetProcAddress(hAdvApi32, "OpenThreadToken");
91 pfnOpenProcessToken = (BOOL (__stdcall *)(HANDLE, DWORD, PHANDLE))
92 GetProcAddress(hAdvApi32, "OpenProcessToken");
93 pfnGetTokenInformation = (BOOL (__stdcall *)(HANDLE,
94 TOKEN_INFORMATION_CLASS, LPVOID, DWORD, PDWORD))
95 GetProcAddress(hAdvApi32, "GetTokenInformation");
96 pfnAllocateAndInitializeSid = (BOOL (__stdcall *)(
97 PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD, DWORD, DWORD, DWORD,
98 DWORD, DWORD, DWORD, PSID))
99 GetProcAddress(hAdvApi32, "AllocateAndInitializeSid");
100 pfnEqualSid = (BOOL (__stdcall *)(PSID, PSID))
101 GetProcAddress(hAdvApi32, "EqualSid");
102 pfnFreeSid = (PVOID (__stdcall *)(PSID))
103 GetProcAddress(hAdvApi32, "FreeSid");
104
105 if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
106 pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
107 pfnEqualSid && pfnFreeSid))
108 {
109 warn("Cannot load functions from advapi32.dll library");
110 FreeLibrary(hAdvApi32);
111 XSRETURN_UNDEF;
112 }
113
114 if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
115 if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
116 warn("Cannot open thread token or process token");
117 FreeLibrary(hAdvApi32);
118 XSRETURN_UNDEF;
119 }
120 }
121
122 pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
123 if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
124 warn("Cannot allocate token information structure");
125 CloseHandle(hTok);
126 FreeLibrary(hAdvApi32);
127 XSRETURN_UNDEF;
128 }
129
130 if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
131 &dwTokInfoLen))
132 {
133 warn("Cannot get token information");
134 Safefree(lpTokInfo);
135 CloseHandle(hTok);
136 FreeLibrary(hAdvApi32);
137 XSRETURN_UNDEF;
138 }
139
140 if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
141 DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))
142 {
143 warn("Cannot allocate administrators' SID");
144 Safefree(lpTokInfo);
145 CloseHandle(hTok);
146 FreeLibrary(hAdvApi32);
147 XSRETURN_UNDEF;
148 }
149
150 iRetVal = 0;
151 for (i = 0; i < lpTokInfo->GroupCount; ++i) {
152 if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {
153 iRetVal = 1;
154 break;
155 }
156 }
157
158 pfnFreeSid(pAdminSid);
159 Safefree(lpTokInfo);
160 CloseHandle(hTok);
161 FreeLibrary(hAdvApi32);
162
163 EXTEND(SP, 1);
164 ST(0) = sv_2mortal(newSViv(iRetVal));
165 XSRETURN(1);
166}
167
168XS(w32_LookupAccountName)
169{
170 dXSARGS;
171 char SID[400];
172 DWORD SIDLen;
173 SID_NAME_USE snu;
174 char Domain[256];
175 DWORD DomLen;
176 STRLEN n_a;
177 BOOL bResult;
178
179 if (items != 5)
180 croak("usage: Win32::LookupAccountName($system, $account, $domain, "
181 "$sid, $sidtype);\n");
182
183 SIDLen = sizeof(SID);
184 DomLen = sizeof(Domain);
185
186 if (USING_WIDE()) {
187 WCHAR wSID[sizeof(SID)];
188 WCHAR wDomain[sizeof(Domain)];
189 WCHAR wSystem[MAX_PATH+1];
190 WCHAR wAccount[MAX_PATH+1];
191 A2WHELPER(SvPV(ST(0),n_a), wSystem, sizeof(wSystem));
192 A2WHELPER(SvPV(ST(1),n_a), wAccount, sizeof(wAccount));
193 bResult = LookupAccountNameW(wSystem, /* System */
194 wAccount, /* Account name */
195 &wSID, /* SID structure */
196 &SIDLen, /* Size of SID buffer */
197 wDomain, /* Domain buffer */
198 &DomLen, /* Domain buffer size */
199 &snu); /* SID name type */
200 if (bResult) {
201 W2AHELPER(wSID, SID, SIDLen);
202 W2AHELPER(wDomain, Domain, DomLen);
203 }
204 }
205 else
206 bResult = LookupAccountNameA(SvPV(ST(0),n_a), /* System */
207 SvPV(ST(1),n_a), /* Account name */
208 &SID, /* SID structure */
209 &SIDLen, /* Size of SID buffer */
210 Domain, /* Domain buffer */
211 &DomLen, /* Domain buffer size */
212 &snu); /* SID name type */
213 if (bResult) {
214 sv_setpv(ST(2), Domain);
215 sv_setpvn(ST(3), SID, SIDLen);
216 sv_setiv(ST(4), snu);
217 XSRETURN_YES;
218 }
219 else {
220 GetLastError();
221 XSRETURN_NO;
222 }
223} /* NTLookupAccountName */
224
225
226XS(w32_LookupAccountSID)
227{
228 dXSARGS;
229 PSID sid;
230 char Account[256];
231 DWORD AcctLen = sizeof(Account);
232 char Domain[256];
233 DWORD DomLen = sizeof(Domain);
234 SID_NAME_USE snu;
b4ad57f4 235 STRLEN n_a;
236 BOOL bResult;
237
238 if (items != 5)
239 croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
240
241 sid = SvPV(ST(1), n_a);
242 if (IsValidSid(sid)) {
243 if (USING_WIDE()) {
b4ad57f4 244 WCHAR wDomain[sizeof(Domain)];
245 WCHAR wSystem[MAX_PATH+1];
246 WCHAR wAccount[sizeof(Account)];
247 A2WHELPER(SvPV(ST(0),n_a), wSystem, sizeof(wSystem));
248
249 bResult = LookupAccountSidW(wSystem, /* System */
250 sid, /* SID structure */
251 wAccount, /* Account name buffer */
252 &AcctLen, /* name buffer length */
253 wDomain, /* Domain buffer */
254 &DomLen, /* Domain buffer length */
255 &snu); /* SID name type */
256 if (bResult) {
257 W2AHELPER(wAccount, Account, AcctLen);
258 W2AHELPER(wDomain, Domain, DomLen);
259 }
260 }
261 else
262 bResult = LookupAccountSidA(SvPV(ST(0),n_a), /* System */
263 sid, /* SID structure */
264 Account, /* Account name buffer */
265 &AcctLen, /* name buffer length */
266 Domain, /* Domain buffer */
267 &DomLen, /* Domain buffer length */
268 &snu); /* SID name type */
269 if (bResult) {
270 sv_setpv(ST(2), Account);
271 sv_setpv(ST(3), Domain);
272 sv_setiv(ST(4), (IV)snu);
273 XSRETURN_YES;
274 }
275 else {
276 GetLastError();
277 XSRETURN_NO;
278 }
279 }
280 else {
281 GetLastError();
282 XSRETURN_NO;
283 }
284} /* NTLookupAccountSID */
285
286XS(w32_InitiateSystemShutdown)
287{
288 dXSARGS;
289 HANDLE hToken; /* handle to process token */
290 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
291 BOOL bRet;
292 WCHAR wbuffer[MAX_PATH+1];
293 char *machineName, *message;
294 STRLEN n_a;
295
296 if (items != 5)
297 croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
298 "$timeOut, $forceClose, $reboot);\n");
299
300 machineName = SvPV(ST(0), n_a);
301 if (USING_WIDE()) {
302 A2WHELPER(machineName, wbuffer, sizeof(wbuffer));
303 }
304
305 if (OpenProcessToken(GetCurrentProcess(),
306 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
307 &hToken))
308 {
309 if (USING_WIDE())
310 LookupPrivilegeValueW(wbuffer,
311 SE_SHUTDOWN_NAMEW,
312 &tkp.Privileges[0].Luid);
313 else
314 LookupPrivilegeValueA(machineName,
315 SE_SHUTDOWN_NAMEA,
316 &tkp.Privileges[0].Luid);
317
318 tkp.PrivilegeCount = 1; /* only setting one */
319 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
320
321 /* Get shutdown privilege for this process. */
322 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
323 (PTOKEN_PRIVILEGES)NULL, 0);
324 }
325
326 message = SvPV(ST(1), n_a);
327 if (USING_WIDE()) {
328 WCHAR* pWBuf;
329 int length = strlen(message)+1;
330 New(0, pWBuf, length, WCHAR);
331 A2WHELPER(message, pWBuf, length*sizeof(WCHAR));
332 bRet = InitiateSystemShutdownW(wbuffer, pWBuf,
333 SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
334 Safefree(pWBuf);
335 }
336 else
337 bRet = InitiateSystemShutdownA(machineName, message,
338 SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
339
340 /* Disable shutdown privilege. */
341 tkp.Privileges[0].Attributes = 0;
342 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
343 (PTOKEN_PRIVILEGES)NULL, 0);
344 CloseHandle(hToken);
345 XSRETURN_IV(bRet);
346}
347
348XS(w32_AbortSystemShutdown)
349{
350 dXSARGS;
351 HANDLE hToken; /* handle to process token */
352 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
353 BOOL bRet;
354 char *machineName;
355 STRLEN n_a;
356 WCHAR wbuffer[MAX_PATH+1];
357
358 if (items != 1)
359 croak("usage: Win32::AbortSystemShutdown($machineName);\n");
360
361 machineName = SvPV(ST(0), n_a);
362 if (USING_WIDE()) {
363 A2WHELPER(machineName, wbuffer, sizeof(wbuffer));
364 }
365
366 if (OpenProcessToken(GetCurrentProcess(),
367 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
368 &hToken))
369 {
370 if (USING_WIDE())
371 LookupPrivilegeValueW(wbuffer,
372 SE_SHUTDOWN_NAMEW,
373 &tkp.Privileges[0].Luid);
374 else
375 LookupPrivilegeValueA(machineName,
376 SE_SHUTDOWN_NAMEA,
377 &tkp.Privileges[0].Luid);
378
379 tkp.PrivilegeCount = 1; /* only setting one */
380 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
381
382 /* Get shutdown privilege for this process. */
383 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
384 (PTOKEN_PRIVILEGES)NULL, 0);
385 }
386
387 if (USING_WIDE()) {
388 bRet = AbortSystemShutdownW(wbuffer);
389 }
390 else
391 bRet = AbortSystemShutdownA(machineName);
392
393 /* Disable shutdown privilege. */
394 tkp.Privileges[0].Attributes = 0;
395 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
396 (PTOKEN_PRIVILEGES)NULL, 0);
397 CloseHandle(hToken);
398 XSRETURN_IV(bRet);
399}
400
401
402XS(w32_MsgBox)
403{
404 dXSARGS;
405 char *msg;
406 char *title = "Perl";
407 DWORD flags = MB_ICONEXCLAMATION;
408 STRLEN n_a;
409 I32 result;
410
411 if (items < 1 || items > 3)
412 croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
413
414 msg = SvPV(ST(0), n_a);
415 if (items > 1) {
416 flags = SvIV(ST(1));
417 if (items > 2)
418 title = SvPV(ST(2), n_a);
419 }
420 if (USING_WIDE()) {
421 WCHAR* pMsg;
422 WCHAR* pTitle;
423 int length;
424 length = strlen(msg)+1;
425 New(0, pMsg, length, WCHAR);
426 A2WHELPER(msg, pMsg, length*sizeof(WCHAR));
427 length = strlen(title)+1;
428 New(0, pTitle, length, WCHAR);
429 A2WHELPER(title, pTitle, length*sizeof(WCHAR));
430 result = MessageBoxW(GetActiveWindow(), pMsg, pTitle, flags);
431 Safefree(pMsg);
432 Safefree(pTitle);
433 }
434 else
435 result = MessageBoxA(GetActiveWindow(), msg, title, flags);
436
437 XSRETURN_IV(result);
438}
439
440XS(w32_LoadLibrary)
441{
442 dXSARGS;
443 STRLEN n_a;
444 HANDLE hHandle;
445 char* lpName;
446
447 if (items != 1)
448 croak("usage: Win32::LoadLibrary($libname)\n");
449 lpName = (char *)SvPV(ST(0),n_a);
450 if (USING_WIDE()) {
451 WCHAR wbuffer[MAX_PATH+1];
452 A2WHELPER(lpName, wbuffer, sizeof(wbuffer));
453 hHandle = LoadLibraryW(wbuffer);
454 }
455 else
456 hHandle = LoadLibraryA(lpName);
457 XSRETURN_IV((long)hHandle);
458}
459
460XS(w32_FreeLibrary)
461{
462 dXSARGS;
463 if (items != 1)
464 croak("usage: Win32::FreeLibrary($handle)\n");
465 if (FreeLibrary((HINSTANCE) SvIV(ST(0)))) {
466 XSRETURN_YES;
467 }
468 XSRETURN_NO;
469}
470
471XS(w32_GetProcAddress)
472{
473 dXSARGS;
474 STRLEN n_a;
475 if (items != 2)
476 croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
477 XSRETURN_IV((long)GetProcAddress((HINSTANCE)SvIV(ST(0)), SvPV(ST(1), n_a)));
478}
479
480XS(w32_RegisterServer)
481{
482 dXSARGS;
483 BOOL result = FALSE;
484 HINSTANCE hnd;
485 FARPROC func;
486 STRLEN n_a;
487 char* lpName;
488
489 if (items != 1)
490 croak("usage: Win32::RegisterServer($libname)\n");
491
492 lpName = SvPV(ST(0),n_a);
493 if (USING_WIDE()) {
494 WCHAR wbuffer[MAX_PATH+1];
495 A2WHELPER(lpName, wbuffer, sizeof(wbuffer));
496 hnd = LoadLibraryW(wbuffer);
497 }
498 else
499 hnd = LoadLibraryA(lpName);
500
501 if (hnd) {
502 func = GetProcAddress(hnd, "DllRegisterServer");
503 if (func && func() == 0)
504 result = TRUE;
505 FreeLibrary(hnd);
506 }
507 if (result)
508 XSRETURN_YES;
509 else
510 XSRETURN_NO;
511}
512
513XS(w32_UnregisterServer)
514{
515 dXSARGS;
516 BOOL result = FALSE;
517 HINSTANCE hnd;
518 FARPROC func;
519 STRLEN n_a;
520 char* lpName;
521
522 if (items != 1)
523 croak("usage: Win32::UnregisterServer($libname)\n");
524
525 lpName = SvPV(ST(0),n_a);
526 if (USING_WIDE()) {
527 WCHAR wbuffer[MAX_PATH+1];
528 A2WHELPER(lpName, wbuffer, sizeof(wbuffer));
529 hnd = LoadLibraryW(wbuffer);
530 }
531 else
532 hnd = LoadLibraryA(lpName);
533
534 if (hnd) {
535 func = GetProcAddress(hnd, "DllUnregisterServer");
536 if (func && func() == 0)
537 result = TRUE;
538 FreeLibrary(hnd);
539 }
540 if (result)
541 XSRETURN_YES;
542 else
543 XSRETURN_NO;
544}
545
546/* XXX rather bogus */
547XS(w32_GetArchName)
548{
549 dXSARGS;
550 XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
551}
552
553XS(w32_GetChipName)
554{
555 dXSARGS;
556 SYSTEM_INFO sysinfo;
557
558 Zero(&sysinfo,1,SYSTEM_INFO);
559 GetSystemInfo(&sysinfo);
560 /* XXX docs say dwProcessorType is deprecated on NT */
561 XSRETURN_IV(sysinfo.dwProcessorType);
562}
563
564XS(w32_GuidGen)
565{
566 dXSARGS;
567 GUID guid;
568 char szGUID[50] = {'\0'};
569 HRESULT hr = CoCreateGuid(&guid);
570
571 if (SUCCEEDED(hr)) {
572 LPOLESTR pStr = NULL;
e364e11c 573 if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
574 WideCharToMultiByte(CP_ACP, 0, pStr, wcslen(pStr), szGUID,
575 sizeof(szGUID), NULL, NULL);
576 CoTaskMemFree(pStr);
577 XSRETURN_PV(szGUID);
578 }
b4ad57f4 579 }
e364e11c 580 XSRETURN_UNDEF;
b4ad57f4 581}
582
583XS(w32_GetFolderPath)
584{
585 dXSARGS;
586 char path[MAX_PATH+1];
587 int folder;
588 int create = 0;
589 HMODULE module;
590
591 if (items != 1 && items != 2)
592 croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
593
594 folder = SvIV(ST(0));
595 if (items == 2)
596 create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
597
598 /* We are not bothering with USING_WIDE() anymore,
599 * because this is not how Unicode works with Perl.
600 * Nobody seems to use "perl -C" anyways.
601 */
602 module = LoadLibrary("shfolder.dll");
603 if (module) {
604 PFNSHGetFolderPath pfn;
605 pfn = (PFNSHGetFolderPath)GetProcAddress(module, "SHGetFolderPathA");
606 if (pfn && SUCCEEDED(pfn(NULL, folder|create, NULL, 0, path))) {
607 FreeLibrary(module);
608 XSRETURN_PV(path);
609 }
610 FreeLibrary(module);
611 }
612
613 module = LoadLibrary("shell32.dll");
614 if (module) {
615 PFNSHGetSpecialFolderPath pfn;
616 pfn = (PFNSHGetSpecialFolderPath)
617 GetProcAddress(module, "SHGetSpecialFolderPathA");
618 if (pfn && pfn(NULL, path, folder, !!create)) {
619 FreeLibrary(module);
620 XSRETURN_PV(path);
621 }
622 FreeLibrary(module);
623 }
624 XSRETURN_UNDEF;
625}
626
e364e11c 627XS(w32_GetFileVersion)
628{
629 dXSARGS;
630 DWORD size;
631 DWORD handle;
632 char *filename;
633 char *data;
634
635 if (items != 1)
636 croak("usage: Win32::GetFileVersion($filename)\n");
637
638 filename = SvPV_nolen(ST(0));
639 size = GetFileVersionInfoSize(filename, &handle);
640 if (!size)
641 XSRETURN_UNDEF;
642
643 New(0, data, size, char);
644 if (!data)
645 XSRETURN_UNDEF;
646
647 if (GetFileVersionInfo(filename, handle, size, data)) {
648 VS_FIXEDFILEINFO *info;
649 UINT len;
650 if (VerQueryValue(data, "\\", (void**)&info, &len)) {
651 int dwValueMS1 = (info->dwFileVersionMS>>16);
652 int dwValueMS2 = (info->dwFileVersionMS&0xffff);
653 int dwValueLS1 = (info->dwFileVersionLS>>16);
654 int dwValueLS2 = (info->dwFileVersionLS&0xffff);
655
656 if (GIMME_V == G_ARRAY) {
657 EXTEND(SP, 4);
658 XST_mIV(0, dwValueMS1);
659 XST_mIV(1, dwValueMS2);
660 XST_mIV(2, dwValueLS1);
661 XST_mIV(3, dwValueLS2);
662 items = 4;
663 }
664 else {
665 char version[50];
666 sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
667 XST_mPV(0, version);
668 }
669 }
670 }
671 else
672 items = 0;
673
674 Safefree(data);
675 XSRETURN(items);
676}
677
b4ad57f4 678XS(boot_Win32)
679{
680 dXSARGS;
681 char *file = __FILE__;
682
683 newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
684 newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
685 newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);
686 newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file);
687 newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file);
688 newXS("Win32::MsgBox", w32_MsgBox, file);
689 newXS("Win32::LoadLibrary", w32_LoadLibrary, file);
690 newXS("Win32::FreeLibrary", w32_FreeLibrary, file);
691 newXS("Win32::GetProcAddress", w32_GetProcAddress, file);
692 newXS("Win32::RegisterServer", w32_RegisterServer, file);
693 newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
694 newXS("Win32::GetArchName", w32_GetArchName, file);
695 newXS("Win32::GetChipName", w32_GetChipName, file);
696 newXS("Win32::GuidGen", w32_GuidGen, file);
697 newXS("Win32::GetFolderPath", w32_GetFolderPath, file);
698 newXS("Win32::IsAdminUser", w32_IsAdminUser, file);
e364e11c 699 newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
b4ad57f4 700
701 XSRETURN_YES;
702}