7 #define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege"
9 typedef BOOL (WINAPI *PFNSHGetSpecialFolderPath)(HWND, char*, int, BOOL);
10 typedef HRESULT (WINAPI *PFNSHGetFolderPath)(HWND, int, HANDLE, DWORD, LPTSTR);
11 typedef int (__stdcall *PFNDllRegisterServer)(void);
12 typedef int (__stdcall *PFNDllUnregisterServer)(void);
13 #ifndef CSIDL_FLAG_CREATE
14 # define CSIDL_FLAG_CREATE 0x8000
17 static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
19 #define ONE_K_BUFSIZE 1024
24 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
30 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
35 #define isSLASH(c) ((c) == '/' || (c) == '\\')
36 #define SKIP_SLASHES(s) \
38 while (*(s) && isSLASH(*(s))) \
41 #define COPY_NONSLASHES(d,s) \
43 while (*(s) && !isSLASH(*(s))) \
47 /* Find the longname of a given path. path is destructively modified.
48 * It should have space for at least MAX_PATH characters. */
50 win32_longpath(char *path)
52 WIN32_FIND_DATA fdata;
54 char tmpbuf[MAX_PATH+1];
55 char *tmpstart = tmpbuf;
62 if (isALPHA(path[0]) && path[1] == ':') {
64 *tmpstart++ = path[0];
68 else if (isSLASH(path[0]) && isSLASH(path[1])) {
70 *tmpstart++ = path[0];
71 *tmpstart++ = path[1];
73 COPY_NONSLASHES(tmpstart,start); /* copy machine name */
75 *tmpstart++ = *start++;
77 COPY_NONSLASHES(tmpstart,start); /* copy share name */
82 /* copy initial slash, if any */
83 if (isSLASH(*start)) {
84 *tmpstart++ = *start++;
89 /* FindFirstFile() expands "." and "..", so we need to pass
90 * those through unmolested */
92 && (!start[1] || isSLASH(start[1])
93 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
95 COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
100 /* if this is the end, bust outta here */
104 /* now we're at a non-slash; walk up to next slash */
105 while (*start && !isSLASH(*start))
108 /* stop and find full name of component */
111 fhand = FindFirstFile(path,&fdata);
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);
127 /* failed a step, just return without side effects */
128 /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
142 char szfilename[MAX_PATH+1];
144 GetCurrentDirectoryA(MAX_PATH+1, szfilename);
145 New(0, ptr, strlen(szfilename)+1, char);
146 strcpy(ptr, szfilename);
151 free_childdir(char* d)
164 free_childenv(void* d)
168 # define PerlDir_mapA(dir) (dir)
172 XS(w32_ExpandEnvironmentStrings)
178 croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
180 ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), (char*)buffer, sizeof(buffer));
181 XSRETURN_PV((char*)buffer);
188 BOOL (__stdcall *pfnOpenThreadToken)(HANDLE hThr, DWORD dwDesiredAccess,
189 BOOL bOpenAsSelf, PHANDLE phTok);
190 BOOL (__stdcall *pfnOpenProcessToken)(HANDLE hProc, DWORD dwDesiredAccess,
192 BOOL (__stdcall *pfnGetTokenInformation)(HANDLE hTok,
193 TOKEN_INFORMATION_CLASS TokenInformationClass,
194 LPVOID lpTokInfo, DWORD dwTokInfoLen,
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);
207 TOKEN_GROUPS *lpTokInfo;
208 SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY;
215 croak("usage: Win32::IsAdminUser()");
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)
225 hAdvApi32 = LoadLibrary("advapi32.dll");
227 warn("Cannot load advapi32.dll library");
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");
247 if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
248 pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
249 pfnEqualSid && pfnFreeSid))
251 warn("Cannot load functions from advapi32.dll library");
252 FreeLibrary(hAdvApi32);
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);
264 pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
265 if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
266 warn("Cannot allocate token information structure");
268 FreeLibrary(hAdvApi32);
272 if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
275 warn("Cannot get token information");
278 FreeLibrary(hAdvApi32);
282 if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
283 DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))
285 warn("Cannot allocate administrators' SID");
288 FreeLibrary(hAdvApi32);
293 for (i = 0; i < lpTokInfo->GroupCount; ++i) {
294 if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {
300 pfnFreeSid(pAdminSid);
303 FreeLibrary(hAdvApi32);
306 ST(0) = sv_2mortal(newSViv(iRetVal));
310 XS(w32_LookupAccountName)
321 croak("usage: Win32::LookupAccountName($system, $account, $domain, "
322 "$sid, $sidtype);\n");
324 SIDLen = sizeof(SID);
325 DomLen = sizeof(Domain);
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 */
335 sv_setpv(ST(2), Domain);
336 sv_setpvn(ST(3), SID, SIDLen);
337 sv_setiv(ST(4), snu);
344 XS(w32_LookupAccountSID)
349 DWORD AcctLen = sizeof(Account);
351 DWORD DomLen = sizeof(Domain);
356 croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
358 sid = SvPV_nolen(ST(1));
359 if (IsValidSid(sid)) {
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 */
368 sv_setpv(ST(2), Account);
369 sv_setpv(ST(3), Domain);
370 sv_setiv(ST(4), (IV)snu);
377 XS(w32_InitiateSystemShutdown)
380 HANDLE hToken; /* handle to process token */
381 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
383 char *machineName, *message;
386 croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
387 "$timeOut, $forceClose, $reboot);\n");
389 machineName = SvPV_nolen(ST(0));
391 if (OpenProcessToken(GetCurrentProcess(),
392 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
395 LookupPrivilegeValueA(machineName,
397 &tkp.Privileges[0].Luid);
399 tkp.PrivilegeCount = 1; /* only setting one */
400 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
402 /* Get shutdown privilege for this process. */
403 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
404 (PTOKEN_PRIVILEGES)NULL, 0);
407 message = SvPV_nolen(ST(1));
408 bRet = InitiateSystemShutdownA(machineName, message,
409 SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
411 /* Disable shutdown privilege. */
412 tkp.Privileges[0].Attributes = 0;
413 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
414 (PTOKEN_PRIVILEGES)NULL, 0);
419 XS(w32_AbortSystemShutdown)
422 HANDLE hToken; /* handle to process token */
423 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
428 croak("usage: Win32::AbortSystemShutdown($machineName);\n");
430 machineName = SvPV_nolen(ST(0));
432 if (OpenProcessToken(GetCurrentProcess(),
433 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
436 LookupPrivilegeValueA(machineName,
438 &tkp.Privileges[0].Luid);
440 tkp.PrivilegeCount = 1; /* only setting one */
441 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
443 /* Get shutdown privilege for this process. */
444 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
445 (PTOKEN_PRIVILEGES)NULL, 0);
448 bRet = AbortSystemShutdownA(machineName);
450 /* Disable shutdown privilege. */
451 tkp.Privileges[0].Attributes = 0;
452 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
453 (PTOKEN_PRIVILEGES)NULL, 0);
463 char *title = "Perl";
464 DWORD flags = MB_ICONEXCLAMATION;
467 if (items < 1 || items > 3)
468 croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
470 msg = SvPV_nolen(ST(0));
474 title = SvPV_nolen(ST(2));
476 result = MessageBoxA(GetActiveWindow(), msg, title, flags);
486 croak("usage: Win32::LoadLibrary($libname)\n");
487 hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
488 XSRETURN_IV((long)hHandle);
496 croak("usage: Win32::FreeLibrary($handle)\n");
497 if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
503 XS(w32_GetProcAddress)
508 croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
509 XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
512 XS(w32_RegisterServer)
519 croak("usage: Win32::RegisterServer($libname)\n");
521 hnd = LoadLibraryA(SvPV_nolen(ST(0)));
523 PFNDllRegisterServer func;
524 func = (PFNDllRegisterServer)GetProcAddress(hnd, "DllRegisterServer");
525 if (func && func() == 0)
529 ST(0) = boolSV(result);
533 XS(w32_UnregisterServer)
540 croak("usage: Win32::UnregisterServer($libname)\n");
542 hnd = LoadLibraryA(SvPV_nolen(ST(0)));
544 PFNDllUnregisterServer func;
545 func = (PFNDllUnregisterServer)GetProcAddress(hnd, "DllUnregisterServer");
546 if (func && func() == 0)
550 ST(0) = boolSV(result);
554 /* XXX rather bogus */
558 XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
566 Zero(&sysinfo,1,SYSTEM_INFO);
567 GetSystemInfo(&sysinfo);
568 /* XXX docs say dwProcessorType is deprecated on NT */
569 XSRETURN_IV(sysinfo.dwProcessorType);
576 char szGUID[50] = {'\0'};
577 HRESULT hr = CoCreateGuid(&guid);
580 LPOLESTR pStr = NULL;
581 if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
582 WideCharToMultiByte(CP_ACP, 0, pStr, wcslen(pStr), szGUID,
583 sizeof(szGUID), NULL, NULL);
591 XS(w32_GetFolderPath)
594 char path[MAX_PATH+1];
599 if (items != 1 && items != 2)
600 croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
602 folder = SvIV(ST(0));
604 create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
606 module = LoadLibrary("shfolder.dll");
608 PFNSHGetFolderPath pfn;
609 pfn = (PFNSHGetFolderPath)GetProcAddress(module, "SHGetFolderPathA");
610 if (pfn && SUCCEEDED(pfn(NULL, folder|create, NULL, 0, path))) {
617 module = LoadLibrary("shell32.dll");
619 PFNSHGetSpecialFolderPath pfn;
620 pfn = (PFNSHGetSpecialFolderPath)
621 GetProcAddress(module, "SHGetSpecialFolderPathA");
622 if (pfn && pfn(NULL, path, folder, !!create)) {
631 XS(w32_GetFileVersion)
640 croak("usage: Win32::GetFileVersion($filename)\n");
642 filename = SvPV_nolen(ST(0));
643 size = GetFileVersionInfoSize(filename, &handle);
647 New(0, data, size, char);
651 if (GetFileVersionInfo(filename, handle, size, data)) {
652 VS_FIXEDFILEINFO *info;
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);
660 if (GIMME_V == G_ARRAY) {
662 XST_mIV(0, dwValueMS1);
663 XST_mIV(1, dwValueMS2);
664 XST_mIV(2, dwValueLS1);
665 XST_mIV(3, dwValueLS2);
670 sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
683 XS(w32_SetChildShowWindow)
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.
699 /* Make the host for current directory */
700 char* ptr = PerlEnv_get_childdir();
703 * then it worked, set PV valid,
704 * else return 'undef'
707 SV *sv = sv_newmortal();
709 PerlEnv_free_childdir(ptr);
711 #ifndef INCOMPLETE_TAINTS
727 Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
728 if (!PerlDir_chdir(SvPV_nolen(ST(0))))
734 XS(w32_GetNextAvailDrive)
738 char root[] = "_:\\";
743 if (GetDriveType(root) == 1) {
755 XSRETURN_IV(GetLastError());
762 Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
763 SetLastError(SvIV(ST(0)));
771 DWORD size = sizeof(name);
773 if (GetUserName(name,&size)) {
774 /* size includes NULL */
775 ST(0) = sv_2mortal(newSVpvn(name,size-1));
784 char name[MAX_COMPUTERNAME_LENGTH+1];
785 DWORD size = sizeof(name);
787 if (GetComputerName(name,&size)) {
788 /* size does NOT include NULL :-( */
789 ST(0) = sv_2mortal(newSVpvn(name,size));
799 HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
800 DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
801 DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
805 pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
806 GetProcAddress(hNetApi32, "NetApiBufferFree");
807 pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
808 GetProcAddress(hNetApi32, "NetWkstaGetInfo");
811 if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
812 /* this way is more reliable, in case user has a local account. */
814 DWORD dnamelen = sizeof(dname);
816 DWORD wki100_platform_id;
817 LPWSTR wki100_computername;
818 LPWSTR wki100_langroup;
819 DWORD wki100_ver_major;
820 DWORD wki100_ver_minor;
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);
829 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
830 -1, (LPSTR)dname, dnamelen, NULL, NULL);
832 pfnNetApiBufferFree(pwi);
833 FreeLibrary(hNetApi32);
836 FreeLibrary(hNetApi32);
839 /* Win95 doesn't have NetWksta*(), so do it the old way */
841 DWORD size = sizeof(name);
843 FreeLibrary(hNetApi32);
844 if (GetUserName(name,&size)) {
845 char sid[ONE_K_BUFSIZE];
846 DWORD sidlen = sizeof(sid);
848 DWORD dnamelen = sizeof(dname);
850 if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
851 dname, &dnamelen, &snu)) {
852 XSRETURN_PV(dname); /* all that for this */
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)));
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.
888 DWORD dwOSVersionInfoSize;
889 DWORD dwMajorVersion;
890 DWORD dwMinorVersion;
893 CHAR szCSDVersion[128];
894 unsigned short wServicePackMajor;
895 unsigned short wServicePackMinor;
896 unsigned short wSuiteMask;
902 osver.dwOSVersionInfoSize = sizeof(osver);
903 if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
905 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
906 if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
910 if (GIMME_V == G_SCALAR) {
911 XSRETURN_IV(osver.dwPlatformId);
913 XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
915 XPUSHs(newSViv(osver.dwMajorVersion));
916 XPUSHs(newSViv(osver.dwMinorVersion));
917 XPUSHs(newSViv(osver.dwBuildNumber));
918 XPUSHs(newSViv(osver.dwPlatformId));
920 XPUSHs(newSViv(osver.wServicePackMajor));
921 XPUSHs(newSViv(osver.wServicePackMinor));
922 XPUSHs(newSViv(osver.wSuiteMask));
923 XPUSHs(newSViv(osver.wProductType));
932 XSRETURN_IV(IsWinNT());
939 XSRETURN_IV(IsWin95());
942 XS(w32_FormatMessage)
946 char msgbuf[ONE_K_BUFSIZE];
949 Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
951 if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
952 &source, SvIV(ST(0)), 0,
953 msgbuf, sizeof(msgbuf)-1, NULL))
967 PROCESS_INFORMATION stProcInfo;
968 STARTUPINFO stStartInfo;
969 BOOL bSuccess = FALSE;
972 Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
974 cmd = SvPV_nolen(ST(0));
975 args = SvPV_nolen(ST(1));
977 env = PerlEnv_get_childenv();
978 dir = PerlEnv_get_childdir();
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) */
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) */
997 int pid = (int)stProcInfo.dwProcessId;
998 if (IsWin95() && pid < 0)
1000 sv_setiv(ST(2), pid);
1001 CloseHandle(stProcInfo.hThread);/* library source code does this. */
1004 PerlEnv_free_childenv(env);
1005 PerlEnv_free_childdir(dir);
1006 XSRETURN_IV(bSuccess);
1009 XS(w32_GetTickCount)
1012 DWORD msec = GetTickCount();
1019 XS(w32_GetShortPathName)
1026 Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
1028 shortpath = sv_mortalcopy(ST(0));
1029 SvUPGRADE(shortpath, SVt_PV);
1030 if (!SvPVX(shortpath) || !SvLEN(shortpath))
1033 /* src == target is allowed */
1035 len = GetShortPathName(SvPVX(shortpath),
1038 } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
1040 SvCUR_set(shortpath,len);
1041 *SvEND(shortpath) = '\0';
1048 XS(w32_GetFullPathName)
1055 STRLEN filename_len;
1059 Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
1062 filename_p = SvPV(filename, filename_len);
1063 fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
1064 if (!SvPVX(fullpath) || !SvLEN(fullpath))
1068 len = GetFullPathName(SvPVX(filename),
1072 } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
1074 if (GIMME_V == G_ARRAY) {
1077 XST_mPV(1,filepart);
1078 len = filepart - SvPVX(fullpath);
1085 SvCUR_set(fullpath,len);
1086 *SvEND(fullpath) = '\0';
1093 XS(w32_GetLongPathName)
1097 char tmpbuf[MAX_PATH+1];
1102 Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
1105 pathstr = SvPV(path,len);
1106 strcpy(tmpbuf, pathstr);
1107 pathstr = win32_longpath(tmpbuf);
1109 ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
1119 Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
1128 char szSourceFile[MAX_PATH+1];
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)));
1142 char *file = __FILE__;
1144 if (g_osver.dwOSVersionInfoSize == 0) {
1145 g_osver.dwOSVersionInfoSize = sizeof(g_osver);
1146 GetVersionEx(&g_osver);
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);
1165 newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
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);
1188 newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);