From: Nicholas Clark Date: Fri, 19 Mar 2004 11:59:01 +0000 (+0000) Subject: [PATCH] Move Win32.pm/Win32.xs from libwin32 module to core Perl X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b4ad57f4f7fe2aca6dc52ea357ce9be7a7d38769;p=p5sagit%2Fp5-mst-13.2.git [PATCH] Move Win32.pm/Win32.xs from libwin32 module to core Perl From: Jan Dubois Message-ID: Date: Thu, 18 Mar 2004 13:13:49 -0800 Subject: Re: [PATCH] Move Win32.pm/Win32.xs from libwin32 module to core Perl From: Steve Hay Message-ID: <405ACC6D.1040804@uk.radan.com> Date: Fri, 19 Mar 2004 10:33:17 +0000 p4raw-id: //depot/perl@22537 --- diff --git a/MANIFEST b/MANIFEST index 9d7b696..12134c8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2173,7 +2173,6 @@ lib/vmsish.t Tests for vmsish.pm lib/warnings.pm For "use warnings" lib/warnings/register.pm For "use warnings::register" lib/warnings.t See if warning controls work -lib/Win32.pod Documentation for Win32 extras locale.c locale-specific utility functions makeaperl.SH perl script that produces a new perl binary makedef.pl Create symbol export lists for linking @@ -3045,6 +3044,9 @@ win32/config.vc Win32 base line config.sh (Visual C++ build) win32/config.vc64 Win64 base line config.sh (Visual C++ build) win32/distclean.bat Remove _ALL_ files not listed here in MANIFEST win32/dl_win32.xs Win32 port +win32/ext/Win32/Makefile.PL Win32 extension makefile writer +win32/ext/Win32/Win32.pm Win32 extension Perl module +win32/ext/Win32/Win32.xs Win32 extension external subroutines win32/fcrypt.c crypt() implementation win32/FindExt.pm Scan for extensions win32/genmk95.pl Perl code to generate command.com-usable makefile.95 diff --git a/lib/Win32.pod b/lib/Win32.pod deleted file mode 100644 index d0a6263..0000000 --- a/lib/Win32.pod +++ /dev/null @@ -1,429 +0,0 @@ -=head1 NAME - -Win32 - Interfaces to some Win32 API Functions - -=head1 DESCRIPTION - -Perl on Win32 contains several functions to access Win32 APIs. Some -are included in Perl itself (on Win32) and some are only available -after explicitly requesting the Win32 module with: - - use Win32; - -The builtin functions are marked as [CORE] and the other ones -as [EXT] in the following alphabetical listing. The C module -is not part of the Perl source distribution; it is distributed in -the libwin32 bundle of Win32::* modules on CPAN. The module is -already preinstalled in binary distributions like ActivePerl. - -=head2 Alphabetical Listing of Win32 Functions - -=over - -=item Win32::AbortSystemShutdown(MACHINE) - -[EXT] Aborts a system shutdown (started by the -InitiateSystemShutdown function) on the specified MACHINE. - -=item Win32::BuildNumber() - -[CORE] Returns the ActivePerl build number. This function is -only available in the ActivePerl binary distribution. - -=item Win32::CopyFile(FROM, TO, OVERWRITE) - -[CORE] The Win32::CopyFile() function copies an existing file to a new -file. All file information like creation time and file attributes will -be copied to the new file. However it will B copy the security -information. If the destination file already exists it will only be -overwritten when the OVERWRITE parameter is true. But even this will -not overwrite a read-only file; you have to unlink() it first -yourself. - -=item Win32::DomainName() - -[CORE] Returns the name of the Microsoft Network domain that the -owner of the current perl process is logged into. This function does -B work on Windows 9x. - -=item Win32::ExpandEnvironmentStrings(STRING) - -[EXT] Takes STRING and replaces all referenced environment variable -names with their defined values. References to environment variables -take the form C<%VariableName%>. Case is ignored when looking up the -VariableName in the environment. If the variable is not found then the -original C<%VariableName%> text is retained. Has the same effect -as the following: - - $string =~ s/%([^%]*)%/$ENV{$1} || "%$1%"/eg - -=item Win32::FormatMessage(ERRORCODE) - -[CORE] Converts the supplied Win32 error number (e.g. returned by -Win32::GetLastError()) to a descriptive string. Analogous to the -perror() standard-C library function. Note that C<$^E> used -in a string context has much the same effect. - - C:\> perl -e "$^E = 26; print $^E;" - The specified disk or diskette cannot be accessed - -=item Win32::FsType() - -[CORE] Returns the name of the filesystem of the currently active -drive (like 'FAT' or 'NTFS'). In list context it returns three values: -(FSTYPE, FLAGS, MAXCOMPLEN). FSTYPE is the filesystem type as -before. FLAGS is a combination of values of the following table: - - 0x00000001 supports case-sensitive filenames - 0x00000002 preserves the case of filenames - 0x00000004 supports Unicode in filenames - 0x00000008 preserves and enforces ACLs - 0x00000010 supports file-based compression - 0x00000020 supports disk quotas - 0x00000040 supports sparse files - 0x00000080 supports reparse points - 0x00000100 supports remote storage - 0x00008000 is a compressed volume (e.g. DoubleSpace) - 0x00010000 supports object identifiers - 0x00020000 supports the Encrypted File System (EFS) - -MAXCOMPLEN is the maximum length of a filename component (the part -between two backslashes) on this file system. - -=item Win32::FreeLibrary(HANDLE) - -[EXT] Unloads a previously loaded dynamic-link library. The HANDLE is -no longer valid after this call. See L -for information on dynamically loading a library. - -=item Win32::GetArchName() - -[EXT] Use of this function is deprecated. It is equivalent with -$ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X. - -=item Win32::GetChipName() - -[EXT] Returns the processor type: 386, 486 or 586 for Intel processors, -21064 for the Alpha chip. - -=item Win32::GetCwd() - -[CORE] Returns the current active drive and directory. This function -does not return a UNC path, since the functionality required for such -a feature is not available under Windows 95. - -=item Win32::GetFolderPath(FOLDER [, CREATE]) - -[EXT] Returns the full pathname of one of the Windows special folders. -The folder will be created if it doesn't exist and the optional CREATE -argument is true. The following FOLDER constants are defined by the -Win32 module, but only exported on demand: - - CSIDL_ADMINTOOLS - CSIDL_APPDATA - CSIDL_CDBURN_AREA - CSIDL_COMMON_ADMINTOOLS - CSIDL_COMMON_APPDATA - CSIDL_COMMON_DESKTOPDIRECTORY - CSIDL_COMMON_DOCUMENTS - CSIDL_COMMON_FAVORITES - CSIDL_COMMON_MUSIC - CSIDL_COMMON_PICTURES - CSIDL_COMMON_PROGRAMS - CSIDL_COMMON_STARTMENU - CSIDL_COMMON_STARTUP - CSIDL_COMMON_TEMPLATES - CSIDL_COMMON_VIDEO - CSIDL_COOKIES - CSIDL_DESKTOP - CSIDL_DESKTOPDIRECTORY - CSIDL_FAVORITES - CSIDL_FONTS - CSIDL_HISTORY - CSIDL_INTERNET_CACHE - CSIDL_LOCAL_APPDATA - CSIDL_MYMUSIC - CSIDL_MYPICTURES - CSIDL_MYVIDEO - CSIDL_NETHOOD - CSIDL_PERSONAL - CSIDL_PRINTHOOD - CSIDL_PROFILE - CSIDL_PROGRAMS - CSIDL_PROGRAM_FILES - CSIDL_PROGRAM_FILES_COMMON - CSIDL_RECENT - CSIDL_RESOURCES - CSIDL_RESOURCES_LOCALIZED - CSIDL_SENDTO - CSIDL_STARTMENU - CSIDL_STARTUP - CSIDL_SYSTEM - CSIDL_TEMPLATES - CSIDL_WINDOWS - -Note that not all folders are defined on all versions of Windows. - -Please refer to the MSDN documentation of the CSIDL constants, -currently available at: - -http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/enums/csidl.asp - -=item Win32::GetFullPathName(FILENAME) - -[CORE] GetFullPathName combines the FILENAME with the current drive -and directory name and returns a fully qualified (aka, absolute) -path name. In list context it returns two elements: (PATH, FILE) where -PATH is the complete pathname component (including trailing backslash) -and FILE is just the filename part. Note that no attempt is made to -convert 8.3 components in the supplied FILENAME to longnames or -vice-versa. Compare with Win32::GetShortPathName and -Win32::GetLongPathName. - -This function has been added for Perl 5.6. - -=item Win32::GetLastError() - -[CORE] Returns the last error value generated by a call to a Win32 API -function. Note that C<$^E> used in a numeric context amounts to the -same value. - -=item Win32::GetLongPathName(PATHNAME) - -[CORE] Returns a representation of PATHNAME composed of longname -components (if any). The result may not necessarily be longer -than PATHNAME. No attempt is made to convert PATHNAME to the -absolute path. Compare with Win32::GetShortPathName and -Win32::GetFullPathName. - -This function has been added for Perl 5.6. - -=item Win32::GetNextAvailDrive() - -[CORE] Returns a string in the form of ":" where is the first -available drive letter. - -=item Win32::GetOSVersion() - -[CORE] Returns the list (STRING, MAJOR, MINOR, BUILD, ID), where the -elements are, respectively: An arbitrary descriptive string, the major -version number of the operating system, the minor version number, the -build number, and a digit indicating the actual operating system. -For the ID, the values are 0 for Win32s, 1 for Windows 9X/Me and 2 for -Windows NT/2000/XP/2003. In scalar context it returns just the ID. - -Currently known values for ID MAJOR and MINOR are as follows: - - OS ID MAJOR MINOR - Win32s 0 - - - Windows 95 1 4 0 - Windows 98 1 4 10 - Windows Me 1 4 90 - Windows NT 3.51 2 3 51 - Windows NT 4 2 4 0 - Windows 2000 2 5 0 - Windows XP 2 5 1 - Windows Server 2003 2 5 2 - -On Windows NT 4 SP6 and later this function returns the following -additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE. - -SPMAJOR and SPMINOR are are the version numbers of the latest -installed service pack. - -SUITEMASK is a bitfield identifying the product suites available on -the system. Known bits are: - - VER_SUITE_SMALLBUSINESS 0x00000001 - VER_SUITE_ENTERPRISE 0x00000002 - VER_SUITE_BACKOFFICE 0x00000004 - VER_SUITE_COMMUNICATIONS 0x00000008 - VER_SUITE_TERMINAL 0x00000010 - VER_SUITE_SMALLBUSINESS_RESTRICTED 0x00000020 - VER_SUITE_EMBEDDEDNT 0x00000040 - VER_SUITE_DATACENTER 0x00000080 - VER_SUITE_SINGLEUSERTS 0x00000100 - VER_SUITE_PERSONAL 0x00000200 - VER_SUITE_BLADE 0x00000400 - VER_SUITE_EMBEDDED_RESTRICTED 0x00000800 - VER_SUITE_SECURITY_APPLIANCE 0x00001000 - -The VER_SUITE_xxx names are listed here to crossreference the Microsoft -documentation. The Win32 module does not provide symbolic names for these -constants. - -PRODUCTTYPE provides additional information about the system. It should -be one of the following integer values: - - 1 - Workstation (NT 4, 2000 Pro, XP Home, XP Pro) - 2 - Domaincontroller - 3 - Server - -=item Win32::GetOSName() - -[EXT] In scalar context returns the name of the Win32 operating system -being used. In list context returns a two element list of the OS name -and whatever edition information is known about the particular build -(for Win9x boxes) and whatever service packs have been installed. -The latter is roughly equivalent to the first item returned by -GetOSVersion() in list context. - -Currently the possible values for the OS name are - - Win32s Win95 Win98 WinMe WinNT3.51 WinNT4 Win2000 WinXP/.Net Win2003 - -This routine is just a simple interface into GetOSVersion(). More -specific or demanding situations should use that instead. Another -option would be to use POSIX::uname(), however the latter appears to -report only the OS family name and not the specific OS. In scalar -context it returns just the ID. - -The name "WinXP/.Net" is used for historical reasons only, to maintain -backwards compatibility of the Win32 module. Windows .NET Server has -been renamed as Windows 2003 Server before final release and uses a -different major/minor version number than Windows XP. - -=item Win32::GetShortPathName(PATHNAME) - -[CORE] Returns a representation of PATHNAME composed only of -short (8.3) path components. The result may not necessarily be -shorter than PATHNAME. Compare with Win32::GetFullPathName and -Win32::GetLongPathName. - -=item Win32::GetProcAddress(INSTANCE, PROCNAME) - -[EXT] Returns the address of a function inside a loaded library. The -information about what you can do with this address has been lost in -the mist of time. Use the Win32::API module instead of this deprecated -function. - -=item Win32::GetTickCount() - -[CORE] Returns the number of milliseconds elapsed since the last -system boot. Resolution is limited to system timer ticks (about 10ms -on WinNT and 55ms on Win9X). - -=item Win32::InitiateSystemShutdown - -(MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT) - -[EXT] Shutsdown the specified MACHINE, notifying users with the -supplied MESSAGE, within the specified TIMEOUT interval. Forces -closing of all documents without prompting the user if FORCECLOSE is -true, and reboots the machine if REBOOT is true. This function works -only on WinNT. - -=item Win32::IsWinNT() - -[CORE] Returns non zero if the Win32 subsystem is Windows NT. - -=item Win32::IsWin95() - -[CORE] Returns non zero if the Win32 subsystem is Windows 95. - -=item Win32::LoadLibrary(LIBNAME) - -[EXT] Loads a dynamic link library into memory and returns its module -handle. This handle can be used with Win32::GetProcAddress and -Win32::FreeLibrary. This function is deprecated. Use the Win32::API -module instead. - -=item Win32::LoginName() - -[CORE] Returns the username of the owner of the current perl process. - -=item Win32::LookupAccountName(SYSTEM, ACCOUNT, DOMAIN, SID, SIDTYPE) - -[EXT] Looks up ACCOUNT on SYSTEM and returns the domain name the SID and -the SID type. - -=item Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE) - -[EXT] Looks up SID on SYSTEM and returns the account name, domain name, -and the SID type. - -=item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]]) - -[EXT] Create a dialogbox containing MESSAGE. FLAGS specifies the -required icon and buttons according to the following table: - - 0 = OK - 1 = OK and Cancel - 2 = Abort, Retry, and Ignore - 3 = Yes, No and Cancel - 4 = Yes and No - 5 = Retry and Cancel - - MB_ICONSTOP "X" in a red circle - MB_ICONQUESTION question mark in a bubble - MB_ICONEXCLAMATION exclamation mark in a yellow triangle - MB_ICONINFORMATION "i" in a bubble - -TITLE specifies an optional window title. The default is "Perl". - -The function returns the menu id of the selected push button: - - 0 Error - - 1 OK - 2 Cancel - 3 Abort - 4 Retry - 5 Ignore - 6 Yes - 7 No - -=item Win32::NodeName() - -[CORE] Returns the Microsoft Network node-name of the current machine. - -=item Win32::RegisterServer(LIBRARYNAME) - -[EXT] Loads the DLL LIBRARYNAME and calls the function DllRegisterServer. - -=item Win32::SetChildShowWindow(SHOWWINDOW) - -[CORE] Sets the I of child processes started by system(). -By default system() will create a new console window for child -processes if Perl itself is not running from a console. Calling -SetChildShowWindow(0) will make these new console windows invisible. -Calling SetChildShowWindow() without arguments reverts system() to the -default behavior. The return value of SetChildShowWindow() is the -previous setting or C. - -[EXT] The following symbolic constants for SHOWWINDOW are available -(but not exported) from the Win32 module: SW_HIDE, SW_SHOWNORMAL, -SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED and SW_SHOWNOACTIVATE. - -=item Win32::SetCwd(NEWDIRECTORY) - -[CORE] Sets the current active drive and directory. This function does not -work with UNC paths, since the functionality required to required for -such a feature is not available under Windows 95. - -=item Win32::SetLastError(ERROR) - -[CORE] Sets the value of the last error encountered to ERROR. This is -that value that will be returned by the Win32::GetLastError() -function. This functions has been added for Perl 5.6. - -=item Win32::Sleep(TIME) - -[CORE] Pauses for TIME milliseconds. The timeslices are made available -to other processes and threads. - -=item Win32::Spawn(COMMAND, ARGS, PID) - -[CORE] Spawns a new process using the supplied COMMAND, passing in -arguments in the string ARGS. The pid of the new process is stored in -PID. This function is deprecated. Please use the Win32::Process module -instead. - -=item Win32::UnregisterServer(LIBRARYNAME) - -[EXT] Loads the DLL LIBRARYNAME and calls the function -DllUnregisterServer. - -=back - -=cut diff --git a/win32/Makefile b/win32/Makefile index 711fbd6..65f0fa5 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -679,6 +679,7 @@ PERLIOVIA = $(EXTDIR)\PerlIO\via\via XSAPITEST = $(EXTDIR)\XS\APItest\APItest XSTYPEMAP = $(EXTDIR)\XS\Typemap\Typemap UNICODENORMALIZE = $(EXTDIR)\Unicode\Normalize\Normalize +WIN32_DIR = ext\Win32 SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -709,6 +710,7 @@ PERLIOVIA_DLL = $(AUTODIR)\PerlIO\via\via.dll XSAPITEST_DLL = $(AUTODIR)\XS\APItest\APItest.dll XSTYPEMAP_DLL = $(AUTODIR)\XS\Typemap\Typemap.dll UNICODENORMALIZE_DLL = $(AUTODIR)\Unicode\Normalize\Normalize.dll +WIN32_DLL = $(AUTODIR)\Win32\Win32.dll EXTENSION_C = \ $(SOCKET).c \ @@ -739,7 +741,8 @@ EXTENSION_C = \ $(PERLIOVIA).c \ $(XSAPITEST).c \ $(XSTYPEMAP).c \ - $(UNICODENORMALIZE).c + $(UNICODENORMALIZE).c \ + $(WIN32_DIR).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -770,7 +773,8 @@ EXTENSION_DLL = \ $(PERLIOVIA_DLL) \ $(XSAPITEST_DLL) \ $(XSTYPEMAP_DLL) \ - $(UNICODENORMALIZE_DLL) + $(UNICODENORMALIZE_DLL) \ + $(WIN32_DLL) POD2HTML = $(PODDIR)\pod2html POD2MAN = $(PODDIR)\pod2man @@ -961,16 +965,19 @@ $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs #---------------------------------------------------------------------------------- Extensions: buildext.pl $(PERLDEP) $(CONFIGPM) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) + $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext # Note: The next two targets explicitly remove a "blibdirs.exists" file that # currerntly gets left behind, until CPAN RT Ticket #5616 is resolved. Extensions_clean: -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean + -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean -if exist $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists del /f $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists Extensions_realclean: -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) realclean + -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean -if exist $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists del /f $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists #---------------------------------------------------------------------------------- @@ -1067,6 +1074,7 @@ distclean: realclean -del /f $(LIBDIR)\threads\shared.pm -del /f $(LIBDIR)\Time\HiRes.pm -del /f $(LIBDIR)\Unicode\Normalize.pm + -del /f $(LIBDIR)\Win32.pm -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO -if exist $(LIBDIR)\IO rmdir /s $(LIBDIR)\IO -if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B diff --git a/win32/ext/Win32/Makefile.PL b/win32/ext/Win32/Makefile.PL new file mode 100644 index 0000000..c167ab3 --- /dev/null +++ b/win32/ext/Win32/Makefile.PL @@ -0,0 +1,6 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Win32', + VERSION_FROM => 'Win32.pm', +); diff --git a/win32/ext/Win32/Win32.pm b/win32/ext/Win32/Win32.pm new file mode 100644 index 0000000..02e72bc --- /dev/null +++ b/win32/ext/Win32/Win32.pm @@ -0,0 +1,689 @@ +package Win32; + +BEGIN { + use strict; + use vars qw|$VERSION @ISA @EXPORT @EXPORT_OK|; + + require Exporter; + require DynaLoader; + + @ISA = qw|Exporter DynaLoader|; + $VERSION = '0.23'; + + @EXPORT = qw( + NULL + WIN31_CLASS + OWNER_SECURITY_INFORMATION + GROUP_SECURITY_INFORMATION + DACL_SECURITY_INFORMATION + SACL_SECURITY_INFORMATION + MB_ICONHAND + MB_ICONQUESTION + MB_ICONEXCLAMATION + MB_ICONASTERISK + MB_ICONWARNING + MB_ICONERROR + MB_ICONINFORMATION + MB_ICONSTOP + ); + @EXPORT_OK = qw( + GetOSName + SW_HIDE + SW_SHOWNORMAL + SW_SHOWMINIMIZED + SW_SHOWMAXIMIZED + SW_SHOWNOACTIVATE + + CSIDL_DESKTOP + CSIDL_PROGRAMS + CSIDL_PERSONAL + CSIDL_FAVORITES + CSIDL_STARTUP + CSIDL_RECENT + CSIDL_SENDTO + CSIDL_STARTMENU + CSIDL_MYMUSIC + CSIDL_MYVIDEO + CSIDL_DESKTOPDIRECTORY + CSIDL_NETHOOD + CSIDL_FONTS + CSIDL_TEMPLATES + CSIDL_COMMON_STARTMENU + CSIDL_COMMON_PROGRAMS + CSIDL_COMMON_STARTUP + CSIDL_COMMON_DESKTOPDIRECTORY + CSIDL_APPDATA + CSIDL_PRINTHOOD + CSIDL_LOCAL_APPDATA + CSIDL_COMMON_FAVORITES + CSIDL_INTERNET_CACHE + CSIDL_COOKIES + CSIDL_HISTORY + CSIDL_COMMON_APPDATA + CSIDL_WINDOWS + CSIDL_SYSTEM + CSIDL_PROGRAM_FILES + CSIDL_MYPICTURES + CSIDL_PROFILE + CSIDL_PROGRAM_FILES_COMMON + CSIDL_COMMON_TEMPLATES + CSIDL_COMMON_DOCUMENTS + CSIDL_COMMON_ADMINTOOLS + CSIDL_ADMINTOOLS + CSIDL_COMMON_MUSIC + CSIDL_COMMON_PICTURES + CSIDL_COMMON_VIDEO + CSIDL_RESOURCES + CSIDL_RESOURCES_LOCALIZED + CSIDL_CDBURN_AREA + ); +} + +# Routines available in core: +# Win32::GetLastError +# Win32::LoginName +# Win32::NodeName +# Win32::DomainName +# Win32::FsType +# Win32::GetCwd +# Win32::GetOSVersion +# Win32::FormatMessage ERRORCODE +# Win32::Spawn COMMAND, ARGS, PID +# Win32::GetTickCount +# Win32::IsWinNT +# Win32::IsWin95 + +# We won't bother with the constant stuff, too much of a hassle. Just hard +# code it here. + +sub NULL { 0 } +sub WIN31_CLASS { &NULL } + +sub OWNER_SECURITY_INFORMATION { 0x00000001 } +sub GROUP_SECURITY_INFORMATION { 0x00000002 } +sub DACL_SECURITY_INFORMATION { 0x00000004 } +sub SACL_SECURITY_INFORMATION { 0x00000008 } + +sub MB_ICONHAND { 0x00000010 } +sub MB_ICONQUESTION { 0x00000020 } +sub MB_ICONEXCLAMATION { 0x00000030 } +sub MB_ICONASTERISK { 0x00000040 } +sub MB_ICONWARNING { 0x00000030 } +sub MB_ICONERROR { 0x00000010 } +sub MB_ICONINFORMATION { 0x00000040 } +sub MB_ICONSTOP { 0x00000010 } + +# +# Newly added constants. These have an empty prototype, unlike the +# the ones above, which aren't prototyped for compatibility reasons. +# +sub SW_HIDE () { 0 } +sub SW_SHOWNORMAL () { 1 } +sub SW_SHOWMINIMIZED () { 2 } +sub SW_SHOWMAXIMIZED () { 3 } +sub SW_SHOWNOACTIVATE () { 4 } + +sub CSIDL_DESKTOP () { 0x0000 } # +sub CSIDL_PROGRAMS () { 0x0002 } # Start Menu\Programs +sub CSIDL_PERSONAL () { 0x0005 } # "My Documents" folder +sub CSIDL_FAVORITES () { 0x0006 } # \Favorites +sub CSIDL_STARTUP () { 0x0007 } # Start Menu\Programs\Startup +sub CSIDL_RECENT () { 0x0008 } # \Recent +sub CSIDL_SENDTO () { 0x0009 } # \SendTo +sub CSIDL_STARTMENU () { 0x000B } # \Start Menu +sub CSIDL_MYMUSIC () { 0x000D } # "My Music" folder +sub CSIDL_MYVIDEO () { 0x000E } # "My Videos" folder +sub CSIDL_DESKTOPDIRECTORY () { 0x0010 } # \Desktop +sub CSIDL_NETHOOD () { 0x0013 } # \nethood +sub CSIDL_FONTS () { 0x0014 } # windows\fonts +sub CSIDL_TEMPLATES () { 0x0015 } +sub CSIDL_COMMON_STARTMENU () { 0x0016 } # All Users\Start Menu +sub CSIDL_COMMON_PROGRAMS () { 0x0017 } # All Users\Start Menu\Programs +sub CSIDL_COMMON_STARTUP () { 0x0018 } # All Users\Startup +sub CSIDL_COMMON_DESKTOPDIRECTORY () { 0x0019 } # All Users\Desktop +sub CSIDL_APPDATA () { 0x001A } # Application Data, new for NT4 +sub CSIDL_PRINTHOOD () { 0x001B } # \PrintHood +sub CSIDL_LOCAL_APPDATA () { 0x001C } # non roaming, user\Local Settings\Application Data +sub CSIDL_COMMON_FAVORITES () { 0x001F } +sub CSIDL_INTERNET_CACHE () { 0x0020 } +sub CSIDL_COOKIES () { 0x0021 } +sub CSIDL_HISTORY () { 0x0022 } +sub CSIDL_COMMON_APPDATA () { 0x0023 } # All Users\Application Data +sub CSIDL_WINDOWS () { 0x0024 } # GetWindowsDirectory() +sub CSIDL_SYSTEM () { 0x0025 } # GetSystemDirectory() +sub CSIDL_PROGRAM_FILES () { 0x0026 } # C:\Program Files +sub CSIDL_MYPICTURES () { 0x0027 } # "My Pictures", new for Win2K +sub CSIDL_PROFILE () { 0x0028 } # USERPROFILE +sub CSIDL_PROGRAM_FILES_COMMON () { 0x002B } # C:\Program Files\Common +sub CSIDL_COMMON_TEMPLATES () { 0x002D } # All Users\Templates +sub CSIDL_COMMON_DOCUMENTS () { 0x002E } # All Users\Documents +sub CSIDL_COMMON_ADMINTOOLS () { 0x002F } # All Users\Start Menu\Programs\Administrative Tools +sub CSIDL_ADMINTOOLS () { 0x0030 } # \Start Menu\Programs\Administrative Tools +sub CSIDL_COMMON_MUSIC () { 0x0035 } # All Users\My Music +sub CSIDL_COMMON_PICTURES () { 0x0036 } # All Users\My Pictures +sub CSIDL_COMMON_VIDEO () { 0x0037 } # All Users\My Video +sub CSIDL_RESOURCES () { 0x0038 } # %windir%\Resources\, For theme and other windows resources. +sub CSIDL_RESOURCES_LOCALIZED () { 0x0039 } # %windir%\Resources\, for theme and other windows specific resources. +sub CSIDL_CDBURN_AREA () { 0x003B } # \Local Settings\Application Data\Microsoft\CD Burning + +### This method is just a simple interface into GetOSVersion(). More +### specific or demanding situations should use that instead. + +my ($found_os, $found_desc); + +sub GetOSName { + my ($os,$desc,$major, $minor, $build, $id)=("",""); + unless (defined $found_os) { + # If we have a run this already, we have the results cached + # If so, return them + + # Use the standard API call to determine the version + ($desc, $major, $minor, $build, $id) = Win32::GetOSVersion(); + + # If id==0 then its a win32s box -- Meaning Win3.11 + unless($id) { + $os = 'Win32s'; + } + else { + # Magic numbers from MSDN documentation of OSVERSIONINFO + # Most version names can be parsed from just the id and minor + # version + $os = { + 1 => { + 0 => "95", + 10 => "98", + 90 => "Me" + }, + 2 => { + 0 => "2000", + 1 => "XP/.Net", + 2 => "2003", + 51 => "NT3.51" + } + }->{$id}->{$minor}; + } + + # This _really_ shouldnt happen. At least not for quite a while + # Politely warn and return undef + unless (defined $os) { + warn qq[Windows version [$id:$major:$minor] unknown!]; + return undef; + } + + my $tag = ""; + + # But distinguising W2k from NT4 requires looking at the major version + if ($os eq "2000" && $major != 5) { + $os = "NT4"; + } + + # For the rest we take a look at the build numbers and try to deduce + # the exact release name, but we put that in the $desc + elsif ($os eq "95") { + if ($build eq '67109814') { + $tag = '(a)'; + } + elsif ($build eq '67306684') { + $tag = '(b1)'; + } + elsif ($build eq '67109975') { + $tag = '(b2)'; + } + } + elsif ($os eq "98" && $build eq '67766446') { + $tag = '(2nd ed)'; + } + + if (length $tag) { + if (length $desc) { + $desc = "$tag $desc"; + } + else { + $desc = $tag; + } + } + + # cache the results, so we dont have to do this again + $found_os = "Win$os"; + $found_desc = $desc; + } + + return wantarray ? ($found_os, $found_desc) : $found_os; +} + +bootstrap Win32; + +1; + +__END__ + +=head1 NAME + +Win32 - Interfaces to some Win32 API Functions + +=head1 DESCRIPTION + +Perl on Win32 contains several functions to access Win32 APIs. Some +are included in Perl itself (on Win32) and some are only available +after explicitly requesting the Win32 module with: + + use Win32; + +The builtin functions are marked as [CORE] and the other ones +as [EXT] in the following alphabetical listing. + +=head2 Alphabetical Listing of Win32 Functions + +=over + +=item Win32::AbortSystemShutdown(MACHINE) + +[EXT] Aborts a system shutdown (started by the +InitiateSystemShutdown function) on the specified MACHINE. + +=item Win32::BuildNumber() + +[CORE] Returns the ActivePerl build number. This function is +only available in the ActivePerl binary distribution. + +=item Win32::CopyFile(FROM, TO, OVERWRITE) + +[CORE] The Win32::CopyFile() function copies an existing file to a new +file. All file information like creation time and file attributes will +be copied to the new file. However it will B copy the security +information. If the destination file already exists it will only be +overwritten when the OVERWRITE parameter is true. But even this will +not overwrite a read-only file; you have to unlink() it first +yourself. + +=item Win32::DomainName() + +[CORE] Returns the name of the Microsoft Network domain that the +owner of the current perl process is logged into. This function does +B work on Windows 9x. + +=item Win32::ExpandEnvironmentStrings(STRING) + +[EXT] Takes STRING and replaces all referenced environment variable +names with their defined values. References to environment variables +take the form C<%VariableName%>. Case is ignored when looking up the +VariableName in the environment. If the variable is not found then the +original C<%VariableName%> text is retained. Has the same effect +as the following: + + $string =~ s/%([^%]*)%/$ENV{$1} || "%$1%"/eg + +=item Win32::FormatMessage(ERRORCODE) + +[CORE] Converts the supplied Win32 error number (e.g. returned by +Win32::GetLastError()) to a descriptive string. Analogous to the +perror() standard-C library function. Note that C<$^E> used +in a string context has much the same effect. + + C:\> perl -e "$^E = 26; print $^E;" + The specified disk or diskette cannot be accessed + +=item Win32::FsType() + +[CORE] Returns the name of the filesystem of the currently active +drive (like 'FAT' or 'NTFS'). In list context it returns three values: +(FSTYPE, FLAGS, MAXCOMPLEN). FSTYPE is the filesystem type as +before. FLAGS is a combination of values of the following table: + + 0x00000001 supports case-sensitive filenames + 0x00000002 preserves the case of filenames + 0x00000004 supports Unicode in filenames + 0x00000008 preserves and enforces ACLs + 0x00000010 supports file-based compression + 0x00000020 supports disk quotas + 0x00000040 supports sparse files + 0x00000080 supports reparse points + 0x00000100 supports remote storage + 0x00008000 is a compressed volume (e.g. DoubleSpace) + 0x00010000 supports object identifiers + 0x00020000 supports the Encrypted File System (EFS) + +MAXCOMPLEN is the maximum length of a filename component (the part +between two backslashes) on this file system. + +=item Win32::FreeLibrary(HANDLE) + +[EXT] Unloads a previously loaded dynamic-link library. The HANDLE is +no longer valid after this call. See L +for information on dynamically loading a library. + +=item Win32::GetArchName() + +[EXT] Use of this function is deprecated. It is equivalent with +$ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X. + +=item Win32::GetChipName() + +[EXT] Returns the processor type: 386, 486 or 586 for Intel processors, +21064 for the Alpha chip. + +=item Win32::GetCwd() + +[CORE] Returns the current active drive and directory. This function +does not return a UNC path, since the functionality required for such +a feature is not available under Windows 95. + +=item Win32::GetFolderPath(FOLDER [, CREATE]) + +[EXT] Returns the full pathname of one of the Windows special folders. +The folder will be created if it doesn't exist and the optional CREATE +argument is true. The following FOLDER constants are defined by the +Win32 module, but only exported on demand: + + CSIDL_ADMINTOOLS + CSIDL_APPDATA + CSIDL_CDBURN_AREA + CSIDL_COMMON_ADMINTOOLS + CSIDL_COMMON_APPDATA + CSIDL_COMMON_DESKTOPDIRECTORY + CSIDL_COMMON_DOCUMENTS + CSIDL_COMMON_FAVORITES + CSIDL_COMMON_MUSIC + CSIDL_COMMON_PICTURES + CSIDL_COMMON_PROGRAMS + CSIDL_COMMON_STARTMENU + CSIDL_COMMON_STARTUP + CSIDL_COMMON_TEMPLATES + CSIDL_COMMON_VIDEO + CSIDL_COOKIES + CSIDL_DESKTOP + CSIDL_DESKTOPDIRECTORY + CSIDL_FAVORITES + CSIDL_FONTS + CSIDL_HISTORY + CSIDL_INTERNET_CACHE + CSIDL_LOCAL_APPDATA + CSIDL_MYMUSIC + CSIDL_MYPICTURES + CSIDL_MYVIDEO + CSIDL_NETHOOD + CSIDL_PERSONAL + CSIDL_PRINTHOOD + CSIDL_PROFILE + CSIDL_PROGRAMS + CSIDL_PROGRAM_FILES + CSIDL_PROGRAM_FILES_COMMON + CSIDL_RECENT + CSIDL_RESOURCES + CSIDL_RESOURCES_LOCALIZED + CSIDL_SENDTO + CSIDL_STARTMENU + CSIDL_STARTUP + CSIDL_SYSTEM + CSIDL_TEMPLATES + CSIDL_WINDOWS + +Note that not all folders are defined on all versions of Windows. + +Please refer to the MSDN documentation of the CSIDL constants, +currently available at: + +http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/enums/csidl.asp + +=item Win32::GetFullPathName(FILENAME) + +[CORE] GetFullPathName combines the FILENAME with the current drive +and directory name and returns a fully qualified (aka, absolute) +path name. In list context it returns two elements: (PATH, FILE) where +PATH is the complete pathname component (including trailing backslash) +and FILE is just the filename part. Note that no attempt is made to +convert 8.3 components in the supplied FILENAME to longnames or +vice-versa. Compare with Win32::GetShortPathName and +Win32::GetLongPathName. + +=item Win32::GetLastError() + +[CORE] Returns the last error value generated by a call to a Win32 API +function. Note that C<$^E> used in a numeric context amounts to the +same value. + +=item Win32::GetLongPathName(PATHNAME) + +[CORE] Returns a representation of PATHNAME composed of longname +components (if any). The result may not necessarily be longer +than PATHNAME. No attempt is made to convert PATHNAME to the +absolute path. Compare with Win32::GetShortPathName and +Win32::GetFullPathName. + +=item Win32::GetNextAvailDrive() + +[CORE] Returns a string in the form of ":" where is the first +available drive letter. + +=item Win32::GetOSVersion() + +[CORE] Returns the list (STRING, MAJOR, MINOR, BUILD, ID), where the +elements are, respectively: An arbitrary descriptive string, the major +version number of the operating system, the minor version number, the +build number, and a digit indicating the actual operating system. +For the ID, the values are 0 for Win32s, 1 for Windows 9X/Me and 2 for +Windows NT/2000/XP/2003. In scalar context it returns just the ID. + +Currently known values for ID MAJOR and MINOR are as follows: + + OS ID MAJOR MINOR + Win32s 0 - - + Windows 95 1 4 0 + Windows 98 1 4 10 + Windows Me 1 4 90 + Windows NT 3.51 2 3 51 + Windows NT 4 2 4 0 + Windows 2000 2 5 0 + Windows XP 2 5 1 + Windows Server 2003 2 5 2 + +On Windows NT 4 SP6 and later this function returns the following +additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE. + +SPMAJOR and SPMINOR are are the version numbers of the latest +installed service pack. + +SUITEMASK is a bitfield identifying the product suites available on +the system. Known bits are: + + VER_SUITE_SMALLBUSINESS 0x00000001 + VER_SUITE_ENTERPRISE 0x00000002 + VER_SUITE_BACKOFFICE 0x00000004 + VER_SUITE_COMMUNICATIONS 0x00000008 + VER_SUITE_TERMINAL 0x00000010 + VER_SUITE_SMALLBUSINESS_RESTRICTED 0x00000020 + VER_SUITE_EMBEDDEDNT 0x00000040 + VER_SUITE_DATACENTER 0x00000080 + VER_SUITE_SINGLEUSERTS 0x00000100 + VER_SUITE_PERSONAL 0x00000200 + VER_SUITE_BLADE 0x00000400 + VER_SUITE_EMBEDDED_RESTRICTED 0x00000800 + VER_SUITE_SECURITY_APPLIANCE 0x00001000 + +The VER_SUITE_xxx names are listed here to crossreference the Microsoft +documentation. The Win32 module does not provide symbolic names for these +constants. + +PRODUCTTYPE provides additional information about the system. It should +be one of the following integer values: + + 1 - Workstation (NT 4, 2000 Pro, XP Home, XP Pro) + 2 - Domaincontroller + 3 - Server + +=item Win32::GetOSName() + +[EXT] In scalar context returns the name of the Win32 operating system +being used. In list context returns a two element list of the OS name +and whatever edition information is known about the particular build +(for Win9X boxes) and whatever service packs have been installed. +The latter is roughly equivalent to the first item returned by +GetOSVersion() in list context. + +Currently the possible values for the OS name are + + Win32s Win95 Win98 WinMe WinNT3.51 WinNT4 Win2000 WinXP/.Net Win2003 + +This routine is just a simple interface into GetOSVersion(). More +specific or demanding situations should use that instead. Another +option would be to use POSIX::uname(), however the latter appears to +report only the OS family name and not the specific OS. In scalar +context it returns just the ID. + +The name "WinXP/.Net" is used for historical reasons only, to maintain +backwards compatibility of the Win32 module. Windows .NET Server has +been renamed as Windows 2003 Server before final release and uses a +different major/minor version number than Windows XP. + +=item Win32::GetShortPathName(PATHNAME) + +[CORE] Returns a representation of PATHNAME composed only of +short (8.3) path components. The result may not necessarily be +shorter than PATHNAME. Compare with Win32::GetFullPathName and +Win32::GetLongPathName. + +=item Win32::GetProcAddress(INSTANCE, PROCNAME) + +[EXT] Returns the address of a function inside a loaded library. The +information about what you can do with this address has been lost in +the mist of time. Use the Win32::API module instead of this deprecated +function. + +=item Win32::GetTickCount() + +[CORE] Returns the number of milliseconds elapsed since the last +system boot. Resolution is limited to system timer ticks (about 10ms +on WinNT and 55ms on Win9X). + +=item Win32::InitiateSystemShutdown + +(MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT) + +[EXT] Shutsdown the specified MACHINE, notifying users with the +supplied MESSAGE, within the specified TIMEOUT interval. Forces +closing of all documents without prompting the user if FORCECLOSE is +true, and reboots the machine if REBOOT is true. This function works +only on WinNT. + +=item Win32::IsAdminUser() + +[EXT] Returns non zero if the account in whose security context the +current process/thread is running belongs to the local group of +Administrators in the built-in system domain; returns 0 if not. +Returns the undefined value and prints a warning if an error occurred. +This function always returns 1 on Win9X. + +=item Win32::IsWinNT() + +[CORE] Returns non zero if the Win32 subsystem is Windows NT. + +=item Win32::IsWin95() + +[CORE] Returns non zero if the Win32 subsystem is Windows 95. + +=item Win32::LoadLibrary(LIBNAME) + +[EXT] Loads a dynamic link library into memory and returns its module +handle. This handle can be used with Win32::GetProcAddress and +Win32::FreeLibrary. This function is deprecated. Use the Win32::API +module instead. + +=item Win32::LoginName() + +[CORE] Returns the username of the owner of the current perl process. + +=item Win32::LookupAccountName(SYSTEM, ACCOUNT, DOMAIN, SID, SIDTYPE) + +[EXT] Looks up ACCOUNT on SYSTEM and returns the domain name the SID and +the SID type. + +=item Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE) + +[EXT] Looks up SID on SYSTEM and returns the account name, domain name, +and the SID type. + +=item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]]) + +[EXT] Create a dialogbox containing MESSAGE. FLAGS specifies the +required icon and buttons according to the following table: + + 0 = OK + 1 = OK and Cancel + 2 = Abort, Retry, and Ignore + 3 = Yes, No and Cancel + 4 = Yes and No + 5 = Retry and Cancel + + MB_ICONSTOP "X" in a red circle + MB_ICONQUESTION question mark in a bubble + MB_ICONEXCLAMATION exclamation mark in a yellow triangle + MB_ICONINFORMATION "i" in a bubble + +TITLE specifies an optional window title. The default is "Perl". + +The function returns the menu id of the selected push button: + + 0 Error + + 1 OK + 2 Cancel + 3 Abort + 4 Retry + 5 Ignore + 6 Yes + 7 No + +=item Win32::NodeName() + +[CORE] Returns the Microsoft Network node-name of the current machine. + +=item Win32::RegisterServer(LIBRARYNAME) + +[EXT] Loads the DLL LIBRARYNAME and calls the function DllRegisterServer. + +=item Win32::SetChildShowWindow(SHOWWINDOW) + +[CORE] Sets the I of child processes started by system(). +By default system() will create a new console window for child +processes if Perl itself is not running from a console. Calling +SetChildShowWindow(0) will make these new console windows invisible. +Calling SetChildShowWindow() without arguments reverts system() to the +default behavior. The return value of SetChildShowWindow() is the +previous setting or C. + +[EXT] The following symbolic constants for SHOWWINDOW are available +(but not exported) from the Win32 module: SW_HIDE, SW_SHOWNORMAL, +SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED and SW_SHOWNOACTIVATE. + +=item Win32::SetCwd(NEWDIRECTORY) + +[CORE] Sets the current active drive and directory. This function does not +work with UNC paths, since the functionality required to required for +such a feature is not available under Windows 95. + +=item Win32::SetLastError(ERROR) + +[CORE] Sets the value of the last error encountered to ERROR. This is +that value that will be returned by the Win32::GetLastError() +function. + +=item Win32::Sleep(TIME) + +[CORE] Pauses for TIME milliseconds. The timeslices are made available +to other processes and threads. + +=item Win32::Spawn(COMMAND, ARGS, PID) + +[CORE] Spawns a new process using the supplied COMMAND, passing in +arguments in the string ARGS. The pid of the new process is stored in +PID. This function is deprecated. Please use the Win32::Process module +instead. + +=item Win32::UnregisterServer(LIBRARYNAME) + +[EXT] Loads the DLL LIBRARYNAME and calls the function +DllUnregisterServer. + +=back + +=cut diff --git a/win32/ext/Win32/Win32.xs b/win32/ext/Win32/Win32.xs new file mode 100644 index 0000000..e15fc81 --- /dev/null +++ b/win32/ext/Win32/Win32.xs @@ -0,0 +1,652 @@ +#include + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege" +#define SE_SHUTDOWN_NAMEW L"SeShutdownPrivilege" + +typedef BOOL (WINAPI *PFNSHGetSpecialFolderPath)(HWND, char*, int, BOOL); +typedef HRESULT (WINAPI *PFNSHGetFolderPath)(HWND, int, HANDLE, DWORD, LPTSTR); +#ifndef CSIDL_FLAG_CREATE +# define CSIDL_FLAG_CREATE 0x8000 +#endif + +XS(w32_ExpandEnvironmentStrings) +{ + dXSARGS; + char *lpSource; + BYTE buffer[4096]; + DWORD dwDataLen; + STRLEN n_a; + + if (items != 1) + croak("usage: Win32::ExpandEnvironmentStrings($String);\n"); + + lpSource = (char *)SvPV(ST(0), n_a); + + if (USING_WIDE()) { + WCHAR wSource[MAX_PATH+1]; + WCHAR wbuffer[4096]; + A2WHELPER(lpSource, wSource, sizeof(wSource)); + dwDataLen = ExpandEnvironmentStringsW(wSource, wbuffer, sizeof(wbuffer)/2); + W2AHELPER(wbuffer, buffer, sizeof(buffer)); + } + else + dwDataLen = ExpandEnvironmentStringsA(lpSource, (char*)buffer, sizeof(buffer)); + + XSRETURN_PV((char*)buffer); +} + +XS(w32_IsAdminUser) +{ + dXSARGS; + HINSTANCE hAdvApi32; + BOOL (__stdcall *pfnOpenThreadToken)(HANDLE hThr, DWORD dwDesiredAccess, + BOOL bOpenAsSelf, PHANDLE phTok); + BOOL (__stdcall *pfnOpenProcessToken)(HANDLE hProc, DWORD dwDesiredAccess, + PHANDLE phTok); + BOOL (__stdcall *pfnGetTokenInformation)(HANDLE hTok, + TOKEN_INFORMATION_CLASS TokenInformationClass, + LPVOID lpTokInfo, DWORD dwTokInfoLen, + PDWORD pdwRetLen); + BOOL (__stdcall *pfnAllocateAndInitializeSid)( + PSID_IDENTIFIER_AUTHORITY pIdAuth, + BYTE nSubAuthCount, DWORD dwSubAuth0, + DWORD dwSubAuth1, DWORD dwSubAuth2, + DWORD dwSubAuth3, DWORD dwSubAuth4, + DWORD dwSubAuth5, DWORD dwSubAuth6, + DWORD dwSubAuth7, PSID pSid); + BOOL (__stdcall *pfnEqualSid)(PSID pSid1, PSID pSid2); + PVOID (__stdcall *pfnFreeSid)(PSID pSid); + HANDLE hTok; + DWORD dwTokInfoLen; + TOKEN_GROUPS *lpTokInfo; + SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY; + PSID pAdminSid; + int iRetVal; + unsigned int i; + OSVERSIONINFO osver; + + if (items) + croak("usage: Win32::IsAdminUser()"); + + /* There is no concept of "Administrator" user accounts on Win9x systems, + so just return true. */ + memset(&osver, 0, sizeof(OSVERSIONINFO)); + osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + GetVersionEx(&osver); + if (osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) + XSRETURN_YES; + + hAdvApi32 = LoadLibrary("advapi32.dll"); + if (!hAdvApi32) { + warn("Cannot load advapi32.dll library"); + XSRETURN_UNDEF; + } + + pfnOpenThreadToken = (BOOL (__stdcall *)(HANDLE, DWORD, BOOL, PHANDLE)) + GetProcAddress(hAdvApi32, "OpenThreadToken"); + pfnOpenProcessToken = (BOOL (__stdcall *)(HANDLE, DWORD, PHANDLE)) + GetProcAddress(hAdvApi32, "OpenProcessToken"); + pfnGetTokenInformation = (BOOL (__stdcall *)(HANDLE, + TOKEN_INFORMATION_CLASS, LPVOID, DWORD, PDWORD)) + GetProcAddress(hAdvApi32, "GetTokenInformation"); + pfnAllocateAndInitializeSid = (BOOL (__stdcall *)( + PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD, DWORD, DWORD, DWORD, + DWORD, DWORD, DWORD, PSID)) + GetProcAddress(hAdvApi32, "AllocateAndInitializeSid"); + pfnEqualSid = (BOOL (__stdcall *)(PSID, PSID)) + GetProcAddress(hAdvApi32, "EqualSid"); + pfnFreeSid = (PVOID (__stdcall *)(PSID)) + GetProcAddress(hAdvApi32, "FreeSid"); + + if (!(pfnOpenThreadToken && pfnOpenProcessToken && + pfnGetTokenInformation && pfnAllocateAndInitializeSid && + pfnEqualSid && pfnFreeSid)) + { + warn("Cannot load functions from advapi32.dll library"); + FreeLibrary(hAdvApi32); + XSRETURN_UNDEF; + } + + if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) { + if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) { + warn("Cannot open thread token or process token"); + FreeLibrary(hAdvApi32); + XSRETURN_UNDEF; + } + } + + pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen); + if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) { + warn("Cannot allocate token information structure"); + CloseHandle(hTok); + FreeLibrary(hAdvApi32); + XSRETURN_UNDEF; + } + + if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen, + &dwTokInfoLen)) + { + warn("Cannot get token information"); + Safefree(lpTokInfo); + CloseHandle(hTok); + FreeLibrary(hAdvApi32); + XSRETURN_UNDEF; + } + + if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, + DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid)) + { + warn("Cannot allocate administrators' SID"); + Safefree(lpTokInfo); + CloseHandle(hTok); + FreeLibrary(hAdvApi32); + XSRETURN_UNDEF; + } + + iRetVal = 0; + for (i = 0; i < lpTokInfo->GroupCount; ++i) { + if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) { + iRetVal = 1; + break; + } + } + + pfnFreeSid(pAdminSid); + Safefree(lpTokInfo); + CloseHandle(hTok); + FreeLibrary(hAdvApi32); + + EXTEND(SP, 1); + ST(0) = sv_2mortal(newSViv(iRetVal)); + XSRETURN(1); +} + +XS(w32_LookupAccountName) +{ + dXSARGS; + char SID[400]; + DWORD SIDLen; + SID_NAME_USE snu; + char Domain[256]; + DWORD DomLen; + STRLEN n_a; + BOOL bResult; + + if (items != 5) + croak("usage: Win32::LookupAccountName($system, $account, $domain, " + "$sid, $sidtype);\n"); + + SIDLen = sizeof(SID); + DomLen = sizeof(Domain); + + if (USING_WIDE()) { + WCHAR wSID[sizeof(SID)]; + WCHAR wDomain[sizeof(Domain)]; + WCHAR wSystem[MAX_PATH+1]; + WCHAR wAccount[MAX_PATH+1]; + A2WHELPER(SvPV(ST(0),n_a), wSystem, sizeof(wSystem)); + A2WHELPER(SvPV(ST(1),n_a), wAccount, sizeof(wAccount)); + bResult = LookupAccountNameW(wSystem, /* System */ + wAccount, /* Account name */ + &wSID, /* SID structure */ + &SIDLen, /* Size of SID buffer */ + wDomain, /* Domain buffer */ + &DomLen, /* Domain buffer size */ + &snu); /* SID name type */ + if (bResult) { + W2AHELPER(wSID, SID, SIDLen); + W2AHELPER(wDomain, Domain, DomLen); + } + } + else + bResult = LookupAccountNameA(SvPV(ST(0),n_a), /* System */ + SvPV(ST(1),n_a), /* Account name */ + &SID, /* SID structure */ + &SIDLen, /* Size of SID buffer */ + Domain, /* Domain buffer */ + &DomLen, /* Domain buffer size */ + &snu); /* SID name type */ + if (bResult) { + sv_setpv(ST(2), Domain); + sv_setpvn(ST(3), SID, SIDLen); + sv_setiv(ST(4), snu); + XSRETURN_YES; + } + else { + GetLastError(); + XSRETURN_NO; + } +} /* NTLookupAccountName */ + + +XS(w32_LookupAccountSID) +{ + dXSARGS; + PSID sid; + char Account[256]; + DWORD AcctLen = sizeof(Account); + char Domain[256]; + DWORD DomLen = sizeof(Domain); + SID_NAME_USE snu; + long retval; + STRLEN n_a; + BOOL bResult; + + if (items != 5) + croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n"); + + sid = SvPV(ST(1), n_a); + if (IsValidSid(sid)) { + if (USING_WIDE()) { + WCHAR wSID[sizeof(SID)]; + WCHAR wDomain[sizeof(Domain)]; + WCHAR wSystem[MAX_PATH+1]; + WCHAR wAccount[sizeof(Account)]; + A2WHELPER(SvPV(ST(0),n_a), wSystem, sizeof(wSystem)); + + bResult = LookupAccountSidW(wSystem, /* System */ + sid, /* SID structure */ + wAccount, /* Account name buffer */ + &AcctLen, /* name buffer length */ + wDomain, /* Domain buffer */ + &DomLen, /* Domain buffer length */ + &snu); /* SID name type */ + if (bResult) { + W2AHELPER(wAccount, Account, AcctLen); + W2AHELPER(wDomain, Domain, DomLen); + } + } + else + bResult = LookupAccountSidA(SvPV(ST(0),n_a), /* System */ + sid, /* SID structure */ + Account, /* Account name buffer */ + &AcctLen, /* name buffer length */ + Domain, /* Domain buffer */ + &DomLen, /* Domain buffer length */ + &snu); /* SID name type */ + if (bResult) { + sv_setpv(ST(2), Account); + sv_setpv(ST(3), Domain); + sv_setiv(ST(4), (IV)snu); + XSRETURN_YES; + } + else { + GetLastError(); + XSRETURN_NO; + } + } + else { + GetLastError(); + XSRETURN_NO; + } +} /* NTLookupAccountSID */ + +XS(w32_InitiateSystemShutdown) +{ + dXSARGS; + HANDLE hToken; /* handle to process token */ + TOKEN_PRIVILEGES tkp; /* pointer to token structure */ + BOOL bRet; + WCHAR wbuffer[MAX_PATH+1]; + char *machineName, *message; + STRLEN n_a; + + if (items != 5) + croak("usage: Win32::InitiateSystemShutdown($machineName, $message, " + "$timeOut, $forceClose, $reboot);\n"); + + machineName = SvPV(ST(0), n_a); + if (USING_WIDE()) { + A2WHELPER(machineName, wbuffer, sizeof(wbuffer)); + } + + if (OpenProcessToken(GetCurrentProcess(), + TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY, + &hToken)) + { + if (USING_WIDE()) + LookupPrivilegeValueW(wbuffer, + SE_SHUTDOWN_NAMEW, + &tkp.Privileges[0].Luid); + else + LookupPrivilegeValueA(machineName, + SE_SHUTDOWN_NAMEA, + &tkp.Privileges[0].Luid); + + tkp.PrivilegeCount = 1; /* only setting one */ + tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED; + + /* Get shutdown privilege for this process. */ + AdjustTokenPrivileges(hToken, FALSE, &tkp, 0, + (PTOKEN_PRIVILEGES)NULL, 0); + } + + message = SvPV(ST(1), n_a); + if (USING_WIDE()) { + WCHAR* pWBuf; + int length = strlen(message)+1; + New(0, pWBuf, length, WCHAR); + A2WHELPER(message, pWBuf, length*sizeof(WCHAR)); + bRet = InitiateSystemShutdownW(wbuffer, pWBuf, + SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4))); + Safefree(pWBuf); + } + else + bRet = InitiateSystemShutdownA(machineName, message, + SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4))); + + /* Disable shutdown privilege. */ + tkp.Privileges[0].Attributes = 0; + AdjustTokenPrivileges(hToken, FALSE, &tkp, 0, + (PTOKEN_PRIVILEGES)NULL, 0); + CloseHandle(hToken); + XSRETURN_IV(bRet); +} + +XS(w32_AbortSystemShutdown) +{ + dXSARGS; + HANDLE hToken; /* handle to process token */ + TOKEN_PRIVILEGES tkp; /* pointer to token structure */ + BOOL bRet; + char *machineName; + STRLEN n_a; + WCHAR wbuffer[MAX_PATH+1]; + + if (items != 1) + croak("usage: Win32::AbortSystemShutdown($machineName);\n"); + + machineName = SvPV(ST(0), n_a); + if (USING_WIDE()) { + A2WHELPER(machineName, wbuffer, sizeof(wbuffer)); + } + + if (OpenProcessToken(GetCurrentProcess(), + TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY, + &hToken)) + { + if (USING_WIDE()) + LookupPrivilegeValueW(wbuffer, + SE_SHUTDOWN_NAMEW, + &tkp.Privileges[0].Luid); + else + LookupPrivilegeValueA(machineName, + SE_SHUTDOWN_NAMEA, + &tkp.Privileges[0].Luid); + + tkp.PrivilegeCount = 1; /* only setting one */ + tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED; + + /* Get shutdown privilege for this process. */ + AdjustTokenPrivileges(hToken, FALSE, &tkp, 0, + (PTOKEN_PRIVILEGES)NULL, 0); + } + + if (USING_WIDE()) { + bRet = AbortSystemShutdownW(wbuffer); + } + else + bRet = AbortSystemShutdownA(machineName); + + /* Disable shutdown privilege. */ + tkp.Privileges[0].Attributes = 0; + AdjustTokenPrivileges(hToken, FALSE, &tkp, 0, + (PTOKEN_PRIVILEGES)NULL, 0); + CloseHandle(hToken); + XSRETURN_IV(bRet); +} + + +XS(w32_MsgBox) +{ + dXSARGS; + char *msg; + char *title = "Perl"; + DWORD flags = MB_ICONEXCLAMATION; + STRLEN n_a; + I32 result; + + if (items < 1 || items > 3) + croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n"); + + msg = SvPV(ST(0), n_a); + if (items > 1) { + flags = SvIV(ST(1)); + if (items > 2) + title = SvPV(ST(2), n_a); + } + if (USING_WIDE()) { + WCHAR* pMsg; + WCHAR* pTitle; + int length; + length = strlen(msg)+1; + New(0, pMsg, length, WCHAR); + A2WHELPER(msg, pMsg, length*sizeof(WCHAR)); + length = strlen(title)+1; + New(0, pTitle, length, WCHAR); + A2WHELPER(title, pTitle, length*sizeof(WCHAR)); + result = MessageBoxW(GetActiveWindow(), pMsg, pTitle, flags); + Safefree(pMsg); + Safefree(pTitle); + } + else + result = MessageBoxA(GetActiveWindow(), msg, title, flags); + + XSRETURN_IV(result); +} + +XS(w32_LoadLibrary) +{ + dXSARGS; + STRLEN n_a; + HANDLE hHandle; + char* lpName; + + if (items != 1) + croak("usage: Win32::LoadLibrary($libname)\n"); + lpName = (char *)SvPV(ST(0),n_a); + if (USING_WIDE()) { + WCHAR wbuffer[MAX_PATH+1]; + A2WHELPER(lpName, wbuffer, sizeof(wbuffer)); + hHandle = LoadLibraryW(wbuffer); + } + else + hHandle = LoadLibraryA(lpName); + XSRETURN_IV((long)hHandle); +} + +XS(w32_FreeLibrary) +{ + dXSARGS; + if (items != 1) + croak("usage: Win32::FreeLibrary($handle)\n"); + if (FreeLibrary((HINSTANCE) SvIV(ST(0)))) { + XSRETURN_YES; + } + XSRETURN_NO; +} + +XS(w32_GetProcAddress) +{ + dXSARGS; + STRLEN n_a; + if (items != 2) + croak("usage: Win32::GetProcAddress($hinstance, $procname)\n"); + XSRETURN_IV((long)GetProcAddress((HINSTANCE)SvIV(ST(0)), SvPV(ST(1), n_a))); +} + +XS(w32_RegisterServer) +{ + dXSARGS; + BOOL result = FALSE; + HINSTANCE hnd; + FARPROC func; + STRLEN n_a; + char* lpName; + + if (items != 1) + croak("usage: Win32::RegisterServer($libname)\n"); + + lpName = SvPV(ST(0),n_a); + if (USING_WIDE()) { + WCHAR wbuffer[MAX_PATH+1]; + A2WHELPER(lpName, wbuffer, sizeof(wbuffer)); + hnd = LoadLibraryW(wbuffer); + } + else + hnd = LoadLibraryA(lpName); + + if (hnd) { + func = GetProcAddress(hnd, "DllRegisterServer"); + if (func && func() == 0) + result = TRUE; + FreeLibrary(hnd); + } + if (result) + XSRETURN_YES; + else + XSRETURN_NO; +} + +XS(w32_UnregisterServer) +{ + dXSARGS; + BOOL result = FALSE; + HINSTANCE hnd; + FARPROC func; + STRLEN n_a; + char* lpName; + + if (items != 1) + croak("usage: Win32::UnregisterServer($libname)\n"); + + lpName = SvPV(ST(0),n_a); + if (USING_WIDE()) { + WCHAR wbuffer[MAX_PATH+1]; + A2WHELPER(lpName, wbuffer, sizeof(wbuffer)); + hnd = LoadLibraryW(wbuffer); + } + else + hnd = LoadLibraryA(lpName); + + if (hnd) { + func = GetProcAddress(hnd, "DllUnregisterServer"); + if (func && func() == 0) + result = TRUE; + FreeLibrary(hnd); + } + if (result) + XSRETURN_YES; + else + XSRETURN_NO; +} + +/* XXX rather bogus */ +XS(w32_GetArchName) +{ + dXSARGS; + XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE")); +} + +XS(w32_GetChipName) +{ + dXSARGS; + SYSTEM_INFO sysinfo; + + Zero(&sysinfo,1,SYSTEM_INFO); + GetSystemInfo(&sysinfo); + /* XXX docs say dwProcessorType is deprecated on NT */ + XSRETURN_IV(sysinfo.dwProcessorType); +} + +XS(w32_GuidGen) +{ + dXSARGS; + GUID guid; + char szGUID[50] = {'\0'}; + HRESULT hr = CoCreateGuid(&guid); + + if (SUCCEEDED(hr)) { + LPOLESTR pStr = NULL; + StringFromCLSID(&guid, &pStr); + WideCharToMultiByte(CP_ACP, 0, pStr, wcslen(pStr), szGUID, + sizeof(szGUID), NULL, NULL); + + XSRETURN_PV(szGUID); + } + else + XSRETURN_UNDEF; +} + +XS(w32_GetFolderPath) +{ + dXSARGS; + char path[MAX_PATH+1]; + int folder; + int create = 0; + HMODULE module; + + if (items != 1 && items != 2) + croak("usage: Win32::GetFolderPath($csidl [, $create])\n"); + + folder = SvIV(ST(0)); + if (items == 2) + create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0; + + /* We are not bothering with USING_WIDE() anymore, + * because this is not how Unicode works with Perl. + * Nobody seems to use "perl -C" anyways. + */ + module = LoadLibrary("shfolder.dll"); + if (module) { + PFNSHGetFolderPath pfn; + pfn = (PFNSHGetFolderPath)GetProcAddress(module, "SHGetFolderPathA"); + if (pfn && SUCCEEDED(pfn(NULL, folder|create, NULL, 0, path))) { + FreeLibrary(module); + XSRETURN_PV(path); + } + FreeLibrary(module); + } + + module = LoadLibrary("shell32.dll"); + if (module) { + PFNSHGetSpecialFolderPath pfn; + pfn = (PFNSHGetSpecialFolderPath) + GetProcAddress(module, "SHGetSpecialFolderPathA"); + if (pfn && pfn(NULL, path, folder, !!create)) { + FreeLibrary(module); + XSRETURN_PV(path); + } + FreeLibrary(module); + } + XSRETURN_UNDEF; +} + +XS(boot_Win32) +{ + dXSARGS; + char *file = __FILE__; + + newXS("Win32::LookupAccountName", w32_LookupAccountName, file); + newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file); + newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file); + newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file); + newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file); + newXS("Win32::MsgBox", w32_MsgBox, file); + newXS("Win32::LoadLibrary", w32_LoadLibrary, file); + newXS("Win32::FreeLibrary", w32_FreeLibrary, file); + newXS("Win32::GetProcAddress", w32_GetProcAddress, file); + newXS("Win32::RegisterServer", w32_RegisterServer, file); + newXS("Win32::UnregisterServer", w32_UnregisterServer, file); + newXS("Win32::GetArchName", w32_GetArchName, file); + newXS("Win32::GetChipName", w32_GetChipName, file); + newXS("Win32::GuidGen", w32_GuidGen, file); + newXS("Win32::GetFolderPath", w32_GetFolderPath, file); + newXS("Win32::IsAdminUser", w32_IsAdminUser, file); + + XSRETURN_YES; +} diff --git a/win32/makefile.mk b/win32/makefile.mk index 78f45d0..3e326bd 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -787,7 +787,7 @@ DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ Sys/Hostname Storable Filter/Util/Call Encode \ Digest/MD5 PerlIO/scalar MIME/Base64 Time/HiRes \ - Unicode/Normalize + Unicode/Normalize Win32 STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -1101,16 +1101,19 @@ $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs #---------------------------------------------------------------------------------- Extensions : buildext.pl $(PERLDEP) $(CONFIGPM) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) + $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext # Note: The next two targets explicitly remove a "blibdirs.exists" file that # currerntly gets left behind, until CPAN RT Ticket #5616 is resolved. Extensions_clean : -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean + -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean -if exist $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists del /f $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists Extensions_realclean : -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) realclean + -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean -if exist $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists del /f $(EXTDIR)\SDBM_File\sdbm\blibdirs.exists #---------------------------------------------------------------------------------- @@ -1200,6 +1203,7 @@ distclean: realclean -del /f $(LIBDIR)\threads\shared.pm -del /f $(LIBDIR)\Time\HiRes.pm -del /f $(LIBDIR)\Unicode\Normalize.pm + -del /f $(LIBDIR)\Win32.pm -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO -if exist $(LIBDIR)\IO rmdir /s $(LIBDIR)\IO -if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B