This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[PATCH] Move Win32.pm/Win32.xs from libwin32 module to core Perl
authorNicholas Clark <nick@ccl4.org>
Fri, 19 Mar 2004 11:59:01 +0000 (11:59 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 19 Mar 2004 11:59:01 +0000 (11:59 +0000)
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

MANIFEST
win32/Makefile
win32/ext/Win32/Makefile.PL [new file with mode: 0644]
win32/ext/Win32/Win32.pm [moved from lib/Win32.pod with 51% similarity]
win32/ext/Win32/Win32.xs [new file with mode: 0644]
win32/makefile.mk

index 9d7b696..12134c8 100644 (file)
--- 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
index 711fbd6..65f0fa5 100644 (file)
@@ -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 (file)
index 0000000..c167ab3
--- /dev/null
@@ -0,0 +1,6 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME               => 'Win32',
+    VERSION_FROM       => 'Win32.pm',
+);
similarity index 51%
rename from lib/Win32.pod
rename to win32/ext/Win32/Win32.pm
index d0a6263..02e72bc 100644 (file)
+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 (file)
index 0000000..e15fc81
--- /dev/null
@@ -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;
+}
index 78f45d0..3e326bd 100644 (file)
@@ -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