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