summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2004-03-19 11:59:01 +0000
committerNicholas Clark <nick@ccl4.org>2004-03-19 11:59:01 +0000
commitb4ad57f4f7fe2aca6dc52ea357ce9be7a7d38769 (patch)
tree5b948b1e1896e64bc6df3f3b24c5a46eea0d6cd0
parent3f575d8d31d599e5462cda971d11111dea58e41f (diff)
downloadperl-b4ad57f4f7fe2aca6dc52ea357ce9be7a7d38769.tar.gz
[PATCH] Move Win32.pm/Win32.xs from libwin32 module to core Perl
From: Jan Dubois <jand@activestate.com> Message-ID: <lg2k509o51b8openotuetdts6go7pn4udo@4ax.com> 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 <steve.hay@uk.radan.com> Message-ID: <405ACC6D.1040804@uk.radan.com> Date: Fri, 19 Mar 2004 10:33:17 +0000 p4raw-id: //depot/perl@22537
-rw-r--r--MANIFEST4
-rw-r--r--win32/Makefile12
-rw-r--r--win32/ext/Win32/Makefile.PL6
-rw-r--r--win32/ext/Win32/Win32.pm (renamed from lib/Win32.pod)348
-rw-r--r--win32/ext/Win32/Win32.xs652
-rw-r--r--win32/makefile.mk6
6 files changed, 980 insertions, 48 deletions
diff --git a/MANIFEST b/MANIFEST
index 9d7b696109..12134c807d 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/win32/Makefile b/win32/Makefile
index 711fbd689c..65f0fa5506 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 0000000000..c167ab3704
--- /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/lib/Win32.pod b/win32/ext/Win32/Win32.pm
index d0a62633e6..02e72bc7e6 100644
--- a/lib/Win32.pod
+++ b/win32/ext/Win32/Win32.pm
@@ -1,20 +1,276 @@
+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 } # <desktop>
+sub CSIDL_PROGRAMS () { 0x0002 } # Start Menu\Programs
+sub CSIDL_PERSONAL () { 0x0005 } # "My Documents" folder
+sub CSIDL_FAVORITES () { 0x0006 } # <user name>\Favorites
+sub CSIDL_STARTUP () { 0x0007 } # Start Menu\Programs\Startup
+sub CSIDL_RECENT () { 0x0008 } # <user name>\Recent
+sub CSIDL_SENDTO () { 0x0009 } # <user name>\SendTo
+sub CSIDL_STARTMENU () { 0x000B } # <user name>\Start Menu
+sub CSIDL_MYMUSIC () { 0x000D } # "My Music" folder
+sub CSIDL_MYVIDEO () { 0x000E } # "My Videos" folder
+sub CSIDL_DESKTOPDIRECTORY () { 0x0010 } # <user name>\Desktop
+sub CSIDL_NETHOOD () { 0x0013 } # <user name>\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 } # <user name>\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 } # <user name>\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\<LangID>, for theme and other windows specific resources.
+sub CSIDL_CDBURN_AREA () { 0x003B } # <user name>\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
+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<Win32> 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.
+as [EXT] in the following alphabetical listing.
=head2 Alphabetical Listing of Win32 Functions
@@ -27,16 +283,16 @@ InitiateSystemShutdown function) on the specified MACHINE.
=item Win32::BuildNumber()
-[CORE] Returns the ActivePerl build number. This function is
+[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<not> 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
+file. All file information like creation time and file attributes will
+be copied to the new file. However it will B<not> 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.
@@ -49,9 +305,9 @@ B<not> 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
+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:
@@ -70,9 +326,9 @@ in a string context has much the same effect.
=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:
+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
@@ -92,14 +348,14 @@ 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<LoadLibrary|Win32::LoadLibrary(LIBNAME)>
+[EXT] Unloads a previously loaded dynamic-link library. The HANDLE is
+no longer valid after this call. See L<LoadLibrary|Win32::LoadLibrary(LIBNAME)>
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.
+[EXT] Use of this function is deprecated. It is equivalent with
+$ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X.
=item Win32::GetChipName()
@@ -108,7 +364,7 @@ $ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X.
=item Win32::GetCwd()
-[CORE] Returns the current active drive and directory. This function
+[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.
@@ -173,14 +429,12 @@ http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platfor
[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 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.
+Win32::GetLongPathName.
=item Win32::GetLastError()
@@ -196,8 +450,6 @@ 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 "<d>:" where <d> is the first
@@ -264,7 +516,7 @@ be one of the following integer values:
[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.
+(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.
@@ -292,15 +544,15 @@ Win32::GetLongPathName.
=item Win32::GetProcAddress(INSTANCE, PROCNAME)
-[EXT] Returns the address of a function inside a loaded library. The
+[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
+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
+system boot. Resolution is limited to system timer ticks (about 10ms
on WinNT and 55ms on Win9X).
=item Win32::InitiateSystemShutdown
@@ -308,11 +560,19 @@ on WinNT and 55ms on Win9X).
(MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT)
[EXT] Shutsdown the specified MACHINE, notifying users with the
-supplied MESSAGE, within the specified TIMEOUT interval. Forces
+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
+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.
@@ -324,8 +584,8 @@ only on WinNT.
=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
+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()
@@ -344,7 +604,7 @@ and the SID type.
=item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]])
-[EXT] Create a dialogbox containing MESSAGE. FLAGS specifies the
+[EXT] Create a dialogbox containing MESSAGE. FLAGS specifies the
required icon and buttons according to the following table:
0 = OK
@@ -359,7 +619,7 @@ required icon and buttons according to the following table:
MB_ICONEXCLAMATION exclamation mark in a yellow triangle
MB_ICONINFORMATION "i" in a bubble
-TITLE specifies an optional window title. The default is "Perl".
+TITLE specifies an optional window title. The default is "Perl".
The function returns the menu id of the selected push button:
@@ -385,7 +645,7 @@ The function returns the menu id of the selected push button:
[CORE] Sets the I<ShowMode> 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
+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
@@ -397,26 +657,26 @@ SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED and SW_SHOWNOACTIVATE.
=item Win32::SetCwd(NEWDIRECTORY)
-[CORE] Sets the current active drive and directory. This function does not
+[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
+[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.
+function.
=item Win32::Sleep(TIME)
-[CORE] Pauses for TIME milliseconds. The timeslices are made available
+[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
+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)
diff --git a/win32/ext/Win32/Win32.xs b/win32/ext/Win32/Win32.xs
new file mode 100644
index 0000000000..e15fc815ae
--- /dev/null
+++ b/win32/ext/Win32/Win32.xs
@@ -0,0 +1,652 @@
+#include <windows.h>
+
+#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 78f45d04b5..3e326bddc6 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