summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorJan Dubois <jand@activestate.com>2012-08-14 16:34:32 -0700
committerJan Dubois <jand@activestate.com>2012-08-15 00:33:13 -0700
commitc3c06741add2b0081dd06d45d21fdbfd0f45dd1f (patch)
tree3313a6f5b9a7bd2f09f452ad4ce2fbe234a68c09 /cpan
parentfd172611d1f859cac8b24983ce0841e6619e37c3 (diff)
downloadperl-c3c06741add2b0081dd06d45d21fdbfd0f45dd1f.tar.gz
Update to Win32-0.45 from CPAN
Diffstat (limited to 'cpan')
-rw-r--r--cpan/Win32/Changes360
-rw-r--r--cpan/Win32/Makefile.PL36
-rw-r--r--cpan/Win32/Win32.pm2441
-rw-r--r--cpan/Win32/Win32.xs3604
-rw-r--r--cpan/Win32/longpath.inc222
-rw-r--r--cpan/Win32/t/CodePage.t27
-rw-r--r--cpan/Win32/t/CreateFile.t62
-rw-r--r--cpan/Win32/t/ExpandEnvironmentStrings.t14
-rw-r--r--cpan/Win32/t/GetCurrentThreadId.t76
-rw-r--r--cpan/Win32/t/GetFileVersion.t36
-rw-r--r--cpan/Win32/t/GetFolderPath.t16
-rw-r--r--cpan/Win32/t/GetFullPathName.t68
-rw-r--r--cpan/Win32/t/GetLongPathName.t106
-rw-r--r--cpan/Win32/t/GetOSVersion.t22
-rw-r--r--cpan/Win32/t/GetShortPathName.t40
-rw-r--r--cpan/Win32/t/GuidGen.t30
-rw-r--r--cpan/Win32/t/Names.t112
-rw-r--r--cpan/Win32/t/Unicode.t175
18 files changed, 3790 insertions, 3657 deletions
diff --git a/cpan/Win32/Changes b/cpan/Win32/Changes
index dbbb4ff94e..900c1e845c 100644
--- a/cpan/Win32/Changes
+++ b/cpan/Win32/Changes
@@ -1,176 +1,184 @@
-Revision history for the Perl extension Win32.
-
-0.44 [2011-01-12]
- - fix memory leak introduced in 0.43
-
-0.43 [2011-01-12]
- - fix a few potential buffer overrun bugs reported by Alex Davies.
- [perl#78710]
-
-0.42 [2011-01-06]
- - remove brittle test for Win32::GetLongPathName($ENV{SYSTEMROOT})
- which will fail if the case of the environment value doesn't
- exactly match the case of the directory name on the filesystem.
-
-0.41 [2010-12-10]
- - Fix Win32::GetChipName() to return the native processor type when
- running 32-bit Perl on 64-bit Windows (WOW64). This will also
- affect the values returned by Win32::GetOSDisplayName() and
- Win32::GetOSName(). [rt#63797]
- - Fix Win32::GetOSDisplayName() to return the correct values for
- all products even when a service pack has been installed. (This
- was only an issue for some "special" editions).
- - The display name for "Windows 7 Business Edition" is actually
- "Windows 7 Professional".
- - Fix t/GetOSName.t tests to avoid using the values returned by
- GetSystemMetrics() when the test template didn't specify any
- value at all.
-
-0.40 [2010-12-08]
- - Add Win32::GetSystemMetrics function.
- - Add Win32::GetProductInfo() function.
- - Add Win32::GetOSDisplayName() function.
- - Detect "Windows Server 2008 R2" as "Win2008" in Win32::GetOSName()
- (used to return "Win7" before). [rt#57172]
- - Detect "Windows Home Server" as "WinHomeSvr" in Win32::GetOSName()
- (used to return "Win2003" before).
- - Add "R2", "Media Center", "Tablet PC", "Starter Edition" etc.
- tags to the description returned by Win32::GetOSName() in
- list context.
- - Rewrite the t/GetOSName.t tests
-
-0.39 [2009-01-19]
- - Add support for Windows 2008 Server and Windows 7 in
- Win32::GetOSName() and in the documentation for
- Win32::GetOSVersion().
- - Make Win32::GetOSName() implementation testable.
- - Document that the OSName for Win32s is actually "WinWin32s".
-
-0.38 [2008-06-27]
- - Fix Cygwin releated problems in t/GetCurrentThreadId.t
- (Jerry D. Hedden).
-
-0.37 [2008-06-26]
- - Add Win32::GetCurrentProcessId() function
-
-0.36 [2008-04-17]
- - Add typecasts for Win64 compilation
-
-0.35 [2008-03-31]
- Integrate changes from bleadperl:
- - Silence Borland compiler warning (Steve Hay)
- - Fix memory leak in Win32::GetOSVersion (Vincent Pit)
- - Test Win32::GetCurrentThreadId on cygwin (Reini Urban, Steve Hay)
-
-0.34 [2007-11-21]
- - Document "WinVista" return value for Win32::GetOSName()
- (Steve Hay).
-
-0.33 [2007-11-12]
- - Update version to 0.33 for Perl 5.10 release
- - Add $^O test in Makefile.PL for CPAN Testers
- - Use Win32::GetLastError() instead of $^E in t/Names.t for
- cygwin compatibility (Jerry D. Hedden).
-
-0.32 [2007-09-20]
- - Additional #define's for older versions of VC++ (Dmitry Karasik).
- - Win32::DomainName() doesn't return anything when the Workstation
- service isn't running. Set $^E and adapt t/Names.t accordingly
- (Steve Hay & Jerry D. Hedden).
- - Fix t/Names.t to allow Win32::GetOSName() to return an empty
- description as the 2nd return value (e.g. Vista without SP).
- - Fix t/GetFileVersion.t for Perl 5.10
-
-0.31 [2007-09-10]
- - Apply Cygwin fixes from bleadperl (from Jerry D. Hedden).
- - Make sure Win32::GetLongPathName() always returns drive
- letters in uppercase (Jerry D. Hedden).
- - Use uppercase environment variable names in t/Unicode.t
- because the MSWin32 doesn't care, and Cygwin only works
- with the uppercased version.
- - new t/Names.t test (from Sébastien Aperghis-Tramoni)
-
-0.30 [2007-06-25]
- - Fixed t/Unicode.t test for Cygwin (with help from Jerry D. Hedden).
- - Fixed and documented Win32::GetShortPathName() to return undef
- when the pathname doesn't exist (thanks to Steve Hay).
- - Added t/GetShortPathName.t
-
-0.29 [2007-05-17]
- - Fixed to compile with Borland BCC (thanks to Steve Hay).
-
-0.28_01 [2007-05-16]
- - Increase version number as 0.28 was already used by an ActivePerl
- release (for essentially 0.27 plus the Win32::IsAdminUser() change).
-
- - Add MODULE and PROTOTYPES directives to silence warnings from
- newer versions of xsubpp.
-
- - Use the Cygwin codepath in Win32::GetFullPathName() when
- PERL_IMPLICIT_SYS is not defined, because the other code
- relies on the virtualization code in win32/vdir.h.
-
-0.27_02 [2007-05-15]
- - We need Windows 2000 or later for the Unicode support because
- WC_NO_BEST_FIT_CHARS is not supported on Windows NT.
-
- - Fix Win32::GetFullPathName() on Windows NT to return an
- empty file part if the original argument ends with a slash.
-
-0.27_01 [2007-04-18]
- - Update Win32::IsAdminUser() to use the IsUserAnAdmin() function
- in shell32.dll when available. On Windows Vista this will only
- return true if the process is running with elevated privileges
- and not just when the owner of the process is a member of the
- "Administrators" group.
-
- - Win32::ExpandEnvironmentStrings() may return a Unicode string
- (a string containing characters outside the system codepage)
-
- - new Win32::GetANSIPathName() function returns a pathname in
- a form containing only characters from the system codepage
-
- - Win32::GetCwd() will return an ANSI version of the directory
- name if the long name contains characters outside the system
- codepage.
-
- - Win32::GetFolderPath() will return an ANSI pathname. Call
- Win32::GetLongPathName() to get the canonical Unicode
- representation.
-
- - Win32::GetFullPathName() will return an ANSI pathname. Call
- Win32::GetLongPathName() to get the canonical Unicode
- representation.
-
- - Win32::GetLongPathName() may return a Unicode path name.
- Call Win32::GetANSIPathName() to get a representation using
- only characters from the system codepage.
-
- - Win32::LoginName() may return a Unicode string.
-
- - new Win32::OutputDebugString() function sends a string to
- the debugger.
-
- - new Win32::GetCurrentThreadId() function returns the thread
- id (to complement the process id in $$).
-
- - new Win32::CreateDirectory() creates a new directory. The
- name of the directory may contain Unicode characters outside
- the system codepage.
-
- - new Win32::CreateFile() creates a new file. The name of the
- file may contain Unicode characters outside the system codepage.
-
-
-0.27 [2007-03-07]
- - Extracted from the libwin32 distribution to simplify maintenance
- because Win32 is a dual-life core module since 5.8.4.
-
- - Win32.pm and Win32.xs updated to version in bleadperl.
- This includes all the Win32::* function from win32/win32.c
- in core Perl, except for Win32::SetChildShowWindows().
-
- - Install into 'perl' directory instead of 'site' for Perl 5.8.4
- and later.
-
- - Add some simple tests.
+Revision history for the Perl extension Win32.
+
+0.45 [2012-08-07]
+ - add Win32::GetACP(), Win32::GetConsoleCP(),
+ Win32::GetConsoleOutputCP(), Win32::GetOEMCP(), Win32::SetConsoleCP()
+ and Win32::SetConsoleOutputCP(). [rt#78820] (Steve Hay)
+ - adjust t/Unicode.t for Cygwin 1.7, where readdir() returns
+ the utf8 encoded filename without setting the SvUTF8 flag [rt#66751]
+ [rt#74332]
+
+0.44 [2011-01-12]
+ - fix memory leak introduced in 0.43
+
+0.43 [2011-01-12]
+ - fix a few potential buffer overrun bugs reported by Alex Davies.
+ [perl#78710]
+
+0.42 [2011-01-06]
+ - remove brittle test for Win32::GetLongPathName($ENV{SYSTEMROOT})
+ which will fail if the case of the environment value doesn't
+ exactly match the case of the directory name on the filesystem.
+
+0.41 [2010-12-10]
+ - Fix Win32::GetChipName() to return the native processor type when
+ running 32-bit Perl on 64-bit Windows (WOW64). This will also
+ affect the values returned by Win32::GetOSDisplayName() and
+ Win32::GetOSName(). [rt#63797]
+ - Fix Win32::GetOSDisplayName() to return the correct values for
+ all products even when a service pack has been installed. (This
+ was only an issue for some "special" editions).
+ - The display name for "Windows 7 Business Edition" is actually
+ "Windows 7 Professional".
+ - Fix t/GetOSName.t tests to avoid using the values returned by
+ GetSystemMetrics() when the test template didn't specify any
+ value at all.
+
+0.40 [2010-12-08]
+ - Add Win32::GetSystemMetrics function.
+ - Add Win32::GetProductInfo() function.
+ - Add Win32::GetOSDisplayName() function.
+ - Detect "Windows Server 2008 R2" as "Win2008" in Win32::GetOSName()
+ (used to return "Win7" before). [rt#57172]
+ - Detect "Windows Home Server" as "WinHomeSvr" in Win32::GetOSName()
+ (used to return "Win2003" before).
+ - Add "R2", "Media Center", "Tablet PC", "Starter Edition" etc.
+ tags to the description returned by Win32::GetOSName() in
+ list context.
+ - Rewrite the t/GetOSName.t tests
+
+0.39 [2009-01-19]
+ - Add support for Windows 2008 Server and Windows 7 in
+ Win32::GetOSName() and in the documentation for
+ Win32::GetOSVersion().
+ - Make Win32::GetOSName() implementation testable.
+ - Document that the OSName for Win32s is actually "WinWin32s".
+
+0.38 [2008-06-27]
+ - Fix Cygwin releated problems in t/GetCurrentThreadId.t
+ (Jerry D. Hedden).
+
+0.37 [2008-06-26]
+ - Add Win32::GetCurrentProcessId() function
+
+0.36 [2008-04-17]
+ - Add typecasts for Win64 compilation
+
+0.35 [2008-03-31]
+ Integrate changes from bleadperl:
+ - Silence Borland compiler warning (Steve Hay)
+ - Fix memory leak in Win32::GetOSVersion (Vincent Pit)
+ - Test Win32::GetCurrentThreadId on cygwin (Reini Urban, Steve Hay)
+
+0.34 [2007-11-21]
+ - Document "WinVista" return value for Win32::GetOSName()
+ (Steve Hay).
+
+0.33 [2007-11-12]
+ - Update version to 0.33 for Perl 5.10 release
+ - Add $^O test in Makefile.PL for CPAN Testers
+ - Use Win32::GetLastError() instead of $^E in t/Names.t for
+ cygwin compatibility (Jerry D. Hedden).
+
+0.32 [2007-09-20]
+ - Additional #define's for older versions of VC++ (Dmitry Karasik).
+ - Win32::DomainName() doesn't return anything when the Workstation
+ service isn't running. Set $^E and adapt t/Names.t accordingly
+ (Steve Hay & Jerry D. Hedden).
+ - Fix t/Names.t to allow Win32::GetOSName() to return an empty
+ description as the 2nd return value (e.g. Vista without SP).
+ - Fix t/GetFileVersion.t for Perl 5.10
+
+0.31 [2007-09-10]
+ - Apply Cygwin fixes from bleadperl (from Jerry D. Hedden).
+ - Make sure Win32::GetLongPathName() always returns drive
+ letters in uppercase (Jerry D. Hedden).
+ - Use uppercase environment variable names in t/Unicode.t
+ because the MSWin32 doesn't care, and Cygwin only works
+ with the uppercased version.
+ - new t/Names.t test (from Sébastien Aperghis-Tramoni)
+
+0.30 [2007-06-25]
+ - Fixed t/Unicode.t test for Cygwin (with help from Jerry D. Hedden).
+ - Fixed and documented Win32::GetShortPathName() to return undef
+ when the pathname doesn't exist (thanks to Steve Hay).
+ - Added t/GetShortPathName.t
+
+0.29 [2007-05-17]
+ - Fixed to compile with Borland BCC (thanks to Steve Hay).
+
+0.28_01 [2007-05-16]
+ - Increase version number as 0.28 was already used by an ActivePerl
+ release (for essentially 0.27 plus the Win32::IsAdminUser() change).
+
+ - Add MODULE and PROTOTYPES directives to silence warnings from
+ newer versions of xsubpp.
+
+ - Use the Cygwin codepath in Win32::GetFullPathName() when
+ PERL_IMPLICIT_SYS is not defined, because the other code
+ relies on the virtualization code in win32/vdir.h.
+
+0.27_02 [2007-05-15]
+ - We need Windows 2000 or later for the Unicode support because
+ WC_NO_BEST_FIT_CHARS is not supported on Windows NT.
+
+ - Fix Win32::GetFullPathName() on Windows NT to return an
+ empty file part if the original argument ends with a slash.
+
+0.27_01 [2007-04-18]
+ - Update Win32::IsAdminUser() to use the IsUserAnAdmin() function
+ in shell32.dll when available. On Windows Vista this will only
+ return true if the process is running with elevated privileges
+ and not just when the owner of the process is a member of the
+ "Administrators" group.
+
+ - Win32::ExpandEnvironmentStrings() may return a Unicode string
+ (a string containing characters outside the system codepage)
+
+ - new Win32::GetANSIPathName() function returns a pathname in
+ a form containing only characters from the system codepage
+
+ - Win32::GetCwd() will return an ANSI version of the directory
+ name if the long name contains characters outside the system
+ codepage.
+
+ - Win32::GetFolderPath() will return an ANSI pathname. Call
+ Win32::GetLongPathName() to get the canonical Unicode
+ representation.
+
+ - Win32::GetFullPathName() will return an ANSI pathname. Call
+ Win32::GetLongPathName() to get the canonical Unicode
+ representation.
+
+ - Win32::GetLongPathName() may return a Unicode path name.
+ Call Win32::GetANSIPathName() to get a representation using
+ only characters from the system codepage.
+
+ - Win32::LoginName() may return a Unicode string.
+
+ - new Win32::OutputDebugString() function sends a string to
+ the debugger.
+
+ - new Win32::GetCurrentThreadId() function returns the thread
+ id (to complement the process id in $$).
+
+ - new Win32::CreateDirectory() creates a new directory. The
+ name of the directory may contain Unicode characters outside
+ the system codepage.
+
+ - new Win32::CreateFile() creates a new file. The name of the
+ file may contain Unicode characters outside the system codepage.
+
+
+0.27 [2007-03-07]
+ - Extracted from the libwin32 distribution to simplify maintenance
+ because Win32 is a dual-life core module since 5.8.4.
+
+ - Win32.pm and Win32.xs updated to version in bleadperl.
+ This includes all the Win32::* function from win32/win32.c
+ in core Perl, except for Win32::SetChildShowWindows().
+
+ - Install into 'perl' directory instead of 'site' for Perl 5.8.4
+ and later.
+
+ - Add some simple tests.
diff --git a/cpan/Win32/Makefile.PL b/cpan/Win32/Makefile.PL
index 89a568a5f6..0f16594aad 100644
--- a/cpan/Win32/Makefile.PL
+++ b/cpan/Win32/Makefile.PL
@@ -1,18 +1,18 @@
-use 5.006;
-use strict;
-use warnings;
-use ExtUtils::MakeMaker;
-
-unless ($^O eq "MSWin32" || $^O eq "cygwin") {
- die "OS unsupported\n";
-}
-
-my %param = (
- NAME => 'Win32',
- VERSION_FROM => 'Win32.pm',
- INSTALLDIRS => ($] >= 5.008004 && $] < 5.012 ? 'perl' : 'site'),
-);
-$param{NO_META} = 1 if eval "$ExtUtils::MakeMaker::VERSION" >= 6.10_03;
-$param{LIBS} = ['-L/lib/w32api -lole32 -lversion'] if $^O eq "cygwin";
-
-WriteMakefile(%param);
+use 5.006;
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+unless ($^O eq "MSWin32" || $^O eq "cygwin") {
+ die "OS unsupported\n";
+}
+
+my %param = (
+ NAME => 'Win32',
+ VERSION_FROM => 'Win32.pm',
+ INSTALLDIRS => ($] >= 5.008004 && $] < 5.012 ? 'perl' : 'site'),
+);
+$param{NO_META} = 1 if eval "$ExtUtils::MakeMaker::VERSION" >= 6.10_03;
+$param{LIBS} = ['-L/lib/w32api -lole32 -lversion'] if $^O eq "cygwin";
+
+WriteMakefile(%param);
diff --git a/cpan/Win32/Win32.pm b/cpan/Win32/Win32.pm
index d37352a41b..deb46bed06 100644
--- a/cpan/Win32/Win32.pm
+++ b/cpan/Win32/Win32.pm
@@ -1,1201 +1,1240 @@
-package Win32;
-
-# BEGIN {
- use strict;
- use vars qw|$VERSION $XS_VERSION @ISA @EXPORT @EXPORT_OK|;
-
- require Exporter;
- require DynaLoader;
-
- @ISA = qw|Exporter DynaLoader|;
- $VERSION = '0.44';
- $XS_VERSION = $VERSION;
- $VERSION = eval $VERSION;
-
- @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
- );
-# }
-
-# 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
-
-sub VER_NT_DOMAIN_CONTROLLER () { 0x0000002 } # The system is a domain controller and the operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server.
-sub VER_NT_SERVER () { 0x0000003 } # The operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server.
-# Note that a server that is also a domain controller is reported as VER_NT_DOMAIN_CONTROLLER, not VER_NT_SERVER.
-sub VER_NT_WORKSTATION () { 0x0000001 } # The operating system is Windows Vista, Windows XP Professional, Windows XP Home Edition, or Windows 2000 Professional.
-
-
-sub VER_SUITE_BACKOFFICE () { 0x00000004 } # Microsoft BackOffice components are installed.
-sub VER_SUITE_BLADE () { 0x00000400 } # Windows Server 2003, Web Edition is installed.
-sub VER_SUITE_COMPUTE_SERVER () { 0x00004000 } # Windows Server 2003, Compute Cluster Edition is installed.
-sub VER_SUITE_DATACENTER () { 0x00000080 } # Windows Server 2008 Datacenter, Windows Server 2003, Datacenter Edition, or Windows 2000 Datacenter Server is installed.
-sub VER_SUITE_ENTERPRISE () { 0x00000002 } # Windows Server 2008 Enterprise, Windows Server 2003, Enterprise Edition, or Windows 2000 Advanced Server is installed. Refer to the Remarks section for more information about this bit flag.
-sub VER_SUITE_EMBEDDEDNT () { 0x00000040 } # Windows XP Embedded is installed.
-sub VER_SUITE_PERSONAL () { 0x00000200 } # Windows Vista Home Premium, Windows Vista Home Basic, or Windows XP Home Edition is installed.
-sub VER_SUITE_SINGLEUSERTS () { 0x00000100 } # Remote Desktop is supported, but only one interactive session is supported. This value is set unless the system is running in application server mode.
-sub VER_SUITE_SMALLBUSINESS () { 0x00000001 } # Microsoft Small Business Server was once installed on the system, but may have been upgraded to another version of Windows. Refer to the Remarks section for more information about this bit flag.
-sub VER_SUITE_SMALLBUSINESS_RESTRICTED () { 0x00000020 } # Microsoft Small Business Server is installed with the restrictive client license in force. Refer to the Remarks section for more information about this bit flag.
-sub VER_SUITE_STORAGE_SERVER () { 0x00002000 } # Windows Storage Server 2003 R2 or Windows Storage Server 2003 is installed.
-sub VER_SUITE_TERMINAL () { 0x00000010 } # Terminal Services is installed. This value is always set.
-# If VER_SUITE_TERMINAL is set but VER_SUITE_SINGLEUSERTS is not set, the system is running in application server mode.
-sub VER_SUITE_WH_SERVER () { 0x00008000 } # Windows Home Server is installed.
-
-
-sub SM_TABLETPC () { 86 }
-sub SM_MEDIACENTER () { 87 }
-sub SM_STARTER () { 88 }
-sub SM_SERVERR2 () { 89 }
-
-sub PRODUCT_UNDEFINED () { 0x000 } # An unknown product
-sub PRODUCT_ULTIMATE () { 0x001 } # Ultimate
-sub PRODUCT_HOME_BASIC () { 0x002 } # Home Basic
-sub PRODUCT_HOME_PREMIUM () { 0x003 } # Home Premium
-sub PRODUCT_ENTERPRISE () { 0x004 } # Enterprise
-sub PRODUCT_HOME_BASIC_N () { 0x005 } # Home Basic N
-sub PRODUCT_BUSINESS () { 0x006 } # Business
-sub PRODUCT_STANDARD_SERVER () { 0x007 } # Server Standard (full installation)
-sub PRODUCT_DATACENTER_SERVER () { 0x008 } # Server Datacenter (full installation)
-sub PRODUCT_SMALLBUSINESS_SERVER () { 0x009 } # Windows Small Business Server
-sub PRODUCT_ENTERPRISE_SERVER () { 0x00A } # Server Enterprise (full installation)
-sub PRODUCT_STARTER () { 0x00B } # Starter
-sub PRODUCT_DATACENTER_SERVER_CORE () { 0x00C } # Server Datacenter (core installation)
-sub PRODUCT_STANDARD_SERVER_CORE () { 0x00D } # Server Standard (core installation)
-sub PRODUCT_ENTERPRISE_SERVER_CORE () { 0x00E } # Server Enterprise (core installation)
-sub PRODUCT_ENTERPRISE_SERVER_IA64 () { 0x00F } # Server Enterprise for Itanium-based Systems
-sub PRODUCT_BUSINESS_N () { 0x010 } # Business N
-sub PRODUCT_WEB_SERVER () { 0x011 } # Web Server (full installation)
-sub PRODUCT_CLUSTER_SERVER () { 0x012 } # HPC Edition
-sub PRODUCT_HOME_SERVER () { 0x013 } # Home Server Edition
-sub PRODUCT_STORAGE_EXPRESS_SERVER () { 0x014 } # Storage Server Express
-sub PRODUCT_STORAGE_STANDARD_SERVER () { 0x015 } # Storage Server Standard
-sub PRODUCT_STORAGE_WORKGROUP_SERVER () { 0x016 } # Storage Server Workgroup
-sub PRODUCT_STORAGE_ENTERPRISE_SERVER () { 0x017 } # Storage Server Enterprise
-sub PRODUCT_SERVER_FOR_SMALLBUSINESS () { 0x018 } # Windows Server 2008 for Windows Essential Server Solutions
-sub PRODUCT_SMALLBUSINESS_SERVER_PREMIUM () { 0x019 } # Windows Small Business Server Premium
-sub PRODUCT_HOME_PREMIUM_N () { 0x01A } # Home Premium N
-sub PRODUCT_ENTERPRISE_N () { 0x01B } # Enterprise N
-sub PRODUCT_ULTIMATE_N () { 0x01C } # Ultimate N
-sub PRODUCT_WEB_SERVER_CORE () { 0x01D } # Web Server (core installation)
-sub PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT () { 0x01E } # Windows Essential Business Server Management Server
-sub PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY () { 0x01F } # Windows Essential Business Server Security Server
-sub PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING () { 0x020 } # Windows Essential Business Server Messaging Server
-sub PRODUCT_SERVER_FOUNDATION () { 0x021 } # Server Foundation
-
-sub PRODUCT_SERVER_FOR_SMALLBUSINESS_V () { 0x023 } # Windows Server 2008 without Hyper-V for Windows Essential Server Solutions
-sub PRODUCT_STANDARD_SERVER_V () { 0x024 } # Server Standard without Hyper-V (full installation)
-sub PRODUCT_DATACENTER_SERVER_V () { 0x025 } # Server Datacenter without Hyper-V (full installation)
-sub PRODUCT_ENTERPRISE_SERVER_V () { 0x026 } # Server Enterprise without Hyper-V (full installation)
-sub PRODUCT_DATACENTER_SERVER_CORE_V () { 0x027 } # Server Datacenter without Hyper-V (core installation)
-sub PRODUCT_STANDARD_SERVER_CORE_V () { 0x028 } # Server Standard without Hyper-V (core installation)
-sub PRODUCT_ENTERPRISE_SERVER_CORE_V () { 0x029 } # Server Enterprise without Hyper-V (core installation)
-sub PRODUCT_HYPERV () { 0x02A } # Microsoft Hyper-V Server
-
-sub PRODUCT_STARTER_N () { 0x02F } # Starter N
-sub PRODUCT_PROFESSIONAL () { 0x030 } # Professional
-sub PRODUCT_PROFESSIONAL_N () { 0x031 } # Professional N
-
-sub PRODUCT_STARTER_E () { 0x042 } # Starter E
-sub PRODUCT_HOME_BASIC_E () { 0x043 } # Home Basic E
-sub PRODUCT_HOME_PREMIUM_E () { 0x044 } # Home Premium E
-sub PRODUCT_PROFESSIONAL_E () { 0x045 } # Professional E
-sub PRODUCT_ENTERPRISE_E () { 0x046 } # Enterprise E
-sub PRODUCT_ULTIMATE_E () { 0x047 } # Ultimate E
-
-sub PRODUCT_UNLICENSED () { 0xABCDABCD } # product has not been activated and is no longer in the grace period
-
-sub PROCESSOR_ARCHITECTURE_AMD64 () { 9 } # x64 (AMD or Intel)
-sub PROCESSOR_ARCHITECTURE_IA64 () { 6 } # Intel Itanium Processor Family (IPF)
-sub PROCESSOR_ARCHITECTURE_INTEL () { 0 } # x86
-sub PROCESSOR_ARCHITECTURE_UNKNOWN () { 0xffff } # Unknown architecture.
-
-sub _GetProcessorArchitecture {
- my $arch = {
- 386 => PROCESSOR_ARCHITECTURE_INTEL,
- 486 => PROCESSOR_ARCHITECTURE_INTEL,
- 586 => PROCESSOR_ARCHITECTURE_INTEL,
- 2200 => PROCESSOR_ARCHITECTURE_IA64,
- 8664 => PROCESSOR_ARCHITECTURE_AMD64,
- }->{Win32::GetChipName()};
- return defined($arch) ? $arch : PROCESSOR_ARCHITECTURE_UNKNOWN;
-}
-
-### This method is just a simple interface into GetOSVersion(). More
-### specific or demanding situations should use that instead.
-
-my ($cached_os, $cached_desc);
-
-sub GetOSName {
- unless (defined $cached_os) {
- my($desc, $major, $minor, $build, $id, undef, undef, $suitemask, $producttype)
- = Win32::GetOSVersion();
- my $arch = _GetProcessorArchitecture();
- my $productinfo = Win32::GetProductInfo(6, 0, 0, 0);
- ($cached_os, $cached_desc) = _GetOSName($desc, $major, $minor, $build, $id,
- $suitemask, $producttype, $productinfo, $arch);
- }
- return wantarray ? ($cached_os, $cached_desc) : $cached_os;
-}
-
-sub GetOSDisplayName {
- # Calling GetOSDisplayName() with arguments is for the test suite only!
- my($name,$desc) = @_ ? @_ : GetOSName();
- $name =~ s/^Win//;
- if ($desc =~ /^Windows Home Server\b/ || $desc =~ /^Windows XP Professional x64 Edition\b/) {
- ($name, $desc) = ($desc, "");
- }
- elsif ($desc =~ s/\s*(Windows (.*) Server( \d+)?)//) {
- $name = "$1 $name";
- $desc =~ s/^\s+//;
- }
- else {
- for ($name) {
- s/^/Windows / unless /^Win32s$/;
- s/\/.Net//;
- s/NT(\d)/NT $1/;
- if ($desc =~ s/\s*(HPC|Small Business|Web) Server//) {
- my $name = $1;
- $desc =~ s/^\s*//;
- s/(200.)/$name Server $1/;
- }
- s/^Windows (200[38])/Windows Server $1/;
- }
- }
- $name .= " $desc" if length $desc;
- return $name;
-}
-
-sub _GetSystemMetrics {
- my($index,$metrics) = @_;
- return Win32::GetSystemMetrics($index) unless ref $metrics;
- return $metrics->{$index} if ref $metrics eq "HASH" && defined $metrics->{$index};
- return 1 if ref $metrics eq "ARRAY" && grep $_ == $index, @$metrics;
- return 0;
-}
-
-sub _GetOSName {
- # The $metrics argument only exists for the benefit of t/GetOSName.t
- my($csd, $major, $minor, $build, $id, $suitemask, $producttype, $productinfo, $arch, $metrics) = @_;
-
- my($os,@tags);
- my $desc = "";
- if ($id == 0) {
- $os = "Win32s";
- }
- elsif ($id == 1) {
- if ($minor == 0) {
- $os = "95";
- }
- elsif ($minor == 10) {
- $os = "98";
- }
- elsif ($minor == 90) {
- $os = "Me";
- }
- }
- elsif ($id == 2) {
- if ($major == 3) {
- $os = "NT3.51";
- }
- elsif ($major == 4) {
- $os = "NT4";
- }
- elsif ($major == 5) {
- if ($minor == 0) {
- $os = "2000";
- if ($producttype == VER_NT_WORKSTATION) {
- $desc = "Professional";
- }
- else {
- if ($suitemask & VER_SUITE_DATACENTER) {
- $desc = "Datacenter Server";
- }
- elsif ($suitemask & VER_SUITE_ENTERPRISE) {
- $desc = "Advanced Server";
- }
- elsif ($suitemask & VER_SUITE_SMALLBUSINESS_RESTRICTED) {
- $desc = "Small Business Server";
- }
- else {
- $desc = "Server";
- }
- }
- # XXX ignoring "Windows 2000 Advanced Server Limited Edition" for Itanium
- # XXX and "Windows 2000 Datacenter Server Limited Edition" for Itanium
- }
- elsif ($minor == 1) {
- $os = "XP/.Net";
- if (_GetSystemMetrics(SM_MEDIACENTER, $metrics)) {
- $desc = "Media Center Edition";
- }
- elsif (_GetSystemMetrics(SM_TABLETPC, $metrics)) {
- # Tablet PC Edition is based on XP Pro
- $desc = "Tablet PC Edition";
- }
- elsif (_GetSystemMetrics(SM_STARTER, $metrics)) {
- $desc = "Starter Edition";
- }
- elsif ($suitemask & VER_SUITE_PERSONAL) {
- $desc = "Home Edition";
- }
- else {
- $desc = "Professional";
- }
- # XXX ignoring all Windows XP Embedded and Fundamentals versions
- }
- elsif ($minor == 2) {
- $os = "2003";
-
- if (_GetSystemMetrics(SM_SERVERR2, $metrics)) {
- # XXX R2 was released for all x86 and x64 versions,
- # XXX but only Enterprise Edition for Itanium.
- $desc = "R2";
- }
-
- if ($suitemask == VER_SUITE_STORAGE_SERVER) {
- $desc .= " Windows Storage Server";
- }
- elsif ($suitemask == VER_SUITE_WH_SERVER) {
- $desc .= " Windows Home Server";
- }
- elsif ($producttype == VER_NT_WORKSTATION && $arch == PROCESSOR_ARCHITECTURE_AMD64) {
- $desc .= " Windows XP Professional x64 Edition";
- }
-
- # Test for the server type.
- if ($producttype != VER_NT_WORKSTATION) {
- if ($arch == PROCESSOR_ARCHITECTURE_IA64) {
- if ($suitemask & VER_SUITE_DATACENTER) {
- $desc .= " Datacenter Edition for Itanium-based Systems";
- }
- elsif ($suitemask & VER_SUITE_ENTERPRISE) {
- $desc .= " Enterprise Edition for Itanium-based Systems";
- }
- }
- elsif ($arch == PROCESSOR_ARCHITECTURE_AMD64) {
- if ($suitemask & VER_SUITE_DATACENTER) {
- $desc .= " Datacenter x64 Edition";
- }
- elsif ($suitemask & VER_SUITE_ENTERPRISE) {
- $desc .= " Enterprise x64 Edition";
- }
- else {
- $desc .= " Standard x64 Edition";
- }
- }
- else {
- if ($suitemask & VER_SUITE_COMPUTE_SERVER) {
- $desc .= " Windows Compute Cluster Server";
- }
- elsif ($suitemask & VER_SUITE_DATACENTER) {
- $desc .= " Datacenter Edition";
- }
- elsif ($suitemask & VER_SUITE_ENTERPRISE) {
- $desc .= " Enterprise Edition";
- }
- elsif ($suitemask & VER_SUITE_BLADE) {
- $desc .= " Web Edition";
- }
- elsif ($suitemask & VER_SUITE_SMALLBUSINESS_RESTRICTED) {
- $desc .= " Small Business Server";
- }
- else {
- if ($desc !~ /Windows (Home|Storage) Server/) {
- $desc .= " Standard Edition";
- }
- }
- }
- }
- }
- }
- elsif ($major == 6) {
- if ($minor == 0) {
- if ($producttype == VER_NT_WORKSTATION) {
- $os = "Vista";
- }
- else {
- $os = "2008";
- }
- }
- elsif ($minor == 1) {
- if ($producttype == VER_NT_WORKSTATION) {
- $os = "7";
- }
- else {
- $os = "2008";
- $desc = "R2";
- }
- }
-
- if ($productinfo == PRODUCT_ULTIMATE) {
- $desc .= " Ultimate";
- }
- elsif ($productinfo == PRODUCT_HOME_PREMIUM) {
- $desc .= " Home Premium";
- }
- elsif ($productinfo == PRODUCT_HOME_BASIC) {
- $desc .= " Home Basic";
- }
- elsif ($productinfo == PRODUCT_ENTERPRISE) {
- $desc .= " Enterprise";
- }
- elsif ($productinfo == PRODUCT_BUSINESS) {
- # "Windows 7 Business" had a name change to "Windows 7 Professional"
- $desc .= $minor == 0 ? " Business" : " Professional";
- }
- elsif ($productinfo == PRODUCT_STARTER) {
- $desc .= " Starter";
- }
- elsif ($productinfo == PRODUCT_CLUSTER_SERVER) {
- $desc .= " HPC Server";
- }
- elsif ($productinfo == PRODUCT_DATACENTER_SERVER) {
- $desc .= " Datacenter";
- }
- elsif ($productinfo == PRODUCT_DATACENTER_SERVER_CORE) {
- $desc .= " Datacenter Edition (core installation)";
- }
- elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER) {
- $desc .= " Enterprise";
- }
- elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_CORE) {
- $desc .= " Enterprise Edition (core installation)";
- }
- elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_IA64) {
- $desc .= " Enterprise Edition for Itanium-based Systems";
- }
- elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER) {
- $desc .= " Small Business Server";
- }
- elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER_PREMIUM) {
- $desc .= " Small Business Server Premium Edition";
- }
- elsif ($productinfo == PRODUCT_STANDARD_SERVER) {
- $desc .= " Standard";
- }
- elsif ($productinfo == PRODUCT_STANDARD_SERVER_CORE) {
- $desc .= " Standard Edition (core installation)";
- }
- elsif ($productinfo == PRODUCT_WEB_SERVER) {
- $desc .= " Web Server";
- }
- elsif ($productinfo == PRODUCT_PROFESSIONAL) {
- $desc .= " Professional";
- }
-
- if ($arch == PROCESSOR_ARCHITECTURE_INTEL) {
- $desc .= " (32-bit)";
- }
- elsif ($arch == PROCESSOR_ARCHITECTURE_AMD64) {
- $desc .= " (64-bit)";
- }
- }
- }
-
- unless (defined $os) {
- warn "Unknown Windows version [$id:$major:$minor]";
- return;
- }
-
- for ($desc) {
- s/\s\s+/ /g;
- s/^\s//;
- s/\s$//;
- }
-
- # XXX What about "Small Business Server"? NT, 200, 2003, 2008 editions...
-
- if ($major >= 5) {
- # XXX XP, Vista, 7 all have starter editions
- #push(@tags, "Starter Edition") if _GetSystemMetrics(SM_STARTER, $metrics);
- }
-
- if (@tags) {
- unshift(@tags, $desc) if length $desc;
- $desc = join(" ", @tags);
- }
-
- if (length $csd) {
- $desc .= " " if length $desc;
- $desc .= $csd;
- }
- return ("Win$os", $desc);
-}
-
-# "no warnings 'redefine';" doesn't work for 5.8.7 and earlier
-local $^W = 0;
-bootstrap Win32;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Win32 - Interfaces to some Win32 API Functions
-
-=head1 DESCRIPTION
-
-The Win32 module contains functions to access Win32 APIs.
-
-=head2 Alphabetical Listing of Win32 Functions
-
-It is recommended to C<use Win32;> before any of these functions;
-however, for backwards compatibility, those marked as [CORE] will
-automatically do this for you.
-
-In the function descriptions below the term I<Unicode string> is used
-to indicate that the string may contain characters outside the system
-codepage. The caveat I<If supported by the core Perl version>
-generally means Perl 5.8.9 and later, though some Unicode pathname
-functionality may work on earlier versions.
-
-=over
-
-=item Win32::AbortSystemShutdown(MACHINE)
-
-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<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.
-
-=item Win32::CreateDirectory(DIRECTORY)
-
-Creates the DIRECTORY and returns a true value on success. Check $^E
-on failure for extended error information.
-
-DIRECTORY may contain Unicode characters outside the system codepage.
-Once the directory has been created you can use
-Win32::GetANSIPathName() to get a name that can be passed to system
-calls and external programs.
-
-=item Win32::CreateFile(FILE)
-
-Creates the FILE and returns a true value on success. Check $^E on
-failure for extended error information.
-
-FILE may contain Unicode characters outside the system codepage. Once
-the file has been created you can use Win32::GetANSIPathName() to get
-a name that can be passed to system calls and external programs.
-
-=item Win32::DomainName()
-
-[CORE] Returns the name of the Microsoft Network domain or workgroup
-that the owner of the current perl process is logged into. The
-"Workstation" service must be running to determine this
-information. This function does B<not> work on Windows 9x.
-
-=item Win32::ExpandEnvironmentStrings(STRING)
-
-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
-
-However, this function may return a Unicode string if the environment
-variable being expanded hasn't been assigned to via %ENV. Access
-to %ENV is currently always using byte semantics.
-
-=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)
-
-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::GetANSIPathName(FILENAME)
-
-Returns an ANSI version of FILENAME. This may be the short name
-if the long name cannot be represented in the system codepage.
-
-While not currently implemented, it is possible that in the future
-this function will convert only parts of the path to FILENAME to a
-short form.
-
-If FILENAME doesn't exist on the filesystem, or if the filesystem
-doesn't support short ANSI filenames, then this function will
-translate the Unicode name into the system codepage using replacement
-characters.
-
-=item Win32::GetArchName()
-
-Use of this function is deprecated. It is equivalent with
-$ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X.
-
-=item Win32::GetChipName()
-
-Returns the processor type: 386, 486 or 586 for x86 processors, 8664
-for the x64 processor and 2200 for the Itanium. Since it returns the
-native processor type it will return a 64-bit processor type even when
-called from a 32-bit Perl running on 64-bit Windows.
-
-=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.
-
-If supported by the core Perl version, this function will return an
-ANSI path name for the current directory if the long pathname cannot
-be represented in the system codepage.
-
-=item Win32::GetCurrentProcessId()
-
-Returns the process identifier of the current process. Until the
-process terminates, the process identifier uniquely identifies the
-process throughout the system.
-
-The current process identifier is normally also available via the
-predefined $$ variable. Under fork() emulation however $$ may contain
-a pseudo-process identifier that is only meaningful to the Perl
-kill(), wait() and waitpid() functions. The
-Win32::GetCurrentProcessId() function will always return the regular
-Windows process id, even when called from inside a pseudo-process.
-
-=item Win32::GetCurrentThreadId()
-
-Returns the thread identifier of the calling thread. Until the thread
-terminates, the thread identifier uniquely identifies the thread
-throughout the system.
-
-=item Win32::GetFileVersion(FILENAME)
-
-Returns the file version number from the VERSIONINFO resource of
-the executable file or DLL. This is a tuple of four 16 bit numbers.
-In list context these four numbers will be returned. In scalar context
-they are concatenated into a string, separated by dots.
-
-=item Win32::GetFolderPath(FOLDER [, CREATE])
-
-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
-
-This function will return an ANSI folder path if the long name cannot
-be represented in the system codepage. Use Win32::GetLongPathName()
-on the result of Win32::GetFolderPath() if you want the Unicode
-version of the folder name.
-
-=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().
-
-If supported by the core Perl version, this function will return an
-ANSI path name if the full pathname cannot be represented in the
-system codepage.
-
-=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 may return the pathname in Unicode if it cannot be
-represented in the system codepage. Use Win32::GetANSIPathName()
-before passing the path to a system call or another program.
-
-=item Win32::GetNextAvailDrive()
-
-[CORE] Returns a string in the form of "<d>:" where <d> is the first
-available drive letter.
-
-=item Win32::GetOSDisplayName()
-
-Returns the "marketing" name of the Windows operating system version
-being used. It returns names like these (random samples):
-
- Windows 2000 Datacenter Server
- Windows XP Professional
- Windows XP Tablet PC Edition
- Windows Home Server
- Windows Server 2003 Enterprise Edition for Itanium-based Systems
- Windows Vista Ultimate (32-bit)
- Windows Small Business Server 2008 R2 (64-bit)
-
-The display name describes the native Windows version, so even on a
-32-bit Perl this function may return a "Windows ... (64-bit)" name
-when running on a 64-bit Windows.
-
-This function should only be used to display the actual OS name to the
-user; it should not be used to determine the class of operating systems
-this system belongs to. The Win32::GetOSName(), Win32::GetOSVersion,
-Win32::GetProductInfo() and Win32::GetSystemMetrics() functions provide
-the base information to check for certain capabilities, or for families
-of OS releases.
-
-=item Win32::GetOSName()
-
-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.
-
-The description will also include tags for other special editions,
-like "R2", "Media Center", "Tablet PC", or "Starter Edition".
-
-Currently the possible values for the OS name are
-
- WinWin32s
- Win95
- Win98
- WinMe
- WinNT3.51
- WinNT4
- Win2000
- WinXP/.Net
- Win2003
- WinHomeSvr
- WinVista
- Win2008
- Win7
-
-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.
-
-Similarly the name "WinWin32s" should have been "Win32s" but has been
-kept as-is for backwards compatibility reasons too.
-
-=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/Vista/2008/7. 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
- Windows Server 2003 R2 2 5 2
- Windows Home Server 2 5 2
-
- Windows Vista 2 6 0
- Windows Server 2008 2 6 0
- Windows 7 2 6 1
- Windows Server 2008 R2 2 6 1
-
-On Windows NT 4 SP6 and later this function returns the following
-additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE.
-
-The version numbers for Windows 2003 and Windows Home Server are
-identical; the SUITEMASK field must be used to differentiate between\
-them.
-
-The version numbers for Windows Vista and Windows Server 2008 are
-identical; the PRODUCTTYPE field must be used to differentiate between
-them.
-
-The version numbers for Windows 7 and Windows Server 2008 R2 are
-identical; the PRODUCTTYPE field must be used to differentiate between
-them.
-
-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
- VER_SUITE_STORAGE_SERVER 0x00002000
- VER_SUITE_COMPUTE_SERVER 0x00004000
- VER_SUITE_WH_SERVER 0x00008000
-
-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, Vista)
- 2 - Domaincontroller
- 3 - Server (2000 Server, Server 2003, Server 2008)
-
-Note that a server that is also a domain controller is reported as
-PRODUCTTYPE 2 (Domaincontroller) and not PRODUCTTYPE 3 (Server).
-
-=item Win32::GetShortPathName(PATHNAME)
-
-[CORE] Returns a representation of PATHNAME that is composed of short
-(8.3) path components where available. For path components where the
-file system has not generated the short form the returned path will
-use the long form, so this function might still for instance return a
-path containing spaces. Returns C<undef> when the PATHNAME does not
-exist. Compare with Win32::GetFullPathName() and
-Win32::GetLongPathName().
-
-=item Win32::GetSystemMetrics(INDEX)
-
-Retrieves the specified system metric or system configuration setting.
-Please refer to the Microsoft documentation of the GetSystemMetrics()
-function for a reference of available INDEX values. All system
-metrics return integer values.
-
-=item Win32::GetProcAddress(INSTANCE, PROCNAME)
-
-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::GetProductInfo(OSMAJOR, OSMINOR, SPMAJOR, SPMINOR)
-
-Retrieves the product type for the operating system on the local
-computer, and maps the type to the product types supported by the
-specified operating system. Please refer to the Microsoft
-documentation of the GetProductInfo() function for more information
-about the parameters and return value. This function requires Windows
-Vista or later.
-
-See also the Win32::GetOSName() and Win32::GetOSDisplayName()
-functions which provide a higher level abstraction of the data
-returned by this 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::GuidGen()
-
-Creates a globally unique 128 bit integer that can be used as a
-persistent identifier in a distributed setting. To a very high degree
-of certainty this function returns a unique value. No other
-invocation, on the same or any other system (networked or not), should
-return the same value.
-
-The return value is formatted according to OLE conventions, as groups
-of hex digits with surrounding braces. For example:
-
- {09531CF1-D0C7-4860-840C-1C8C8735E2AD}
-
-=item Win32::InitiateSystemShutdown
-
-(MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT)
-
-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()
-
-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.
-On Windows Vista it will only return non-zero if the process is
-actually running with elevated privileges. Returns C<undef>
-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)
-
-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.
-The return value may be a Unicode string.
-
-=item Win32::LookupAccountName(SYSTEM, ACCOUNT, DOMAIN, SID, SIDTYPE)
-
-Looks up ACCOUNT on SYSTEM and returns the domain name the SID and
-the SID type.
-
-=item Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE)
-
-Looks up SID on SYSTEM and returns the account name, domain name,
-and the SID type.
-
-=item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]])
-
-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::OutputDebugString(STRING)
-
-Sends a string to the application or system debugger for display.
-The function does nothing if there is no active debugger.
-
-Alternatively one can use the I<Debug Viewer> application to
-watch the OutputDebugString() output:
-
-http://www.microsoft.com/technet/sysinternals/utilities/debugview.mspx
-
-=item Win32::RegisterServer(LIBRARYNAME)
-
-Loads the DLL LIBRARYNAME and calls the function DllRegisterServer.
-
-=item Win32::SetChildShowWindow(SHOWWINDOW)
-
-[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
-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<undef>.
-
-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)
-
-Loads the DLL LIBRARYNAME and calls the function
-DllUnregisterServer.
-
-=back
-
-=cut
+package Win32;
+
+# BEGIN {
+ use strict;
+ use vars qw|$VERSION $XS_VERSION @ISA @EXPORT @EXPORT_OK|;
+
+ require Exporter;
+ require DynaLoader;
+
+ @ISA = qw|Exporter DynaLoader|;
+ $VERSION = '0.45';
+ $XS_VERSION = $VERSION;
+ $VERSION = eval $VERSION;
+
+ @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
+ );
+# }
+
+# 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
+
+sub VER_NT_DOMAIN_CONTROLLER () { 0x0000002 } # The system is a domain controller and the operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server.
+sub VER_NT_SERVER () { 0x0000003 } # The operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server.
+# Note that a server that is also a domain controller is reported as VER_NT_DOMAIN_CONTROLLER, not VER_NT_SERVER.
+sub VER_NT_WORKSTATION () { 0x0000001 } # The operating system is Windows Vista, Windows XP Professional, Windows XP Home Edition, or Windows 2000 Professional.
+
+
+sub VER_SUITE_BACKOFFICE () { 0x00000004 } # Microsoft BackOffice components are installed.
+sub VER_SUITE_BLADE () { 0x00000400 } # Windows Server 2003, Web Edition is installed.
+sub VER_SUITE_COMPUTE_SERVER () { 0x00004000 } # Windows Server 2003, Compute Cluster Edition is installed.
+sub VER_SUITE_DATACENTER () { 0x00000080 } # Windows Server 2008 Datacenter, Windows Server 2003, Datacenter Edition, or Windows 2000 Datacenter Server is installed.
+sub VER_SUITE_ENTERPRISE () { 0x00000002 } # Windows Server 2008 Enterprise, Windows Server 2003, Enterprise Edition, or Windows 2000 Advanced Server is installed. Refer to the Remarks section for more information about this bit flag.
+sub VER_SUITE_EMBEDDEDNT () { 0x00000040 } # Windows XP Embedded is installed.
+sub VER_SUITE_PERSONAL () { 0x00000200 } # Windows Vista Home Premium, Windows Vista Home Basic, or Windows XP Home Edition is installed.
+sub VER_SUITE_SINGLEUSERTS () { 0x00000100 } # Remote Desktop is supported, but only one interactive session is supported. This value is set unless the system is running in application server mode.
+sub VER_SUITE_SMALLBUSINESS () { 0x00000001 } # Microsoft Small Business Server was once installed on the system, but may have been upgraded to another version of Windows. Refer to the Remarks section for more information about this bit flag.
+sub VER_SUITE_SMALLBUSINESS_RESTRICTED () { 0x00000020 } # Microsoft Small Business Server is installed with the restrictive client license in force. Refer to the Remarks section for more information about this bit flag.
+sub VER_SUITE_STORAGE_SERVER () { 0x00002000 } # Windows Storage Server 2003 R2 or Windows Storage Server 2003 is installed.
+sub VER_SUITE_TERMINAL () { 0x00000010 } # Terminal Services is installed. This value is always set.
+# If VER_SUITE_TERMINAL is set but VER_SUITE_SINGLEUSERTS is not set, the system is running in application server mode.
+sub VER_SUITE_WH_SERVER () { 0x00008000 } # Windows Home Server is installed.
+
+
+sub SM_TABLETPC () { 86 }
+sub SM_MEDIACENTER () { 87 }
+sub SM_STARTER () { 88 }
+sub SM_SERVERR2 () { 89 }
+
+sub PRODUCT_UNDEFINED () { 0x000 } # An unknown product
+sub PRODUCT_ULTIMATE () { 0x001 } # Ultimate
+sub PRODUCT_HOME_BASIC () { 0x002 } # Home Basic
+sub PRODUCT_HOME_PREMIUM () { 0x003 } # Home Premium
+sub PRODUCT_ENTERPRISE () { 0x004 } # Enterprise
+sub PRODUCT_HOME_BASIC_N () { 0x005 } # Home Basic N
+sub PRODUCT_BUSINESS () { 0x006 } # Business
+sub PRODUCT_STANDARD_SERVER () { 0x007 } # Server Standard (full installation)
+sub PRODUCT_DATACENTER_SERVER () { 0x008 } # Server Datacenter (full installation)
+sub PRODUCT_SMALLBUSINESS_SERVER () { 0x009 } # Windows Small Business Server
+sub PRODUCT_ENTERPRISE_SERVER () { 0x00A } # Server Enterprise (full installation)
+sub PRODUCT_STARTER () { 0x00B } # Starter
+sub PRODUCT_DATACENTER_SERVER_CORE () { 0x00C } # Server Datacenter (core installation)
+sub PRODUCT_STANDARD_SERVER_CORE () { 0x00D } # Server Standard (core installation)
+sub PRODUCT_ENTERPRISE_SERVER_CORE () { 0x00E } # Server Enterprise (core installation)
+sub PRODUCT_ENTERPRISE_SERVER_IA64 () { 0x00F } # Server Enterprise for Itanium-based Systems
+sub PRODUCT_BUSINESS_N () { 0x010 } # Business N
+sub PRODUCT_WEB_SERVER () { 0x011 } # Web Server (full installation)
+sub PRODUCT_CLUSTER_SERVER () { 0x012 } # HPC Edition
+sub PRODUCT_HOME_SERVER () { 0x013 } # Home Server Edition
+sub PRODUCT_STORAGE_EXPRESS_SERVER () { 0x014 } # Storage Server Express
+sub PRODUCT_STORAGE_STANDARD_SERVER () { 0x015 } # Storage Server Standard
+sub PRODUCT_STORAGE_WORKGROUP_SERVER () { 0x016 } # Storage Server Workgroup
+sub PRODUCT_STORAGE_ENTERPRISE_SERVER () { 0x017 } # Storage Server Enterprise
+sub PRODUCT_SERVER_FOR_SMALLBUSINESS () { 0x018 } # Windows Server 2008 for Windows Essential Server Solutions
+sub PRODUCT_SMALLBUSINESS_SERVER_PREMIUM () { 0x019 } # Windows Small Business Server Premium
+sub PRODUCT_HOME_PREMIUM_N () { 0x01A } # Home Premium N
+sub PRODUCT_ENTERPRISE_N () { 0x01B } # Enterprise N
+sub PRODUCT_ULTIMATE_N () { 0x01C } # Ultimate N
+sub PRODUCT_WEB_SERVER_CORE () { 0x01D } # Web Server (core installation)
+sub PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT () { 0x01E } # Windows Essential Business Server Management Server
+sub PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY () { 0x01F } # Windows Essential Business Server Security Server
+sub PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING () { 0x020 } # Windows Essential Business Server Messaging Server
+sub PRODUCT_SERVER_FOUNDATION () { 0x021 } # Server Foundation
+
+sub PRODUCT_SERVER_FOR_SMALLBUSINESS_V () { 0x023 } # Windows Server 2008 without Hyper-V for Windows Essential Server Solutions
+sub PRODUCT_STANDARD_SERVER_V () { 0x024 } # Server Standard without Hyper-V (full installation)
+sub PRODUCT_DATACENTER_SERVER_V () { 0x025 } # Server Datacenter without Hyper-V (full installation)
+sub PRODUCT_ENTERPRISE_SERVER_V () { 0x026 } # Server Enterprise without Hyper-V (full installation)
+sub PRODUCT_DATACENTER_SERVER_CORE_V () { 0x027 } # Server Datacenter without Hyper-V (core installation)
+sub PRODUCT_STANDARD_SERVER_CORE_V () { 0x028 } # Server Standard without Hyper-V (core installation)
+sub PRODUCT_ENTERPRISE_SERVER_CORE_V () { 0x029 } # Server Enterprise without Hyper-V (core installation)
+sub PRODUCT_HYPERV () { 0x02A } # Microsoft Hyper-V Server
+
+sub PRODUCT_STARTER_N () { 0x02F } # Starter N
+sub PRODUCT_PROFESSIONAL () { 0x030 } # Professional
+sub PRODUCT_PROFESSIONAL_N () { 0x031 } # Professional N
+
+sub PRODUCT_STARTER_E () { 0x042 } # Starter E
+sub PRODUCT_HOME_BASIC_E () { 0x043 } # Home Basic E
+sub PRODUCT_HOME_PREMIUM_E () { 0x044 } # Home Premium E
+sub PRODUCT_PROFESSIONAL_E () { 0x045 } # Professional E
+sub PRODUCT_ENTERPRISE_E () { 0x046 } # Enterprise E
+sub PRODUCT_ULTIMATE_E () { 0x047 } # Ultimate E
+
+sub PRODUCT_UNLICENSED () { 0xABCDABCD } # product has not been activated and is no longer in the grace period
+
+sub PROCESSOR_ARCHITECTURE_AMD64 () { 9 } # x64 (AMD or Intel)
+sub PROCESSOR_ARCHITECTURE_IA64 () { 6 } # Intel Itanium Processor Family (IPF)
+sub PROCESSOR_ARCHITECTURE_INTEL () { 0 } # x86
+sub PROCESSOR_ARCHITECTURE_UNKNOWN () { 0xffff } # Unknown architecture.
+
+sub _GetProcessorArchitecture {
+ my $arch = {
+ 386 => PROCESSOR_ARCHITECTURE_INTEL,
+ 486 => PROCESSOR_ARCHITECTURE_INTEL,
+ 586 => PROCESSOR_ARCHITECTURE_INTEL,
+ 2200 => PROCESSOR_ARCHITECTURE_IA64,
+ 8664 => PROCESSOR_ARCHITECTURE_AMD64,
+ }->{Win32::GetChipName()};
+ return defined($arch) ? $arch : PROCESSOR_ARCHITECTURE_UNKNOWN;
+}
+
+### This method is just a simple interface into GetOSVersion(). More
+### specific or demanding situations should use that instead.
+
+my ($cached_os, $cached_desc);
+
+sub GetOSName {
+ unless (defined $cached_os) {
+ my($desc, $major, $minor, $build, $id, undef, undef, $suitemask, $producttype)
+ = Win32::GetOSVersion();
+ my $arch = _GetProcessorArchitecture();
+ my $productinfo = Win32::GetProductInfo(6, 0, 0, 0);
+ ($cached_os, $cached_desc) = _GetOSName($desc, $major, $minor, $build, $id,
+ $suitemask, $producttype, $productinfo, $arch);
+ }
+ return wantarray ? ($cached_os, $cached_desc) : $cached_os;
+}
+
+sub GetOSDisplayName {
+ # Calling GetOSDisplayName() with arguments is for the test suite only!
+ my($name,$desc) = @_ ? @_ : GetOSName();
+ $name =~ s/^Win//;
+ if ($desc =~ /^Windows Home Server\b/ || $desc =~ /^Windows XP Professional x64 Edition\b/) {
+ ($name, $desc) = ($desc, "");
+ }
+ elsif ($desc =~ s/\s*(Windows (.*) Server( \d+)?)//) {
+ $name = "$1 $name";
+ $desc =~ s/^\s+//;
+ }
+ else {
+ for ($name) {
+ s/^/Windows / unless /^Win32s$/;
+ s/\/.Net//;
+ s/NT(\d)/NT $1/;
+ if ($desc =~ s/\s*(HPC|Small Business|Web) Server//) {
+ my $name = $1;
+ $desc =~ s/^\s*//;
+ s/(200.)/$name Server $1/;
+ }
+ s/^Windows (200[38])/Windows Server $1/;
+ }
+ }
+ $name .= " $desc" if length $desc;
+ return $name;
+}
+
+sub _GetSystemMetrics {
+ my($index,$metrics) = @_;
+ return Win32::GetSystemMetrics($index) unless ref $metrics;
+ return $metrics->{$index} if ref $metrics eq "HASH" && defined $metrics->{$index};
+ return 1 if ref $metrics eq "ARRAY" && grep $_ == $index, @$metrics;
+ return 0;
+}
+
+sub _GetOSName {
+ # The $metrics argument only exists for the benefit of t/GetOSName.t
+ my($csd, $major, $minor, $build, $id, $suitemask, $producttype, $productinfo, $arch, $metrics) = @_;
+
+ my($os,@tags);
+ my $desc = "";
+ if ($id == 0) {
+ $os = "Win32s";
+ }
+ elsif ($id == 1) {
+ if ($minor == 0) {
+ $os = "95";
+ }
+ elsif ($minor == 10) {
+ $os = "98";
+ }
+ elsif ($minor == 90) {
+ $os = "Me";
+ }
+ }
+ elsif ($id == 2) {
+ if ($major == 3) {
+ $os = "NT3.51";
+ }
+ elsif ($major == 4) {
+ $os = "NT4";
+ }
+ elsif ($major == 5) {
+ if ($minor == 0) {
+ $os = "2000";
+ if ($producttype == VER_NT_WORKSTATION) {
+ $desc = "Professional";
+ }
+ else {
+ if ($suitemask & VER_SUITE_DATACENTER) {
+ $desc = "Datacenter Server";
+ }
+ elsif ($suitemask & VER_SUITE_ENTERPRISE) {
+ $desc = "Advanced Server";
+ }
+ elsif ($suitemask & VER_SUITE_SMALLBUSINESS_RESTRICTED) {
+ $desc = "Small Business Server";
+ }
+ else {
+ $desc = "Server";
+ }
+ }
+ # XXX ignoring "Windows 2000 Advanced Server Limited Edition" for Itanium
+ # XXX and "Windows 2000 Datacenter Server Limited Edition" for Itanium
+ }
+ elsif ($minor == 1) {
+ $os = "XP/.Net";
+ if (_GetSystemMetrics(SM_MEDIACENTER, $metrics)) {
+ $desc = "Media Center Edition";
+ }
+ elsif (_GetSystemMetrics(SM_TABLETPC, $metrics)) {
+ # Tablet PC Edition is based on XP Pro
+ $desc = "Tablet PC Edition";
+ }
+ elsif (_GetSystemMetrics(SM_STARTER, $metrics)) {
+ $desc = "Starter Edition";
+ }
+ elsif ($suitemask & VER_SUITE_PERSONAL) {
+ $desc = "Home Edition";
+ }
+ else {
+ $desc = "Professional";
+ }
+ # XXX ignoring all Windows XP Embedded and Fundamentals versions
+ }
+ elsif ($minor == 2) {
+ $os = "2003";
+
+ if (_GetSystemMetrics(SM_SERVERR2, $metrics)) {
+ # XXX R2 was released for all x86 and x64 versions,
+ # XXX but only Enterprise Edition for Itanium.
+ $desc = "R2";
+ }
+
+ if ($suitemask == VER_SUITE_STORAGE_SERVER) {
+ $desc .= " Windows Storage Server";
+ }
+ elsif ($suitemask == VER_SUITE_WH_SERVER) {
+ $desc .= " Windows Home Server";
+ }
+ elsif ($producttype == VER_NT_WORKSTATION && $arch == PROCESSOR_ARCHITECTURE_AMD64) {
+ $desc .= " Windows XP Professional x64 Edition";
+ }
+
+ # Test for the server type.
+ if ($producttype != VER_NT_WORKSTATION) {
+ if ($arch == PROCESSOR_ARCHITECTURE_IA64) {
+ if ($suitemask & VER_SUITE_DATACENTER) {
+ $desc .= " Datacenter Edition for Itanium-based Systems";
+ }
+ elsif ($suitemask & VER_SUITE_ENTERPRISE) {
+ $desc .= " Enterprise Edition for Itanium-based Systems";
+ }
+ }
+ elsif ($arch == PROCESSOR_ARCHITECTURE_AMD64) {
+ if ($suitemask & VER_SUITE_DATACENTER) {
+ $desc .= " Datacenter x64 Edition";
+ }
+ elsif ($suitemask & VER_SUITE_ENTERPRISE) {
+ $desc .= " Enterprise x64 Edition";
+ }
+ else {
+ $desc .= " Standard x64 Edition";
+ }
+ }
+ else {
+ if ($suitemask & VER_SUITE_COMPUTE_SERVER) {
+ $desc .= " Windows Compute Cluster Server";
+ }
+ elsif ($suitemask & VER_SUITE_DATACENTER) {
+ $desc .= " Datacenter Edition";
+ }
+ elsif ($suitemask & VER_SUITE_ENTERPRISE) {
+ $desc .= " Enterprise Edition";
+ }
+ elsif ($suitemask & VER_SUITE_BLADE) {
+ $desc .= " Web Edition";
+ }
+ elsif ($suitemask & VER_SUITE_SMALLBUSINESS_RESTRICTED) {
+ $desc .= " Small Business Server";
+ }
+ else {
+ if ($desc !~ /Windows (Home|Storage) Server/) {
+ $desc .= " Standard Edition";
+ }
+ }
+ }
+ }
+ }
+ }
+ elsif ($major == 6) {
+ if ($minor == 0) {
+ if ($producttype == VER_NT_WORKSTATION) {
+ $os = "Vista";
+ }
+ else {
+ $os = "2008";
+ }
+ }
+ elsif ($minor == 1) {
+ if ($producttype == VER_NT_WORKSTATION) {
+ $os = "7";
+ }
+ else {
+ $os = "2008";
+ $desc = "R2";
+ }
+ }
+
+ if ($productinfo == PRODUCT_ULTIMATE) {
+ $desc .= " Ultimate";
+ }
+ elsif ($productinfo == PRODUCT_HOME_PREMIUM) {
+ $desc .= " Home Premium";
+ }
+ elsif ($productinfo == PRODUCT_HOME_BASIC) {
+ $desc .= " Home Basic";
+ }
+ elsif ($productinfo == PRODUCT_ENTERPRISE) {
+ $desc .= " Enterprise";
+ }
+ elsif ($productinfo == PRODUCT_BUSINESS) {
+ # "Windows 7 Business" had a name change to "Windows 7 Professional"
+ $desc .= $minor == 0 ? " Business" : " Professional";
+ }
+ elsif ($productinfo == PRODUCT_STARTER) {
+ $desc .= " Starter";
+ }
+ elsif ($productinfo == PRODUCT_CLUSTER_SERVER) {
+ $desc .= " HPC Server";
+ }
+ elsif ($productinfo == PRODUCT_DATACENTER_SERVER) {
+ $desc .= " Datacenter";
+ }
+ elsif ($productinfo == PRODUCT_DATACENTER_SERVER_CORE) {
+ $desc .= " Datacenter Edition (core installation)";
+ }
+ elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER) {
+ $desc .= " Enterprise";
+ }
+ elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_CORE) {
+ $desc .= " Enterprise Edition (core installation)";
+ }
+ elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_IA64) {
+ $desc .= " Enterprise Edition for Itanium-based Systems";
+ }
+ elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER) {
+ $desc .= " Small Business Server";
+ }
+ elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER_PREMIUM) {
+ $desc .= " Small Business Server Premium Edition";
+ }
+ elsif ($productinfo == PRODUCT_STANDARD_SERVER) {
+ $desc .= " Standard";
+ }
+ elsif ($productinfo == PRODUCT_STANDARD_SERVER_CORE) {
+ $desc .= " Standard Edition (core installation)";
+ }
+ elsif ($productinfo == PRODUCT_WEB_SERVER) {
+ $desc .= " Web Server";
+ }
+ elsif ($productinfo == PRODUCT_PROFESSIONAL) {
+ $desc .= " Professional";
+ }
+
+ if ($arch == PROCESSOR_ARCHITECTURE_INTEL) {
+ $desc .= " (32-bit)";
+ }
+ elsif ($arch == PROCESSOR_ARCHITECTURE_AMD64) {
+ $desc .= " (64-bit)";
+ }
+ }
+ }
+
+ unless (defined $os) {
+ warn "Unknown Windows version [$id:$major:$minor]";
+ return;
+ }
+
+ for ($desc) {
+ s/\s\s+/ /g;
+ s/^\s//;
+ s/\s$//;
+ }
+
+ # XXX What about "Small Business Server"? NT, 200, 2003, 2008 editions...
+
+ if ($major >= 5) {
+ # XXX XP, Vista, 7 all have starter editions
+ #push(@tags, "Starter Edition") if _GetSystemMetrics(SM_STARTER, $metrics);
+ }
+
+ if (@tags) {
+ unshift(@tags, $desc) if length $desc;
+ $desc = join(" ", @tags);
+ }
+
+ if (length $csd) {
+ $desc .= " " if length $desc;
+ $desc .= $csd;
+ }
+ return ("Win$os", $desc);
+}
+
+# "no warnings 'redefine';" doesn't work for 5.8.7 and earlier
+local $^W = 0;
+bootstrap Win32;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Win32 - Interfaces to some Win32 API Functions
+
+=head1 DESCRIPTION
+
+The Win32 module contains functions to access Win32 APIs.
+
+=head2 Alphabetical Listing of Win32 Functions
+
+It is recommended to C<use Win32;> before any of these functions;
+however, for backwards compatibility, those marked as [CORE] will
+automatically do this for you.
+
+In the function descriptions below the term I<Unicode string> is used
+to indicate that the string may contain characters outside the system
+codepage. The caveat I<If supported by the core Perl version>
+generally means Perl 5.8.9 and later, though some Unicode pathname
+functionality may work on earlier versions.
+
+=over
+
+=item Win32::AbortSystemShutdown(MACHINE)
+
+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<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.
+
+=item Win32::CreateDirectory(DIRECTORY)
+
+Creates the DIRECTORY and returns a true value on success. Check $^E
+on failure for extended error information.
+
+DIRECTORY may contain Unicode characters outside the system codepage.
+Once the directory has been created you can use
+Win32::GetANSIPathName() to get a name that can be passed to system
+calls and external programs.
+
+=item Win32::CreateFile(FILE)
+
+Creates the FILE and returns a true value on success. Check $^E on
+failure for extended error information.
+
+FILE may contain Unicode characters outside the system codepage. Once
+the file has been created you can use Win32::GetANSIPathName() to get
+a name that can be passed to system calls and external programs.
+
+=item Win32::DomainName()
+
+[CORE] Returns the name of the Microsoft Network domain or workgroup
+that the owner of the current perl process is logged into. The
+"Workstation" service must be running to determine this
+information. This function does B<not> work on Windows 9x.
+
+=item Win32::ExpandEnvironmentStrings(STRING)
+
+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
+
+However, this function may return a Unicode string if the environment
+variable being expanded hasn't been assigned to via %ENV. Access
+to %ENV is currently always using byte semantics.
+
+=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)
+
+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::GetACP()
+
+Returns the current Windows ANSI code page identifier for the operating
+system. See also GetOEMCP(), GetConsoleCP() and GetConsoleOutputCP().
+
+=item Win32::GetANSIPathName(FILENAME)
+
+Returns an ANSI version of FILENAME. This may be the short name
+if the long name cannot be represented in the system codepage.
+
+While not currently implemented, it is possible that in the future
+this function will convert only parts of the path to FILENAME to a
+short form.
+
+If FILENAME doesn't exist on the filesystem, or if the filesystem
+doesn't support short ANSI filenames, then this function will
+translate the Unicode name into the system codepage using replacement
+characters.
+
+=item Win32::GetArchName()
+
+Use of this function is deprecated. It is equivalent with
+$ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X.
+
+=item Win32::GetChipName()
+
+Returns the processor type: 386, 486 or 586 for x86 processors, 8664
+for the x64 processor and 2200 for the Itanium. Since it returns the
+native processor type it will return a 64-bit processor type even when
+called from a 32-bit Perl running on 64-bit Windows.
+
+=item Win32::GetConsoleCP()
+
+Returns the input code page used by the console associated with the
+calling process. To set the console's input code page, see
+SetConsoleCP(). See also GetConsoleOutputCP(), GetACP() and
+GetOEMCP().
+
+=item Win32::GetConsoleOutputCP()
+
+Returns the output code page used by the console associated with the
+calling process. To set the console's output code page, see
+SetConsoleOutputCP(). See also GetConsoleCP(), GetACP(), and
+GetOEMCP().
+
+=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.
+
+If supported by the core Perl version, this function will return an
+ANSI path name for the current directory if the long pathname cannot
+be represented in the system codepage.
+
+=item Win32::GetCurrentProcessId()
+
+Returns the process identifier of the current process. Until the
+process terminates, the process identifier uniquely identifies the
+process throughout the system.
+
+The current process identifier is normally also available via the
+predefined $$ variable. Under fork() emulation however $$ may contain
+a pseudo-process identifier that is only meaningful to the Perl
+kill(), wait() and waitpid() functions. The
+Win32::GetCurrentProcessId() function will always return the regular
+Windows process id, even when called from inside a pseudo-process.
+
+=item Win32::GetCurrentThreadId()
+
+Returns the thread identifier of the calling thread. Until the thread
+terminates, the thread identifier uniquely identifies the thread
+throughout the system.
+
+=item Win32::GetFileVersion(FILENAME)
+
+Returns the file version number from the VERSIONINFO resource of
+the executable file or DLL. This is a tuple of four 16 bit numbers.
+In list context these four numbers will be returned. In scalar context
+they are concatenated into a string, separated by dots.
+
+=item Win32::GetFolderPath(FOLDER [, CREATE])
+
+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
+
+This function will return an ANSI folder path if the long name cannot
+be represented in the system codepage. Use Win32::GetLongPathName()
+on the result of Win32::GetFolderPath() if you want the Unicode
+version of the folder name.
+
+=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().
+
+If supported by the core Perl version, this function will return an
+ANSI path name if the full pathname cannot be represented in the
+system codepage.
+
+=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 may return the pathname in Unicode if it cannot be
+represented in the system codepage. Use Win32::GetANSIPathName()
+before passing the path to a system call or another program.
+
+=item Win32::GetNextAvailDrive()
+
+[CORE] Returns a string in the form of "<d>:" where <d> is the first
+available drive letter.
+
+=item Win32::GetOEMCP()
+
+Returns the current original equipment manufacturer (OEM) code page
+identifier for the operating system. See also GetACP(), GetConsoleCP()
+and GetConsoleOutputCP().
+
+=item Win32::GetOSDisplayName()
+
+Returns the "marketing" name of the Windows operating system version
+being used. It returns names like these (random samples):
+
+ Windows 2000 Datacenter Server
+ Windows XP Professional
+ Windows XP Tablet PC Edition
+ Windows Home Server
+ Windows Server 2003 Enterprise Edition for Itanium-based Systems
+ Windows Vista Ultimate (32-bit)
+ Windows Small Business Server 2008 R2 (64-bit)
+
+The display name describes the native Windows version, so even on a
+32-bit Perl this function may return a "Windows ... (64-bit)" name
+when running on a 64-bit Windows.
+
+This function should only be used to display the actual OS name to the
+user; it should not be used to determine the class of operating systems
+this system belongs to. The Win32::GetOSName(), Win32::GetOSVersion,
+Win32::GetProductInfo() and Win32::GetSystemMetrics() functions provide
+the base information to check for certain capabilities, or for families
+of OS releases.
+
+=item Win32::GetOSName()
+
+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.
+
+The description will also include tags for other special editions,
+like "R2", "Media Center", "Tablet PC", or "Starter Edition".
+
+Currently the possible values for the OS name are
+
+ WinWin32s
+ Win95
+ Win98
+ WinMe
+ WinNT3.51
+ WinNT4
+ Win2000
+ WinXP/.Net
+ Win2003
+ WinHomeSvr
+ WinVista
+ Win2008
+ Win7
+
+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.
+
+Similarly the name "WinWin32s" should have been "Win32s" but has been
+kept as-is for backwards compatibility reasons too.
+
+=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/Vista/2008/7. 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
+ Windows Server 2003 R2 2 5 2
+ Windows Home Server 2 5 2
+
+ Windows Vista 2 6 0
+ Windows Server 2008 2 6 0
+ Windows 7 2 6 1
+ Windows Server 2008 R2 2 6 1
+
+On Windows NT 4 SP6 and later this function returns the following
+additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE.
+
+The version numbers for Windows 2003 and Windows Home Server are
+identical; the SUITEMASK field must be used to differentiate between\
+them.
+
+The version numbers for Windows Vista and Windows Server 2008 are
+identical; the PRODUCTTYPE field must be used to differentiate between
+them.
+
+The version numbers for Windows 7 and Windows Server 2008 R2 are
+identical; the PRODUCTTYPE field must be used to differentiate between
+them.
+
+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
+ VER_SUITE_STORAGE_SERVER 0x00002000
+ VER_SUITE_COMPUTE_SERVER 0x00004000
+ VER_SUITE_WH_SERVER 0x00008000
+
+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, Vista)
+ 2 - Domaincontroller
+ 3 - Server (2000 Server, Server 2003, Server 2008)
+
+Note that a server that is also a domain controller is reported as
+PRODUCTTYPE 2 (Domaincontroller) and not PRODUCTTYPE 3 (Server).
+
+=item Win32::GetShortPathName(PATHNAME)
+
+[CORE] Returns a representation of PATHNAME that is composed of short
+(8.3) path components where available. For path components where the
+file system has not generated the short form the returned path will
+use the long form, so this function might still for instance return a
+path containing spaces. Returns C<undef> when the PATHNAME does not
+exist. Compare with Win32::GetFullPathName() and
+Win32::GetLongPathName().
+
+=item Win32::GetSystemMetrics(INDEX)
+
+Retrieves the specified system metric or system configuration setting.
+Please refer to the Microsoft documentation of the GetSystemMetrics()
+function for a reference of available INDEX values. All system
+metrics return integer values.
+
+=item Win32::GetProcAddress(INSTANCE, PROCNAME)
+
+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::GetProductInfo(OSMAJOR, OSMINOR, SPMAJOR, SPMINOR)
+
+Retrieves the product type for the operating system on the local
+computer, and maps the type to the product types supported by the
+specified operating system. Please refer to the Microsoft
+documentation of the GetProductInfo() function for more information
+about the parameters and return value. This function requires Windows
+Vista or later.
+
+See also the Win32::GetOSName() and Win32::GetOSDisplayName()
+functions which provide a higher level abstraction of the data
+returned by this 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::GuidGen()
+
+Creates a globally unique 128 bit integer that can be used as a
+persistent identifier in a distributed setting. To a very high degree
+of certainty this function returns a unique value. No other
+invocation, on the same or any other system (networked or not), should
+return the same value.
+
+The return value is formatted according to OLE conventions, as groups
+of hex digits with surrounding braces. For example:
+
+ {09531CF1-D0C7-4860-840C-1C8C8735E2AD}
+
+=item Win32::InitiateSystemShutdown
+
+(MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT)
+
+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()
+
+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.
+On Windows Vista it will only return non-zero if the process is
+actually running with elevated privileges. Returns C<undef>
+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)
+
+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.
+The return value may be a Unicode string.
+
+=item Win32::LookupAccountName(SYSTEM, ACCOUNT, DOMAIN, SID, SIDTYPE)
+
+Looks up ACCOUNT on SYSTEM and returns the domain name the SID and
+the SID type.
+
+=item Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE)
+
+Looks up SID on SYSTEM and returns the account name, domain name,
+and the SID type.
+
+=item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]])
+
+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::OutputDebugString(STRING)
+
+Sends a string to the application or system debugger for display.
+The function does nothing if there is no active debugger.
+
+Alternatively one can use the I<Debug Viewer> application to
+watch the OutputDebugString() output:
+
+http://www.microsoft.com/technet/sysinternals/utilities/debugview.mspx
+
+=item Win32::RegisterServer(LIBRARYNAME)
+
+Loads the DLL LIBRARYNAME and calls the function DllRegisterServer.
+
+=item Win32::SetChildShowWindow(SHOWWINDOW)
+
+[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
+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<undef>.
+
+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::SetConsoleCP(ID)
+
+Sets the input code page used by the console associated with the
+calling process. The return value of SetConsoleCP() is nonzero on
+success or zero on failure. To get the console's input code page, see
+GetConsoleCP().
+
+=item Win32::SetConsoleOutputCP(ID)
+
+Sets the output code page used by the console associated with the
+calling process. The return value of SetConsoleOutputCP() is nonzero on
+success or zero on failure. To get the console's output code page, see
+GetConsoleOutputCP().
+
+=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)
+
+Loads the DLL LIBRARYNAME and calls the function
+DllUnregisterServer.
+
+=back
+
+=cut
diff --git a/cpan/Win32/Win32.xs b/cpan/Win32/Win32.xs
index 8af0e888c6..1f573eb1b0 100644
--- a/cpan/Win32/Win32.xs
+++ b/cpan/Win32/Win32.xs
@@ -1,1775 +1,1829 @@
-#include <wctype.h>
-#include <windows.h>
-#include <shlobj.h>
-
-#define PERL_NO_GET_CONTEXT
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#ifndef countof
-# define countof(array) (sizeof (array) / sizeof (*(array)))
-#endif
-
-#define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege"
-
-#ifndef WC_NO_BEST_FIT_CHARS
-# define WC_NO_BEST_FIT_CHARS 0x00000400
-#endif
-
-#define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn)
-
-typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathA)(HWND, char*, int, BOOL);
-typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathW)(HWND, WCHAR*, int, BOOL);
-typedef HRESULT (WINAPI *PFNSHGetFolderPathA)(HWND, int, HANDLE, DWORD, LPTSTR);
-typedef HRESULT (WINAPI *PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR);
-typedef BOOL (WINAPI *PFNCreateEnvironmentBlock)(void**, HANDLE, BOOL);
-typedef BOOL (WINAPI *PFNDestroyEnvironmentBlock)(void*);
-typedef int (__stdcall *PFNDllRegisterServer)(void);
-typedef int (__stdcall *PFNDllUnregisterServer)(void);
-typedef DWORD (__stdcall *PFNNetApiBufferFree)(void*);
-typedef DWORD (__stdcall *PFNNetWkstaGetInfo)(LPWSTR, DWORD, void*);
-
-typedef BOOL (__stdcall *PFNOpenProcessToken)(HANDLE, DWORD, HANDLE*);
-typedef BOOL (__stdcall *PFNOpenThreadToken)(HANDLE, DWORD, BOOL, HANDLE*);
-typedef BOOL (__stdcall *PFNGetTokenInformation)(HANDLE, TOKEN_INFORMATION_CLASS, void*, DWORD, DWORD*);
-typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD,
- DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*);
-typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);
-typedef void* (__stdcall *PFNFreeSid)(PSID);
-typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);
-typedef BOOL (WINAPI *PFNGetProductInfo)(DWORD, DWORD, DWORD, DWORD, DWORD*);
-typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);
-
-#ifndef CSIDL_MYMUSIC
-# define CSIDL_MYMUSIC 0x000D
-#endif
-#ifndef CSIDL_MYVIDEO
-# define CSIDL_MYVIDEO 0x000E
-#endif
-#ifndef CSIDL_LOCAL_APPDATA
-# define CSIDL_LOCAL_APPDATA 0x001C
-#endif
-#ifndef CSIDL_COMMON_FAVORITES
-# define CSIDL_COMMON_FAVORITES 0x001F
-#endif
-#ifndef CSIDL_INTERNET_CACHE
-# define CSIDL_INTERNET_CACHE 0x0020
-#endif
-#ifndef CSIDL_COOKIES
-# define CSIDL_COOKIES 0x0021
-#endif
-#ifndef CSIDL_HISTORY
-# define CSIDL_HISTORY 0x0022
-#endif
-#ifndef CSIDL_COMMON_APPDATA
-# define CSIDL_COMMON_APPDATA 0x0023
-#endif
-#ifndef CSIDL_WINDOWS
-# define CSIDL_WINDOWS 0x0024
-#endif
-#ifndef CSIDL_PROGRAM_FILES
-# define CSIDL_PROGRAM_FILES 0x0026
-#endif
-#ifndef CSIDL_MYPICTURES
-# define CSIDL_MYPICTURES 0x0027
-#endif
-#ifndef CSIDL_PROFILE
-# define CSIDL_PROFILE 0x0028
-#endif
-#ifndef CSIDL_PROGRAM_FILES_COMMON
-# define CSIDL_PROGRAM_FILES_COMMON 0x002B
-#endif
-#ifndef CSIDL_COMMON_TEMPLATES
-# define CSIDL_COMMON_TEMPLATES 0x002D
-#endif
-#ifndef CSIDL_COMMON_DOCUMENTS
-# define CSIDL_COMMON_DOCUMENTS 0x002E
-#endif
-#ifndef CSIDL_COMMON_ADMINTOOLS
-# define CSIDL_COMMON_ADMINTOOLS 0x002F
-#endif
-#ifndef CSIDL_ADMINTOOLS
-# define CSIDL_ADMINTOOLS 0x0030
-#endif
-#ifndef CSIDL_COMMON_MUSIC
-# define CSIDL_COMMON_MUSIC 0x0035
-#endif
-#ifndef CSIDL_COMMON_PICTURES
-# define CSIDL_COMMON_PICTURES 0x0036
-#endif
-#ifndef CSIDL_COMMON_VIDEO
-# define CSIDL_COMMON_VIDEO 0x0037
-#endif
-#ifndef CSIDL_CDBURN_AREA
-# define CSIDL_CDBURN_AREA 0x003B
-#endif
-#ifndef CSIDL_FLAG_CREATE
-# define CSIDL_FLAG_CREATE 0x8000
-#endif
-
-/* Use explicit struct definition because wSuiteMask and
- * wProductType are not defined in the VC++ 6.0 headers.
- * WORD type has been replaced by unsigned short because
- * WORD is already used by Perl itself.
- */
-struct {
- DWORD dwOSVersionInfoSize;
- DWORD dwMajorVersion;
- DWORD dwMinorVersion;
- DWORD dwBuildNumber;
- DWORD dwPlatformId;
- CHAR szCSDVersion[128];
- unsigned short wServicePackMajor;
- unsigned short wServicePackMinor;
- unsigned short wSuiteMask;
- BYTE wProductType;
- BYTE wReserved;
-} g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0};
-BOOL g_osver_ex = TRUE;
-
-#define ONE_K_BUFSIZE 1024
-
-int
-IsWin95(void)
-{
- return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
-}
-
-int
-IsWinNT(void)
-{
- return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
-}
-
-int
-IsWin2000(void)
-{
- return (g_osver.dwMajorVersion > 4);
-}
-
-/* Convert SV to wide character string. The return value must be
- * freed using Safefree().
- */
-WCHAR*
-sv_to_wstr(pTHX_ SV *sv)
-{
- DWORD wlen;
- WCHAR *wstr;
- STRLEN len;
- char *str = SvPV(sv, len);
- UINT cp = SvUTF8(sv) ? CP_UTF8 : CP_ACP;
-
- wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0);
- New(0, wstr, wlen, WCHAR);
- MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen);
-
- return wstr;
-}
-
-/* Convert wide character string to mortal SV. Use UTF8 encoding
- * if the string cannot be represented in the system codepage.
- */
-SV *
-wstr_to_sv(pTHX_ WCHAR *wstr)
-{
- int wlen = (int)wcslen(wstr)+1;
- BOOL use_default = FALSE;
- int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, NULL, 0, NULL, NULL);
- SV *sv = sv_2mortal(newSV(len));
-
- len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, SvPVX(sv), len, NULL, &use_default);
- if (use_default) {
- len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, NULL, 0, NULL, NULL);
- sv_grow(sv, len);
- len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, SvPVX(sv), len, NULL, NULL);
- SvUTF8_on(sv);
- }
- /* Shouldn't really ever fail since we ask for the required length first, but who knows... */
- if (len) {
- SvPOK_on(sv);
- SvCUR_set(sv, len-1);
- }
- return sv;
-}
-
-/* Retrieve a variable from the Unicode environment in a mortal SV.
- *
- * Recreates the Unicode environment because a bug in earlier Perl versions
- * overwrites it with the ANSI version, which contains replacement
- * characters for the characters not in the ANSI codepage.
- */
-SV*
-get_unicode_env(pTHX_ WCHAR *name)
-{
- SV *sv = NULL;
- void *env;
- HANDLE token;
- HMODULE module;
- PFNOpenProcessToken pfnOpenProcessToken;
-
- /* Get security token for the current process owner */
- module = LoadLibrary("advapi32.dll");
- if (!module)
- return NULL;
-
- GETPROC(OpenProcessToken);
-
- if (pfnOpenProcessToken == NULL ||
- !pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY | TOKEN_DUPLICATE, &token))
- {
- FreeLibrary(module);
- return NULL;
- }
- FreeLibrary(module);
-
- /* Create a Unicode environment block for this process */
- module = LoadLibrary("userenv.dll");
- if (module) {
- PFNCreateEnvironmentBlock pfnCreateEnvironmentBlock;
- PFNDestroyEnvironmentBlock pfnDestroyEnvironmentBlock;
-
- GETPROC(CreateEnvironmentBlock);
- GETPROC(DestroyEnvironmentBlock);
-
- if (pfnCreateEnvironmentBlock && pfnDestroyEnvironmentBlock &&
- pfnCreateEnvironmentBlock(&env, token, FALSE))
- {
- size_t name_len = wcslen(name);
- WCHAR *entry = env;
- while (*entry) {
- size_t i;
- size_t entry_len = wcslen(entry);
- BOOL equal = (entry_len > name_len) && (entry[name_len] == '=');
-
- for (i=0; equal && i < name_len; ++i)
- equal = (towupper(entry[i]) == towupper(name[i]));
-
- if (equal) {
- sv = wstr_to_sv(aTHX_ entry+name_len+1);
- break;
- }
- entry += entry_len+1;
- }
- pfnDestroyEnvironmentBlock(env);
- }
- FreeLibrary(module);
- }
- CloseHandle(token);
- return sv;
-}
-
-/* Define both an ANSI and a Wide version of win32_longpath */
-
-#define CHAR_T char
-#define WIN32_FIND_DATA_T WIN32_FIND_DATAA
-#define FN_FINDFIRSTFILE FindFirstFileA
-#define FN_STRLEN strlen
-#define FN_STRCPY strcpy
-#define LONGPATH my_longpathA
-#include "longpath.inc"
-
-#define CHAR_T WCHAR
-#define WIN32_FIND_DATA_T WIN32_FIND_DATAW
-#define FN_FINDFIRSTFILE FindFirstFileW
-#define FN_STRLEN wcslen
-#define FN_STRCPY wcscpy
-#define LONGPATH my_longpathW
-#include "longpath.inc"
-
-/* The my_ansipath() function takes a Unicode filename and converts it
- * into the current Windows codepage. If some characters cannot be mapped,
- * then it will convert the short name instead.
- *
- * The buffer to the ansi pathname must be freed with Safefree() when it
- * it no longer needed.
- *
- * The argument to my_ansipath() must exist before this function is
- * called; otherwise there is no way to determine the short path name.
- *
- * Ideas for future refinement:
- * - Only convert those segments of the path that are not in the current
- * codepage, but leave the other segments in their long form.
- * - If the resulting name is longer than MAX_PATH, start converting
- * additional path segments into short names until the full name
- * is shorter than MAX_PATH. Shorten the filename part last!
- */
-
-/* This is a modified version of core Perl win32/win32.c(win32_ansipath).
- * It uses New() etc. instead of win32_malloc().
- */
-
-char *
-my_ansipath(const WCHAR *widename)
-{
- char *name;
- BOOL use_default = FALSE;
- int widelen = (int)wcslen(widename)+1;
- int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
- NULL, 0, NULL, NULL);
- New(0, name, len, char);
- WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
- name, len, NULL, &use_default);
- if (use_default) {
- DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
- if (shortlen) {
- WCHAR *shortname;
- New(0, shortname, shortlen, WCHAR);
- shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
-
- len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
- NULL, 0, NULL, NULL);
- Renew(name, len, char);
- WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
- name, len, NULL, NULL);
- Safefree(shortname);
- }
- }
- return name;
-}
-
-/* Convert wide character path to ANSI path and return as mortal SV. */
-SV*
-wstr_to_ansipath(pTHX_ WCHAR *wstr)
-{
- char *ansi = my_ansipath(wstr);
- SV *sv = sv_2mortal(newSVpvn(ansi, strlen(ansi)));
- Safefree(ansi);
- return sv;
-}
-
-#ifdef __CYGWIN__
-
-char*
-get_childdir(void)
-{
- dTHX;
- char* ptr;
-
- if (IsWin2000()) {
- WCHAR filename[MAX_PATH+1];
- GetCurrentDirectoryW(MAX_PATH+1, filename);
- ptr = my_ansipath(filename);
- }
- else {
- char filename[MAX_PATH+1];
- GetCurrentDirectoryA(MAX_PATH+1, filename);
- New(0, ptr, strlen(filename)+1, char);
- strcpy(ptr, filename);
- }
- return ptr;
-}
-
-void
-free_childdir(char *d)
-{
- dTHX;
- Safefree(d);
-}
-
-void*
-get_childenv(void)
-{
- return NULL;
-}
-
-void
-free_childenv(void *d)
-{
-}
-
-# define PerlDir_mapA(dir) (dir)
-
-#endif
-
-XS(w32_ExpandEnvironmentStrings)
-{
- dXSARGS;
-
- if (items != 1)
- croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
-
- if (IsWin2000()) {
- WCHAR value[31*1024];
- WCHAR *source = sv_to_wstr(aTHX_ ST(0));
- ExpandEnvironmentStringsW(source, value, countof(value)-1);
- ST(0) = wstr_to_sv(aTHX_ value);
- Safefree(source);
- XSRETURN(1);
- }
- else {
- char value[31*1024];
- ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), value, countof(value)-2);
- XSRETURN_PV(value);
- }
-}
-
-XS(w32_IsAdminUser)
-{
- dXSARGS;
- HMODULE module;
- PFNIsUserAnAdmin pfnIsUserAnAdmin;
- PFNOpenThreadToken pfnOpenThreadToken;
- PFNOpenProcessToken pfnOpenProcessToken;
- PFNGetTokenInformation pfnGetTokenInformation;
- PFNAllocateAndInitializeSid pfnAllocateAndInitializeSid;
- PFNEqualSid pfnEqualSid;
- PFNFreeSid pfnFreeSid;
- HANDLE hTok;
- DWORD dwTokInfoLen;
- TOKEN_GROUPS *lpTokInfo;
- SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY;
- PSID pAdminSid;
- int iRetVal;
- unsigned int i;
-
- if (items)
- croak("usage: Win32::IsAdminUser()");
-
- /* There is no concept of "Administrator" user accounts on Win9x systems,
- so just return true. */
- if (IsWin95())
- XSRETURN_YES;
-
- /* Use IsUserAnAdmin() when available. On Vista this will only return TRUE
- * if the process is running with elevated privileges and not just when the
- * process owner is a member of the "Administrators" group.
- */
- module = LoadLibrary("shell32.dll");
- if (module) {
- GETPROC(IsUserAnAdmin);
- if (pfnIsUserAnAdmin) {
- EXTEND(SP, 1);
- ST(0) = sv_2mortal(newSViv(pfnIsUserAnAdmin() ? 1 : 0));
- FreeLibrary(module);
- XSRETURN(1);
- }
- FreeLibrary(module);
- }
-
- module = LoadLibrary("advapi32.dll");
- if (!module) {
- warn("Cannot load advapi32.dll library");
- XSRETURN_UNDEF;
- }
-
- GETPROC(OpenThreadToken);
- GETPROC(OpenProcessToken);
- GETPROC(GetTokenInformation);
- GETPROC(AllocateAndInitializeSid);
- GETPROC(EqualSid);
- GETPROC(FreeSid);
-
- if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
- pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
- pfnEqualSid && pfnFreeSid))
- {
- warn("Cannot load functions from advapi32.dll library");
- FreeLibrary(module);
- XSRETURN_UNDEF;
- }
-
- if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
- if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
- warn("Cannot open thread token or process token");
- FreeLibrary(module);
- XSRETURN_UNDEF;
- }
- }
-
- pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
- if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
- warn("Cannot allocate token information structure");
- CloseHandle(hTok);
- FreeLibrary(module);
- XSRETURN_UNDEF;
- }
-
- if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
- &dwTokInfoLen))
- {
- warn("Cannot get token information");
- Safefree(lpTokInfo);
- CloseHandle(hTok);
- FreeLibrary(module);
- 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(module);
- 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(module);
-
- 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;
- BOOL bResult;
-
- if (items != 5)
- croak("usage: Win32::LookupAccountName($system, $account, $domain, "
- "$sid, $sidtype);\n");
-
- SIDLen = sizeof(SID);
- DomLen = sizeof(Domain);
-
- bResult = LookupAccountNameA(SvPV_nolen(ST(0)), /* System */
- SvPV_nolen(ST(1)), /* 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;
- }
- XSRETURN_NO;
-}
-
-
-XS(w32_LookupAccountSID)
-{
- dXSARGS;
- PSID sid;
- char Account[256];
- DWORD AcctLen = sizeof(Account);
- char Domain[256];
- DWORD DomLen = sizeof(Domain);
- SID_NAME_USE snu;
- BOOL bResult;
-
- if (items != 5)
- croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
-
- sid = SvPV_nolen(ST(1));
- if (IsValidSid(sid)) {
- bResult = LookupAccountSidA(SvPV_nolen(ST(0)), /* 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;
- }
- }
- XSRETURN_NO;
-}
-
-XS(w32_InitiateSystemShutdown)
-{
- dXSARGS;
- HANDLE hToken; /* handle to process token */
- TOKEN_PRIVILEGES tkp; /* pointer to token structure */
- BOOL bRet;
- char *machineName, *message;
-
- if (items != 5)
- croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
- "$timeOut, $forceClose, $reboot);\n");
-
- machineName = SvPV_nolen(ST(0));
-
- if (OpenProcessToken(GetCurrentProcess(),
- TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
- &hToken))
- {
- 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_nolen(ST(1));
- bRet = InitiateSystemShutdownA(machineName, message, (DWORD)SvIV(ST(2)),
- (BOOL)SvIV(ST(3)), (BOOL)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;
-
- if (items != 1)
- croak("usage: Win32::AbortSystemShutdown($machineName);\n");
-
- machineName = SvPV_nolen(ST(0));
-
- if (OpenProcessToken(GetCurrentProcess(),
- TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
- &hToken))
- {
- 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);
- }
-
- 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;
- DWORD flags = MB_ICONEXCLAMATION;
- I32 result;
-
- if (items < 1 || items > 3)
- croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
-
- if (items > 1)
- flags = (DWORD)SvIV(ST(1));
-
- if (IsWin2000()) {
- WCHAR *title = NULL;
- WCHAR *msg = sv_to_wstr(aTHX_ ST(0));
- if (items > 2)
- title = sv_to_wstr(aTHX_ ST(2));
- result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags);
- Safefree(msg);
- if (title)
- Safefree(title);
- }
- else {
- char *title = "Perl";
- char *msg = SvPV_nolen(ST(0));
- if (items > 2)
- title = SvPV_nolen(ST(2));
- result = MessageBoxA(GetActiveWindow(), msg, title, flags);
- }
- XSRETURN_IV(result);
-}
-
-XS(w32_LoadLibrary)
-{
- dXSARGS;
- HANDLE hHandle;
-
- if (items != 1)
- croak("usage: Win32::LoadLibrary($libname)\n");
- hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
-#ifdef _WIN64
- XSRETURN_IV((DWORD_PTR)hHandle);
-#else
- XSRETURN_IV((DWORD)hHandle);
-#endif
-}
-
-XS(w32_FreeLibrary)
-{
- dXSARGS;
-
- if (items != 1)
- croak("usage: Win32::FreeLibrary($handle)\n");
- if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
- XSRETURN_YES;
- }
- XSRETURN_NO;
-}
-
-XS(w32_GetProcAddress)
-{
- dXSARGS;
-
- if (items != 2)
- croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
- XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
-}
-
-XS(w32_RegisterServer)
-{
- dXSARGS;
- BOOL result = FALSE;
- HMODULE module;
-
- if (items != 1)
- croak("usage: Win32::RegisterServer($libname)\n");
-
- module = LoadLibraryA(SvPV_nolen(ST(0)));
- if (module) {
- PFNDllRegisterServer pfnDllRegisterServer;
- GETPROC(DllRegisterServer);
- if (pfnDllRegisterServer && pfnDllRegisterServer() == 0)
- result = TRUE;
- FreeLibrary(module);
- }
- ST(0) = boolSV(result);
- XSRETURN(1);
-}
-
-XS(w32_UnregisterServer)
-{
- dXSARGS;
- BOOL result = FALSE;
- HINSTANCE module;
-
- if (items != 1)
- croak("usage: Win32::UnregisterServer($libname)\n");
-
- module = LoadLibraryA(SvPV_nolen(ST(0)));
- if (module) {
- PFNDllUnregisterServer pfnDllUnregisterServer;
- GETPROC(DllUnregisterServer);
- if (pfnDllUnregisterServer && pfnDllUnregisterServer() == 0)
- result = TRUE;
- FreeLibrary(module);
- }
- ST(0) = boolSV(result);
- XSRETURN(1);
-}
-
-/* XXX rather bogus */
-XS(w32_GetArchName)
-{
- dXSARGS;
- XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
-}
-
-XS(w32_GetChipName)
-{
- dXSARGS;
- SYSTEM_INFO sysinfo;
- HMODULE module;
- PFNGetNativeSystemInfo pfnGetNativeSystemInfo;
-
- Zero(&sysinfo,1,SYSTEM_INFO);
- module = GetModuleHandle("kernel32.dll");
- GETPROC(GetNativeSystemInfo);
- if (pfnGetNativeSystemInfo)
- pfnGetNativeSystemInfo(&sysinfo);
- else
- 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;
- if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
- WideCharToMultiByte(CP_ACP, 0, pStr, (int)wcslen(pStr), szGUID,
- sizeof(szGUID), NULL, NULL);
- CoTaskMemFree(pStr);
- XSRETURN_PV(szGUID);
- }
- }
- XSRETURN_UNDEF;
-}
-
-XS(w32_GetFolderPath)
-{
- dXSARGS;
- char path[MAX_PATH+1];
- WCHAR wpath[MAX_PATH+1];
- int folder;
- int create = 0;
- HMODULE module;
-
- if (items != 1 && items != 2)
- croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
-
- folder = (int)SvIV(ST(0));
- if (items == 2)
- create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
-
- module = LoadLibrary("shfolder.dll");
- if (module) {
- PFNSHGetFolderPathA pfna;
- if (IsWin2000()) {
- PFNSHGetFolderPathW pfnw;
- pfnw = (PFNSHGetFolderPathW)GetProcAddress(module, "SHGetFolderPathW");
- if (pfnw && SUCCEEDED(pfnw(NULL, folder|create, NULL, 0, wpath))) {
- FreeLibrary(module);
- ST(0) = wstr_to_ansipath(aTHX_ wpath);
- XSRETURN(1);
- }
- }
- pfna = (PFNSHGetFolderPathA)GetProcAddress(module, "SHGetFolderPathA");
- if (pfna && SUCCEEDED(pfna(NULL, folder|create, NULL, 0, path))) {
- FreeLibrary(module);
- XSRETURN_PV(path);
- }
- FreeLibrary(module);
- }
-
- module = LoadLibrary("shell32.dll");
- if (module) {
- PFNSHGetSpecialFolderPathA pfna;
- if (IsWin2000()) {
- PFNSHGetSpecialFolderPathW pfnw;
- pfnw = (PFNSHGetSpecialFolderPathW)GetProcAddress(module, "SHGetSpecialFolderPathW");
- if (pfnw && pfnw(NULL, wpath, folder, !!create)) {
- FreeLibrary(module);
- ST(0) = wstr_to_ansipath(aTHX_ wpath);
- XSRETURN(1);
- }
- }
- pfna = (PFNSHGetSpecialFolderPathA)GetProcAddress(module, "SHGetSpecialFolderPathA");
- if (pfna && pfna(NULL, path, folder, !!create)) {
- FreeLibrary(module);
- XSRETURN_PV(path);
- }
- FreeLibrary(module);
- }
-
- /* SHGetFolderPathW() and SHGetSpecialFolderPathW() may fail on older
- * Perl versions that have replaced the Unicode environment with an
- * ANSI version. Let's go spelunking in the registry now...
- */
- if (IsWin2000()) {
- SV *sv;
- HKEY hkey;
- HKEY root = HKEY_CURRENT_USER;
- WCHAR *name = NULL;
-
- switch (folder) {
- case CSIDL_ADMINTOOLS: name = L"Administrative Tools"; break;
- case CSIDL_APPDATA: name = L"AppData"; break;
- case CSIDL_CDBURN_AREA: name = L"CD Burning"; break;
- case CSIDL_COOKIES: name = L"Cookies"; break;
- case CSIDL_DESKTOP:
- case CSIDL_DESKTOPDIRECTORY: name = L"Desktop"; break;
- case CSIDL_FAVORITES: name = L"Favorites"; break;
- case CSIDL_FONTS: name = L"Fonts"; break;
- case CSIDL_HISTORY: name = L"History"; break;
- case CSIDL_INTERNET_CACHE: name = L"Cache"; break;
- case CSIDL_LOCAL_APPDATA: name = L"Local AppData"; break;
- case CSIDL_MYMUSIC: name = L"My Music"; break;
- case CSIDL_MYPICTURES: name = L"My Pictures"; break;
- case CSIDL_MYVIDEO: name = L"My Video"; break;
- case CSIDL_NETHOOD: name = L"NetHood"; break;
- case CSIDL_PERSONAL: name = L"Personal"; break;
- case CSIDL_PRINTHOOD: name = L"PrintHood"; break;
- case CSIDL_PROGRAMS: name = L"Programs"; break;
- case CSIDL_RECENT: name = L"Recent"; break;
- case CSIDL_SENDTO: name = L"SendTo"; break;
- case CSIDL_STARTMENU: name = L"Start Menu"; break;
- case CSIDL_STARTUP: name = L"Startup"; break;
- case CSIDL_TEMPLATES: name = L"Templates"; break;
- /* XXX L"Local Settings" */
- }
-
- if (!name) {
- root = HKEY_LOCAL_MACHINE;
- switch (folder) {
- case CSIDL_COMMON_ADMINTOOLS: name = L"Common Administrative Tools"; break;
- case CSIDL_COMMON_APPDATA: name = L"Common AppData"; break;
- case CSIDL_COMMON_DESKTOPDIRECTORY: name = L"Common Desktop"; break;
- case CSIDL_COMMON_DOCUMENTS: name = L"Common Documents"; break;
- case CSIDL_COMMON_FAVORITES: name = L"Common Favorites"; break;
- case CSIDL_COMMON_PROGRAMS: name = L"Common Programs"; break;
- case CSIDL_COMMON_STARTMENU: name = L"Common Start Menu"; break;
- case CSIDL_COMMON_STARTUP: name = L"Common Startup"; break;
- case CSIDL_COMMON_TEMPLATES: name = L"Common Templates"; break;
- case CSIDL_COMMON_MUSIC: name = L"CommonMusic"; break;
- case CSIDL_COMMON_PICTURES: name = L"CommonPictures"; break;
- case CSIDL_COMMON_VIDEO: name = L"CommonVideo"; break;
- }
- }
- /* XXX todo
- * case CSIDL_SYSTEM # GetSystemDirectory()
- * case CSIDL_RESOURCES # %windir%\Resources\, For theme and other windows resources.
- * case CSIDL_RESOURCES_LOCALIZED # %windir%\Resources\<LangID>, for theme and other windows specific resources.
- */
-
-#define SHELL_FOLDERS "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"
-
- if (name && RegOpenKeyEx(root, SHELL_FOLDERS, 0, KEY_QUERY_VALUE, &hkey) == ERROR_SUCCESS) {
- WCHAR data[MAX_PATH+1];
- DWORD cb = sizeof(data)-sizeof(WCHAR);
- DWORD type = REG_NONE;
- long rc = RegQueryValueExW(hkey, name, NULL, &type, (BYTE*)&data, &cb);
- RegCloseKey(hkey);
- if (rc == ERROR_SUCCESS && type == REG_SZ && cb > sizeof(WCHAR) && data[0]) {
- /* Make sure the string is properly terminated */
- data[cb/sizeof(WCHAR)] = '\0';
- ST(0) = wstr_to_ansipath(aTHX_ data);
- XSRETURN(1);
- }
- }
-
-#undef SHELL_FOLDERS
-
- /* Unders some circumstances the registry entries seem to have a null string
- * as their value even when the directory already exists. The environment
- * variables do get set though, so try re-create a Unicode environment and
- * check if they are there.
- */
- sv = NULL;
- switch (folder) {
- case CSIDL_APPDATA: sv = get_unicode_env(aTHX_ L"APPDATA"); break;
- case CSIDL_PROFILE: sv = get_unicode_env(aTHX_ L"USERPROFILE"); break;
- case CSIDL_PROGRAM_FILES: sv = get_unicode_env(aTHX_ L"ProgramFiles"); break;
- case CSIDL_PROGRAM_FILES_COMMON: sv = get_unicode_env(aTHX_ L"CommonProgramFiles"); break;
- case CSIDL_WINDOWS: sv = get_unicode_env(aTHX_ L"SystemRoot"); break;
- }
- if (sv) {
- ST(0) = sv;
- XSRETURN(1);
- }
- }
-
- XSRETURN_UNDEF;
-}
-
-XS(w32_GetFileVersion)
-{
- dXSARGS;
- DWORD size;
- DWORD handle;
- char *filename;
- char *data;
-
- if (items != 1)
- croak("usage: Win32::GetFileVersion($filename)\n");
-
- filename = SvPV_nolen(ST(0));
- size = GetFileVersionInfoSize(filename, &handle);
- if (!size)
- XSRETURN_UNDEF;
-
- New(0, data, size, char);
- if (!data)
- XSRETURN_UNDEF;
-
- if (GetFileVersionInfo(filename, handle, size, data)) {
- VS_FIXEDFILEINFO *info;
- UINT len;
- if (VerQueryValue(data, "\\", (void**)&info, &len)) {
- int dwValueMS1 = (info->dwFileVersionMS>>16);
- int dwValueMS2 = (info->dwFileVersionMS&0xffff);
- int dwValueLS1 = (info->dwFileVersionLS>>16);
- int dwValueLS2 = (info->dwFileVersionLS&0xffff);
-
- if (GIMME_V == G_ARRAY) {
- EXTEND(SP, 4);
- XST_mIV(0, dwValueMS1);
- XST_mIV(1, dwValueMS2);
- XST_mIV(2, dwValueLS1);
- XST_mIV(3, dwValueLS2);
- items = 4;
- }
- else {
- char version[50];
- sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
- XST_mPV(0, version);
- }
- }
- }
- else
- items = 0;
-
- Safefree(data);
- XSRETURN(items);
-}
-
-#ifdef __CYGWIN__
-XS(w32_SetChildShowWindow)
-{
- /* This function doesn't do anything useful for cygwin. In the
- * MSWin32 case it modifies w32_showwindow, which is used by
- * win32_spawnvp(). Since w32_showwindow is an internal variable
- * inside the thread_intern structure, the MSWin32 implementation
- * lives in win32/win32.c in the core Perl distribution.
- */
- dXSARGS;
- XSRETURN_UNDEF;
-}
-#endif
-
-XS(w32_GetCwd)
-{
- dXSARGS;
- /* Make the host for current directory */
- char* ptr = PerlEnv_get_childdir();
- /*
- * If ptr != Nullch
- * then it worked, set PV valid,
- * else return 'undef'
- */
- if (ptr) {
- SV *sv = sv_newmortal();
- sv_setpv(sv, ptr);
- PerlEnv_free_childdir(ptr);
-
-#ifndef INCOMPLETE_TAINTS
- SvTAINTED_on(sv);
-#endif
-
- EXTEND(SP,1);
- ST(0) = sv;
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
-}
-
-XS(w32_SetCwd)
-{
- dXSARGS;
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)");
-
- if (IsWin2000() && SvUTF8(ST(0))) {
- WCHAR *wide = sv_to_wstr(aTHX_ ST(0));
- char *ansi = my_ansipath(wide);
- int rc = PerlDir_chdir(ansi);
- Safefree(wide);
- Safefree(ansi);
- if (!rc)
- XSRETURN_YES;
- }
- else {
- if (!PerlDir_chdir(SvPV_nolen(ST(0))))
- XSRETURN_YES;
- }
-
- XSRETURN_NO;
-}
-
-XS(w32_GetNextAvailDrive)
-{
- dXSARGS;
- char ix = 'C';
- char root[] = "_:\\";
-
- EXTEND(SP,1);
- while (ix <= 'Z') {
- root[0] = ix++;
- if (GetDriveType(root) == 1) {
- root[2] = '\0';
- XSRETURN_PV(root);
- }
- }
- XSRETURN_UNDEF;
-}
-
-XS(w32_GetLastError)
-{
- dXSARGS;
- EXTEND(SP,1);
- XSRETURN_IV(GetLastError());
-}
-
-XS(w32_SetLastError)
-{
- dXSARGS;
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
- SetLastError((DWORD)SvIV(ST(0)));
- XSRETURN_EMPTY;
-}
-
-XS(w32_LoginName)
-{
- dXSARGS;
- EXTEND(SP,1);
- if (IsWin2000()) {
- WCHAR name[128];
- DWORD size = countof(name);
- if (GetUserNameW(name, &size)) {
- ST(0) = wstr_to_sv(aTHX_ name);
- XSRETURN(1);
- }
- }
- else {
- char name[128];
- DWORD size = countof(name);
- if (GetUserNameA(name, &size)) {
- /* size includes NULL */
- ST(0) = sv_2mortal(newSVpvn(name, size-1));
- XSRETURN(1);
- }
- }
- XSRETURN_UNDEF;
-}
-
-XS(w32_NodeName)
-{
- dXSARGS;
- char name[MAX_COMPUTERNAME_LENGTH+1];
- DWORD size = sizeof(name);
- EXTEND(SP,1);
- if (GetComputerName(name,&size)) {
- /* size does NOT include NULL :-( */
- ST(0) = sv_2mortal(newSVpvn(name,size));
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
-}
-
-
-XS(w32_DomainName)
-{
- dXSARGS;
- HMODULE module = LoadLibrary("netapi32.dll");
- PFNNetApiBufferFree pfnNetApiBufferFree;
- PFNNetWkstaGetInfo pfnNetWkstaGetInfo;
-
- if (module) {
- GETPROC(NetApiBufferFree);
- GETPROC(NetWkstaGetInfo);
- }
- EXTEND(SP,1);
- if (module && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
- /* this way is more reliable, in case user has a local account. */
- char dname[256];
- DWORD dnamelen = sizeof(dname);
- struct {
- DWORD wki100_platform_id;
- LPWSTR wki100_computername;
- LPWSTR wki100_langroup;
- DWORD wki100_ver_major;
- DWORD wki100_ver_minor;
- } *pwi;
- DWORD retval;
- retval = pfnNetWkstaGetInfo(NULL, 100, &pwi);
- /* NERR_Success *is* 0*/
- if (retval == 0) {
- if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
- WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
- -1, (LPSTR)dname, dnamelen, NULL, NULL);
- }
- else {
- WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
- -1, (LPSTR)dname, dnamelen, NULL, NULL);
- }
- pfnNetApiBufferFree(pwi);
- FreeLibrary(module);
- XSRETURN_PV(dname);
- }
- FreeLibrary(module);
- SetLastError(retval);
- }
- else {
- /* Win95 doesn't have NetWksta*(), so do it the old way */
- char name[256];
- DWORD size = sizeof(name);
- if (module)
- FreeLibrary(module);
- if (GetUserName(name,&size)) {
- char sid[ONE_K_BUFSIZE];
- DWORD sidlen = sizeof(sid);
- char dname[256];
- DWORD dnamelen = sizeof(dname);
- SID_NAME_USE snu;
- if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
- dname, &dnamelen, &snu)) {
- XSRETURN_PV(dname); /* all that for this */
- }
- }
- }
- XSRETURN_UNDEF;
-}
-
-XS(w32_FsType)
-{
- dXSARGS;
- char fsname[256];
- DWORD flags, filecomplen;
- if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
- &flags, fsname, sizeof(fsname))) {
- if (GIMME_V == G_ARRAY) {
- XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
- XPUSHs(sv_2mortal(newSViv(flags)));
- XPUSHs(sv_2mortal(newSViv(filecomplen)));
- PUTBACK;
- return;
- }
- EXTEND(SP,1);
- XSRETURN_PV(fsname);
- }
- XSRETURN_EMPTY;
-}
-
-XS(w32_GetOSVersion)
-{
- dXSARGS;
-
- if (GIMME_V == G_SCALAR) {
- XSRETURN_IV(g_osver.dwPlatformId);
- }
- XPUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));
-
- XPUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));
- XPUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));
- XPUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));
- XPUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
- if (g_osver_ex) {
- XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));
- XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));
- XPUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));
- XPUSHs(sv_2mortal(newSViv(g_osver.wProductType)));
- }
- PUTBACK;
-}
-
-XS(w32_IsWinNT)
-{
- dXSARGS;
- EXTEND(SP,1);
- XSRETURN_IV(IsWinNT());
-}
-
-XS(w32_IsWin95)
-{
- dXSARGS;
- EXTEND(SP,1);
- XSRETURN_IV(IsWin95());
-}
-
-XS(w32_FormatMessage)
-{
- dXSARGS;
- DWORD source = 0;
- char msgbuf[ONE_K_BUFSIZE];
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
-
- if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
- &source, (DWORD)SvIV(ST(0)), 0,
- msgbuf, sizeof(msgbuf)-1, NULL))
- {
- XSRETURN_PV(msgbuf);
- }
-
- XSRETURN_UNDEF;
-}
-
-XS(w32_Spawn)
-{
- dXSARGS;
- char *cmd, *args;
- void *env;
- char *dir;
- PROCESS_INFORMATION stProcInfo;
- STARTUPINFO stStartInfo;
- BOOL bSuccess = FALSE;
-
- if (items != 3)
- Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
-
- cmd = SvPV_nolen(ST(0));
- args = SvPV_nolen(ST(1));
-
- env = PerlEnv_get_childenv();
- dir = PerlEnv_get_childdir();
-
- memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
- stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
- stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
- stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
-
- if (CreateProcess(
- cmd, /* Image path */
- args, /* Arguments for command line */
- NULL, /* Default process security */
- NULL, /* Default thread security */
- FALSE, /* Must be TRUE to use std handles */
- NORMAL_PRIORITY_CLASS, /* No special scheduling */
- env, /* Inherit our environment block */
- dir, /* Inherit our currrent directory */
- &stStartInfo, /* -> Startup info */
- &stProcInfo)) /* <- Process info (if OK) */
- {
- int pid = (int)stProcInfo.dwProcessId;
- if (IsWin95() && pid < 0)
- pid = -pid;
- sv_setiv(ST(2), pid);
- CloseHandle(stProcInfo.hThread);/* library source code does this. */
- bSuccess = TRUE;
- }
- PerlEnv_free_childenv(env);
- PerlEnv_free_childdir(dir);
- XSRETURN_IV(bSuccess);
-}
-
-XS(w32_GetTickCount)
-{
- dXSARGS;
- DWORD msec = GetTickCount();
- EXTEND(SP,1);
- if ((IV)msec > 0)
- XSRETURN_IV(msec);
- XSRETURN_NV(msec);
-}
-
-XS(w32_GetShortPathName)
-{
- dXSARGS;
- SV *shortpath;
- DWORD len;
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
-
- if (IsWin2000()) {
- WCHAR wshort[MAX_PATH+1];
- WCHAR *wlong = sv_to_wstr(aTHX_ ST(0));
- len = GetShortPathNameW(wlong, wshort, countof(wshort));
- Safefree(wlong);
- if (len && len < sizeof(wshort)) {
- ST(0) = wstr_to_sv(aTHX_ wshort);
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
- }
-
- shortpath = sv_mortalcopy(ST(0));
- SvUPGRADE(shortpath, SVt_PV);
- if (!SvPVX(shortpath) || !SvLEN(shortpath))
- XSRETURN_UNDEF;
-
- /* src == target is allowed */
- do {
- len = GetShortPathName(SvPVX(shortpath),
- SvPVX(shortpath),
- (DWORD)SvLEN(shortpath));
- } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
- if (len) {
- SvCUR_set(shortpath,len);
- *SvEND(shortpath) = '\0';
- ST(0) = shortpath;
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
-}
-
-XS(w32_GetFullPathName)
-{
- dXSARGS;
- char *fullname;
- char *ansi = NULL;
-
-/* The code below relies on the fact that PerlDir_mapX() returns an
- * absolute path, which is only true under PERL_IMPLICIT_SYS when
- * we use the virtualization code from win32/vdir.h.
- * Without it PerlDir_mapX() is a no-op and we need to use the same
- * code as we use for Cygwin.
- */
-#if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
- char buffer[2*MAX_PATH];
-#endif
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
-
-#if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
- if (IsWin2000()) {
- WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
- WCHAR full[2*MAX_PATH];
- DWORD len = GetFullPathNameW(filename, countof(full), full, NULL);
- Safefree(filename);
- if (len == 0 || len >= countof(full))
- XSRETURN_EMPTY;
- ansi = fullname = my_ansipath(full);
- }
- else {
- DWORD len = GetFullPathNameA(SvPV_nolen(ST(0)), countof(buffer), buffer, NULL);
- if (len == 0 || len >= countof(buffer))
- XSRETURN_EMPTY;
- fullname = buffer;
- }
-#else
- /* Don't use my_ansipath() unless the $filename argument is in Unicode.
- * If the relative path doesn't exist, GetShortPathName() will fail and
- * my_ansipath() will use the long name with replacement characters.
- * In that case we will be better off using PerlDir_mapA(), which
- * already uses the ANSI name of the current directory.
- *
- * XXX The one missing case is where we could downgrade $filename
- * XXX from UTF8 into the current codepage.
- */
- if (IsWin2000() && SvUTF8(ST(0))) {
- WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
- WCHAR *mappedname = PerlDir_mapW(filename);
- Safefree(filename);
- ansi = fullname = my_ansipath(mappedname);
- }
- else {
- fullname = PerlDir_mapA(SvPV_nolen(ST(0)));
- }
-# if PERL_VERSION < 8
- {
- /* PerlDir_mapX() in Perl 5.6 used to return forward slashes */
- char *str = fullname;
- while (*str) {
- if (*str == '/')
- *str = '\\';
- ++str;
- }
- }
-# endif
-#endif
-
- /* GetFullPathName() on Windows NT drops trailing backslash */
- if (g_osver.dwMajorVersion == 4 && *fullname) {
- STRLEN len;
- char *pv = SvPV(ST(0), len);
- char *lastchar = fullname + strlen(fullname) - 1;
- /* If ST(0) ends with a slash, but fullname doesn't ... */
- if (len && (pv[len-1] == '/' || pv[len-1] == '\\') && *lastchar != '\\') {
- /* fullname is the MAX_PATH+1 sized buffer returned from PerlDir_mapA()
- * or the 2*MAX_PATH sized local buffer in the __CYGWIN__ case.
- */
- if (lastchar - fullname < MAX_PATH - 1)
- strcpy(lastchar+1, "\\");
- }
- }
-
- if (GIMME_V == G_ARRAY) {
- char *filepart = strrchr(fullname, '\\');
-
- EXTEND(SP,1);
- if (filepart) {
- XST_mPV(1, ++filepart);
- *filepart = '\0';
- }
- else {
- XST_mPVN(1, "", 0);
- }
- items = 2;
- }
- XST_mPV(0, fullname);
-
- if (ansi)
- Safefree(ansi);
- XSRETURN(items);
-}
-
-XS(w32_GetLongPathName)
-{
- dXSARGS;
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
-
- if (IsWin2000()) {
- WCHAR *wstr = sv_to_wstr(aTHX_ ST(0));
- WCHAR wide_path[MAX_PATH+1];
- WCHAR *long_path;
-
- if (wcslen(wstr) < countof(wide_path)) {
- wcscpy(wide_path, wstr);
- long_path = my_longpathW(wide_path);
- if (long_path) {
- Safefree(wstr);
- ST(0) = wstr_to_sv(aTHX_ long_path);
- XSRETURN(1);
- }
- }
- Safefree(wstr);
- }
- else {
- SV *path;
- char tmpbuf[MAX_PATH+1];
- char *pathstr;
- STRLEN len;
-
- path = ST(0);
- pathstr = SvPV(path,len);
- if (len < sizeof(tmpbuf)) {
- strcpy(tmpbuf, pathstr);
- pathstr = my_longpathA(tmpbuf);
- if (pathstr) {
- ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
- XSRETURN(1);
- }
- }
- }
- XSRETURN_EMPTY;
-}
-
-XS(w32_GetANSIPathName)
-{
- dXSARGS;
- WCHAR *wide_path;
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::GetANSIPathName($pathname)");
-
- wide_path = sv_to_wstr(aTHX_ ST(0));
- ST(0) = wstr_to_ansipath(aTHX_ wide_path);
- Safefree(wide_path);
- XSRETURN(1);
-}
-
-XS(w32_Sleep)
-{
- dXSARGS;
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
- Sleep((DWORD)SvIV(ST(0)));
- XSRETURN_YES;
-}
-
-XS(w32_CopyFile)
-{
- dXSARGS;
- BOOL bResult;
- char *pszSourceFile;
- char szSourceFile[MAX_PATH+1];
-
- if (items != 3)
- Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
-
- pszSourceFile = PerlDir_mapA(SvPV_nolen(ST(0)));
- if (strlen(pszSourceFile) < sizeof(szSourceFile)) {
- strcpy(szSourceFile, pszSourceFile);
- bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
- if (bResult)
- XSRETURN_YES;
- }
- XSRETURN_NO;
-}
-
-XS(w32_OutputDebugString)
-{
- dXSARGS;
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::OutputDebugString($string)");
-
- if (SvUTF8(ST(0))) {
- WCHAR *str = sv_to_wstr(aTHX_ ST(0));
- OutputDebugStringW(str);
- Safefree(str);
- }
- else
- OutputDebugStringA(SvPV_nolen(ST(0)));
-
- XSRETURN_EMPTY;
-}
-
-XS(w32_GetCurrentProcessId)
-{
- dXSARGS;
- EXTEND(SP,1);
- XSRETURN_IV(GetCurrentProcessId());
-}
-
-XS(w32_GetCurrentThreadId)
-{
- dXSARGS;
- EXTEND(SP,1);
- XSRETURN_IV(GetCurrentThreadId());
-}
-
-XS(w32_CreateDirectory)
-{
- dXSARGS;
- BOOL result;
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::CreateDirectory($dir)");
-
- if (IsWin2000() && SvUTF8(ST(0))) {
- WCHAR *dir = sv_to_wstr(aTHX_ ST(0));
- result = CreateDirectoryW(dir, NULL);
- Safefree(dir);
- }
- else {
- result = CreateDirectoryA(SvPV_nolen(ST(0)), NULL);
- }
-
- ST(0) = boolSV(result);
- XSRETURN(1);
-}
-
-XS(w32_CreateFile)
-{
- dXSARGS;
- HANDLE handle;
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::CreateFile($file)");
-
- if (IsWin2000() && SvUTF8(ST(0))) {
- WCHAR *file = sv_to_wstr(aTHX_ ST(0));
- handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_WRITE,
- NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
- Safefree(file);
- }
- else {
- handle = CreateFileA(SvPV_nolen(ST(0)), GENERIC_WRITE, FILE_SHARE_WRITE,
- NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
- }
-
- if (handle != INVALID_HANDLE_VALUE)
- CloseHandle(handle);
-
- ST(0) = boolSV(handle != INVALID_HANDLE_VALUE);
- XSRETURN(1);
-}
-
-XS(w32_GetSystemMetrics)
-{
- dXSARGS;
-
- if (items != 1)
- Perl_croak(aTHX_ "usage: Win32::GetSystemMetrics($index)");
-
- XSRETURN_IV(GetSystemMetrics((int)SvIV(ST(0))));
-}
-
-XS(w32_GetProductInfo)
-{
- dXSARGS;
- DWORD type;
- HMODULE module;
- PFNGetProductInfo pfnGetProductInfo;
-
- if (items != 4)
- Perl_croak(aTHX_ "usage: Win32::GetProductInfo($major,$minor,$spmajor,$spminor)");
-
- module = GetModuleHandle("kernel32.dll");
- GETPROC(GetProductInfo);
- if (pfnGetProductInfo &&
- pfnGetProductInfo((DWORD)SvIV(ST(0)), (DWORD)SvIV(ST(1)),
- (DWORD)SvIV(ST(2)), (DWORD)SvIV(ST(3)), &type))
- {
- XSRETURN_IV(type);
- }
-
- /* PRODUCT_UNDEFINED */
- XSRETURN_IV(0);
-}
-
-MODULE = Win32 PACKAGE = Win32
-
-PROTOTYPES: DISABLE
-
-BOOT:
-{
- char *file = __FILE__;
-
- if (g_osver.dwOSVersionInfoSize == 0) {
- g_osver.dwOSVersionInfoSize = sizeof(g_osver);
- if (!GetVersionExA((OSVERSIONINFOA*)&g_osver)) {
- g_osver_ex = FALSE;
- g_osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
- GetVersionExA((OSVERSIONINFOA*)&g_osver);
- }
- }
-
- 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);
- newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
-
- newXS("Win32::GetCwd", w32_GetCwd, file);
- newXS("Win32::SetCwd", w32_SetCwd, file);
- newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
- newXS("Win32::GetLastError", w32_GetLastError, file);
- newXS("Win32::SetLastError", w32_SetLastError, file);
- newXS("Win32::LoginName", w32_LoginName, file);
- newXS("Win32::NodeName", w32_NodeName, file);
- newXS("Win32::DomainName", w32_DomainName, file);
- newXS("Win32::FsType", w32_FsType, file);
- newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
- newXS("Win32::IsWinNT", w32_IsWinNT, file);
- newXS("Win32::IsWin95", w32_IsWin95, file);
- newXS("Win32::FormatMessage", w32_FormatMessage, file);
- newXS("Win32::Spawn", w32_Spawn, file);
- newXS("Win32::GetTickCount", w32_GetTickCount, file);
- newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
- newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
- newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
- newXS("Win32::GetANSIPathName", w32_GetANSIPathName, file);
- newXS("Win32::CopyFile", w32_CopyFile, file);
- newXS("Win32::Sleep", w32_Sleep, file);
- newXS("Win32::OutputDebugString", w32_OutputDebugString, file);
- newXS("Win32::GetCurrentProcessId", w32_GetCurrentProcessId, file);
- newXS("Win32::GetCurrentThreadId", w32_GetCurrentThreadId, file);
- newXS("Win32::CreateDirectory", w32_CreateDirectory, file);
- newXS("Win32::CreateFile", w32_CreateFile, file);
- newXS("Win32::GetSystemMetrics", w32_GetSystemMetrics, file);
- newXS("Win32::GetProductInfo", w32_GetProductInfo, file);
-#ifdef __CYGWIN__
- newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
-#endif
- XSRETURN_YES;
-}
+#include <wctype.h>
+#include <windows.h>
+#include <shlobj.h>
+
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifndef countof
+# define countof(array) (sizeof (array) / sizeof (*(array)))
+#endif
+
+#define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege"
+
+#ifndef WC_NO_BEST_FIT_CHARS
+# define WC_NO_BEST_FIT_CHARS 0x00000400
+#endif
+
+#define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn)
+
+typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathA)(HWND, char*, int, BOOL);
+typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathW)(HWND, WCHAR*, int, BOOL);
+typedef HRESULT (WINAPI *PFNSHGetFolderPathA)(HWND, int, HANDLE, DWORD, LPTSTR);
+typedef HRESULT (WINAPI *PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR);
+typedef BOOL (WINAPI *PFNCreateEnvironmentBlock)(void**, HANDLE, BOOL);
+typedef BOOL (WINAPI *PFNDestroyEnvironmentBlock)(void*);
+typedef int (__stdcall *PFNDllRegisterServer)(void);
+typedef int (__stdcall *PFNDllUnregisterServer)(void);
+typedef DWORD (__stdcall *PFNNetApiBufferFree)(void*);
+typedef DWORD (__stdcall *PFNNetWkstaGetInfo)(LPWSTR, DWORD, void*);
+
+typedef BOOL (__stdcall *PFNOpenProcessToken)(HANDLE, DWORD, HANDLE*);
+typedef BOOL (__stdcall *PFNOpenThreadToken)(HANDLE, DWORD, BOOL, HANDLE*);
+typedef BOOL (__stdcall *PFNGetTokenInformation)(HANDLE, TOKEN_INFORMATION_CLASS, void*, DWORD, DWORD*);
+typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD,
+ DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*);
+typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);
+typedef void* (__stdcall *PFNFreeSid)(PSID);
+typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);
+typedef BOOL (WINAPI *PFNGetProductInfo)(DWORD, DWORD, DWORD, DWORD, DWORD*);
+typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);
+
+#ifndef CSIDL_MYMUSIC
+# define CSIDL_MYMUSIC 0x000D
+#endif
+#ifndef CSIDL_MYVIDEO
+# define CSIDL_MYVIDEO 0x000E
+#endif
+#ifndef CSIDL_LOCAL_APPDATA
+# define CSIDL_LOCAL_APPDATA 0x001C
+#endif
+#ifndef CSIDL_COMMON_FAVORITES
+# define CSIDL_COMMON_FAVORITES 0x001F
+#endif
+#ifndef CSIDL_INTERNET_CACHE
+# define CSIDL_INTERNET_CACHE 0x0020
+#endif
+#ifndef CSIDL_COOKIES
+# define CSIDL_COOKIES 0x0021
+#endif
+#ifndef CSIDL_HISTORY
+# define CSIDL_HISTORY 0x0022
+#endif
+#ifndef CSIDL_COMMON_APPDATA
+# define CSIDL_COMMON_APPDATA 0x0023
+#endif
+#ifndef CSIDL_WINDOWS
+# define CSIDL_WINDOWS 0x0024
+#endif
+#ifndef CSIDL_PROGRAM_FILES
+# define CSIDL_PROGRAM_FILES 0x0026
+#endif
+#ifndef CSIDL_MYPICTURES
+# define CSIDL_MYPICTURES 0x0027
+#endif
+#ifndef CSIDL_PROFILE
+# define CSIDL_PROFILE 0x0028
+#endif
+#ifndef CSIDL_PROGRAM_FILES_COMMON
+# define CSIDL_PROGRAM_FILES_COMMON 0x002B
+#endif
+#ifndef CSIDL_COMMON_TEMPLATES
+# define CSIDL_COMMON_TEMPLATES 0x002D
+#endif
+#ifndef CSIDL_COMMON_DOCUMENTS
+# define CSIDL_COMMON_DOCUMENTS 0x002E
+#endif
+#ifndef CSIDL_COMMON_ADMINTOOLS
+# define CSIDL_COMMON_ADMINTOOLS 0x002F
+#endif
+#ifndef CSIDL_ADMINTOOLS
+# define CSIDL_ADMINTOOLS 0x0030
+#endif
+#ifndef CSIDL_COMMON_MUSIC
+# define CSIDL_COMMON_MUSIC 0x0035
+#endif
+#ifndef CSIDL_COMMON_PICTURES
+# define CSIDL_COMMON_PICTURES 0x0036
+#endif
+#ifndef CSIDL_COMMON_VIDEO
+# define CSIDL_COMMON_VIDEO 0x0037
+#endif
+#ifndef CSIDL_CDBURN_AREA
+# define CSIDL_CDBURN_AREA 0x003B
+#endif
+#ifndef CSIDL_FLAG_CREATE
+# define CSIDL_FLAG_CREATE 0x8000
+#endif
+
+/* Use explicit struct definition because wSuiteMask and
+ * wProductType are not defined in the VC++ 6.0 headers.
+ * WORD type has been replaced by unsigned short because
+ * WORD is already used by Perl itself.
+ */
+struct {
+ DWORD dwOSVersionInfoSize;
+ DWORD dwMajorVersion;
+ DWORD dwMinorVersion;
+ DWORD dwBuildNumber;
+ DWORD dwPlatformId;
+ CHAR szCSDVersion[128];
+ unsigned short wServicePackMajor;
+ unsigned short wServicePackMinor;
+ unsigned short wSuiteMask;
+ BYTE wProductType;
+ BYTE wReserved;
+} g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0};
+BOOL g_osver_ex = TRUE;
+
+#define ONE_K_BUFSIZE 1024
+
+int
+IsWin95(void)
+{
+ return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
+}
+
+int
+IsWinNT(void)
+{
+ return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
+}
+
+int
+IsWin2000(void)
+{
+ return (g_osver.dwMajorVersion > 4);
+}
+
+/* Convert SV to wide character string. The return value must be
+ * freed using Safefree().
+ */
+WCHAR*
+sv_to_wstr(pTHX_ SV *sv)
+{
+ DWORD wlen;
+ WCHAR *wstr;
+ STRLEN len;
+ char *str = SvPV(sv, len);
+ UINT cp = SvUTF8(sv) ? CP_UTF8 : CP_ACP;
+
+ wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0);
+ New(0, wstr, wlen, WCHAR);
+ MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen);
+
+ return wstr;
+}
+
+/* Convert wide character string to mortal SV. Use UTF8 encoding
+ * if the string cannot be represented in the system codepage.
+ */
+SV *
+wstr_to_sv(pTHX_ WCHAR *wstr)
+{
+ int wlen = (int)wcslen(wstr)+1;
+ BOOL use_default = FALSE;
+ int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, NULL, 0, NULL, NULL);
+ SV *sv = sv_2mortal(newSV(len));
+
+ len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, SvPVX(sv), len, NULL, &use_default);
+ if (use_default) {
+ len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, NULL, 0, NULL, NULL);
+ sv_grow(sv, len);
+ len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, SvPVX(sv), len, NULL, NULL);
+ SvUTF8_on(sv);
+ }
+ /* Shouldn't really ever fail since we ask for the required length first, but who knows... */
+ if (len) {
+ SvPOK_on(sv);
+ SvCUR_set(sv, len-1);
+ }
+ return sv;
+}
+
+/* Retrieve a variable from the Unicode environment in a mortal SV.
+ *
+ * Recreates the Unicode environment because a bug in earlier Perl versions
+ * overwrites it with the ANSI version, which contains replacement
+ * characters for the characters not in the ANSI codepage.
+ */
+SV*
+get_unicode_env(pTHX_ WCHAR *name)
+{
+ SV *sv = NULL;
+ void *env;
+ HANDLE token;
+ HMODULE module;
+ PFNOpenProcessToken pfnOpenProcessToken;
+
+ /* Get security token for the current process owner */
+ module = LoadLibrary("advapi32.dll");
+ if (!module)
+ return NULL;
+
+ GETPROC(OpenProcessToken);
+
+ if (pfnOpenProcessToken == NULL ||
+ !pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY | TOKEN_DUPLICATE, &token))
+ {
+ FreeLibrary(module);
+ return NULL;
+ }
+ FreeLibrary(module);
+
+ /* Create a Unicode environment block for this process */
+ module = LoadLibrary("userenv.dll");
+ if (module) {
+ PFNCreateEnvironmentBlock pfnCreateEnvironmentBlock;
+ PFNDestroyEnvironmentBlock pfnDestroyEnvironmentBlock;
+
+ GETPROC(CreateEnvironmentBlock);
+ GETPROC(DestroyEnvironmentBlock);
+
+ if (pfnCreateEnvironmentBlock && pfnDestroyEnvironmentBlock &&
+ pfnCreateEnvironmentBlock(&env, token, FALSE))
+ {
+ size_t name_len = wcslen(name);
+ WCHAR *entry = env;
+ while (*entry) {
+ size_t i;
+ size_t entry_len = wcslen(entry);
+ BOOL equal = (entry_len > name_len) && (entry[name_len] == '=');
+
+ for (i=0; equal && i < name_len; ++i)
+ equal = (towupper(entry[i]) == towupper(name[i]));
+
+ if (equal) {
+ sv = wstr_to_sv(aTHX_ entry+name_len+1);
+ break;
+ }
+ entry += entry_len+1;
+ }
+ pfnDestroyEnvironmentBlock(env);
+ }
+ FreeLibrary(module);
+ }
+ CloseHandle(token);
+ return sv;
+}
+
+/* Define both an ANSI and a Wide version of win32_longpath */
+
+#define CHAR_T char
+#define WIN32_FIND_DATA_T WIN32_FIND_DATAA
+#define FN_FINDFIRSTFILE FindFirstFileA
+#define FN_STRLEN strlen
+#define FN_STRCPY strcpy
+#define LONGPATH my_longpathA
+#include "longpath.inc"
+
+#define CHAR_T WCHAR
+#define WIN32_FIND_DATA_T WIN32_FIND_DATAW
+#define FN_FINDFIRSTFILE FindFirstFileW
+#define FN_STRLEN wcslen
+#define FN_STRCPY wcscpy
+#define LONGPATH my_longpathW
+#include "longpath.inc"
+
+/* The my_ansipath() function takes a Unicode filename and converts it
+ * into the current Windows codepage. If some characters cannot be mapped,
+ * then it will convert the short name instead.
+ *
+ * The buffer to the ansi pathname must be freed with Safefree() when it
+ * it no longer needed.
+ *
+ * The argument to my_ansipath() must exist before this function is
+ * called; otherwise there is no way to determine the short path name.
+ *
+ * Ideas for future refinement:
+ * - Only convert those segments of the path that are not in the current
+ * codepage, but leave the other segments in their long form.
+ * - If the resulting name is longer than MAX_PATH, start converting
+ * additional path segments into short names until the full name
+ * is shorter than MAX_PATH. Shorten the filename part last!
+ */
+
+/* This is a modified version of core Perl win32/win32.c(win32_ansipath).
+ * It uses New() etc. instead of win32_malloc().
+ */
+
+char *
+my_ansipath(const WCHAR *widename)
+{
+ char *name;
+ BOOL use_default = FALSE;
+ int widelen = (int)wcslen(widename)+1;
+ int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
+ NULL, 0, NULL, NULL);
+ New(0, name, len, char);
+ WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
+ name, len, NULL, &use_default);
+ if (use_default) {
+ DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
+ if (shortlen) {
+ WCHAR *shortname;
+ New(0, shortname, shortlen, WCHAR);
+ shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
+
+ len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
+ NULL, 0, NULL, NULL);
+ Renew(name, len, char);
+ WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
+ name, len, NULL, NULL);
+ Safefree(shortname);
+ }
+ }
+ return name;
+}
+
+/* Convert wide character path to ANSI path and return as mortal SV. */
+SV*
+wstr_to_ansipath(pTHX_ WCHAR *wstr)
+{
+ char *ansi = my_ansipath(wstr);
+ SV *sv = sv_2mortal(newSVpvn(ansi, strlen(ansi)));
+ Safefree(ansi);
+ return sv;
+}
+
+#ifdef __CYGWIN__
+
+char*
+get_childdir(void)
+{
+ dTHX;
+ char* ptr;
+
+ if (IsWin2000()) {
+ WCHAR filename[MAX_PATH+1];
+ GetCurrentDirectoryW(MAX_PATH+1, filename);
+ ptr = my_ansipath(filename);
+ }
+ else {
+ char filename[MAX_PATH+1];
+ GetCurrentDirectoryA(MAX_PATH+1, filename);
+ New(0, ptr, strlen(filename)+1, char);
+ strcpy(ptr, filename);
+ }
+ return ptr;
+}
+
+void
+free_childdir(char *d)
+{
+ dTHX;
+ Safefree(d);
+}
+
+void*
+get_childenv(void)
+{
+ return NULL;
+}
+
+void
+free_childenv(void *d)
+{
+}
+
+# define PerlDir_mapA(dir) (dir)
+
+#endif
+
+XS(w32_ExpandEnvironmentStrings)
+{
+ dXSARGS;
+
+ if (items != 1)
+ croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
+
+ if (IsWin2000()) {
+ WCHAR value[31*1024];
+ WCHAR *source = sv_to_wstr(aTHX_ ST(0));
+ ExpandEnvironmentStringsW(source, value, countof(value)-1);
+ ST(0) = wstr_to_sv(aTHX_ value);
+ Safefree(source);
+ XSRETURN(1);
+ }
+ else {
+ char value[31*1024];
+ ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), value, countof(value)-2);
+ XSRETURN_PV(value);
+ }
+}
+
+XS(w32_IsAdminUser)
+{
+ dXSARGS;
+ HMODULE module;
+ PFNIsUserAnAdmin pfnIsUserAnAdmin;
+ PFNOpenThreadToken pfnOpenThreadToken;
+ PFNOpenProcessToken pfnOpenProcessToken;
+ PFNGetTokenInformation pfnGetTokenInformation;
+ PFNAllocateAndInitializeSid pfnAllocateAndInitializeSid;
+ PFNEqualSid pfnEqualSid;
+ PFNFreeSid pfnFreeSid;
+ HANDLE hTok;
+ DWORD dwTokInfoLen;
+ TOKEN_GROUPS *lpTokInfo;
+ SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY;
+ PSID pAdminSid;
+ int iRetVal;
+ unsigned int i;
+
+ if (items)
+ croak("usage: Win32::IsAdminUser()");
+
+ /* There is no concept of "Administrator" user accounts on Win9x systems,
+ so just return true. */
+ if (IsWin95())
+ XSRETURN_YES;
+
+ /* Use IsUserAnAdmin() when available. On Vista this will only return TRUE
+ * if the process is running with elevated privileges and not just when the
+ * process owner is a member of the "Administrators" group.
+ */
+ module = LoadLibrary("shell32.dll");
+ if (module) {
+ GETPROC(IsUserAnAdmin);
+ if (pfnIsUserAnAdmin) {
+ EXTEND(SP, 1);
+ ST(0) = sv_2mortal(newSViv(pfnIsUserAnAdmin() ? 1 : 0));
+ FreeLibrary(module);
+ XSRETURN(1);
+ }
+ FreeLibrary(module);
+ }
+
+ module = LoadLibrary("advapi32.dll");
+ if (!module) {
+ warn("Cannot load advapi32.dll library");
+ XSRETURN_UNDEF;
+ }
+
+ GETPROC(OpenThreadToken);
+ GETPROC(OpenProcessToken);
+ GETPROC(GetTokenInformation);
+ GETPROC(AllocateAndInitializeSid);
+ GETPROC(EqualSid);
+ GETPROC(FreeSid);
+
+ if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
+ pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
+ pfnEqualSid && pfnFreeSid))
+ {
+ warn("Cannot load functions from advapi32.dll library");
+ FreeLibrary(module);
+ XSRETURN_UNDEF;
+ }
+
+ if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
+ if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
+ warn("Cannot open thread token or process token");
+ FreeLibrary(module);
+ XSRETURN_UNDEF;
+ }
+ }
+
+ pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
+ if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
+ warn("Cannot allocate token information structure");
+ CloseHandle(hTok);
+ FreeLibrary(module);
+ XSRETURN_UNDEF;
+ }
+
+ if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
+ &dwTokInfoLen))
+ {
+ warn("Cannot get token information");
+ Safefree(lpTokInfo);
+ CloseHandle(hTok);
+ FreeLibrary(module);
+ 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(module);
+ 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(module);
+
+ 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;
+ BOOL bResult;
+
+ if (items != 5)
+ croak("usage: Win32::LookupAccountName($system, $account, $domain, "
+ "$sid, $sidtype);\n");
+
+ SIDLen = sizeof(SID);
+ DomLen = sizeof(Domain);
+
+ bResult = LookupAccountNameA(SvPV_nolen(ST(0)), /* System */
+ SvPV_nolen(ST(1)), /* 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;
+ }
+ XSRETURN_NO;
+}
+
+
+XS(w32_LookupAccountSID)
+{
+ dXSARGS;
+ PSID sid;
+ char Account[256];
+ DWORD AcctLen = sizeof(Account);
+ char Domain[256];
+ DWORD DomLen = sizeof(Domain);
+ SID_NAME_USE snu;
+ BOOL bResult;
+
+ if (items != 5)
+ croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
+
+ sid = SvPV_nolen(ST(1));
+ if (IsValidSid(sid)) {
+ bResult = LookupAccountSidA(SvPV_nolen(ST(0)), /* 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;
+ }
+ }
+ XSRETURN_NO;
+}
+
+XS(w32_InitiateSystemShutdown)
+{
+ dXSARGS;
+ HANDLE hToken; /* handle to process token */
+ TOKEN_PRIVILEGES tkp; /* pointer to token structure */
+ BOOL bRet;
+ char *machineName, *message;
+
+ if (items != 5)
+ croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
+ "$timeOut, $forceClose, $reboot);\n");
+
+ machineName = SvPV_nolen(ST(0));
+
+ if (OpenProcessToken(GetCurrentProcess(),
+ TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
+ &hToken))
+ {
+ 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_nolen(ST(1));
+ bRet = InitiateSystemShutdownA(machineName, message, (DWORD)SvIV(ST(2)),
+ (BOOL)SvIV(ST(3)), (BOOL)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;
+
+ if (items != 1)
+ croak("usage: Win32::AbortSystemShutdown($machineName);\n");
+
+ machineName = SvPV_nolen(ST(0));
+
+ if (OpenProcessToken(GetCurrentProcess(),
+ TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
+ &hToken))
+ {
+ 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);
+ }
+
+ 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;
+ DWORD flags = MB_ICONEXCLAMATION;
+ I32 result;
+
+ if (items < 1 || items > 3)
+ croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
+
+ if (items > 1)
+ flags = (DWORD)SvIV(ST(1));
+
+ if (IsWin2000()) {
+ WCHAR *title = NULL;
+ WCHAR *msg = sv_to_wstr(aTHX_ ST(0));
+ if (items > 2)
+ title = sv_to_wstr(aTHX_ ST(2));
+ result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags);
+ Safefree(msg);
+ if (title)
+ Safefree(title);
+ }
+ else {
+ char *title = "Perl";
+ char *msg = SvPV_nolen(ST(0));
+ if (items > 2)
+ title = SvPV_nolen(ST(2));
+ result = MessageBoxA(GetActiveWindow(), msg, title, flags);
+ }
+ XSRETURN_IV(result);
+}
+
+XS(w32_LoadLibrary)
+{
+ dXSARGS;
+ HANDLE hHandle;
+
+ if (items != 1)
+ croak("usage: Win32::LoadLibrary($libname)\n");
+ hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
+#ifdef _WIN64
+ XSRETURN_IV((DWORD_PTR)hHandle);
+#else
+ XSRETURN_IV((DWORD)hHandle);
+#endif
+}
+
+XS(w32_FreeLibrary)
+{
+ dXSARGS;
+
+ if (items != 1)
+ croak("usage: Win32::FreeLibrary($handle)\n");
+ if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+XS(w32_GetProcAddress)
+{
+ dXSARGS;
+
+ if (items != 2)
+ croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
+ XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
+}
+
+XS(w32_RegisterServer)
+{
+ dXSARGS;
+ BOOL result = FALSE;
+ HMODULE module;
+
+ if (items != 1)
+ croak("usage: Win32::RegisterServer($libname)\n");
+
+ module = LoadLibraryA(SvPV_nolen(ST(0)));
+ if (module) {
+ PFNDllRegisterServer pfnDllRegisterServer;
+ GETPROC(DllRegisterServer);
+ if (pfnDllRegisterServer && pfnDllRegisterServer() == 0)
+ result = TRUE;
+ FreeLibrary(module);
+ }
+ ST(0) = boolSV(result);
+ XSRETURN(1);
+}
+
+XS(w32_UnregisterServer)
+{
+ dXSARGS;
+ BOOL result = FALSE;
+ HINSTANCE module;
+
+ if (items != 1)
+ croak("usage: Win32::UnregisterServer($libname)\n");
+
+ module = LoadLibraryA(SvPV_nolen(ST(0)));
+ if (module) {
+ PFNDllUnregisterServer pfnDllUnregisterServer;
+ GETPROC(DllUnregisterServer);
+ if (pfnDllUnregisterServer && pfnDllUnregisterServer() == 0)
+ result = TRUE;
+ FreeLibrary(module);
+ }
+ ST(0) = boolSV(result);
+ XSRETURN(1);
+}
+
+/* XXX rather bogus */
+XS(w32_GetArchName)
+{
+ dXSARGS;
+ XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
+}
+
+XS(w32_GetChipName)
+{
+ dXSARGS;
+ SYSTEM_INFO sysinfo;
+ HMODULE module;
+ PFNGetNativeSystemInfo pfnGetNativeSystemInfo;
+
+ Zero(&sysinfo,1,SYSTEM_INFO);
+ module = GetModuleHandle("kernel32.dll");
+ GETPROC(GetNativeSystemInfo);
+ if (pfnGetNativeSystemInfo)
+ pfnGetNativeSystemInfo(&sysinfo);
+ else
+ 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;
+ if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
+ WideCharToMultiByte(CP_ACP, 0, pStr, (int)wcslen(pStr), szGUID,
+ sizeof(szGUID), NULL, NULL);
+ CoTaskMemFree(pStr);
+ XSRETURN_PV(szGUID);
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(w32_GetFolderPath)
+{
+ dXSARGS;
+ char path[MAX_PATH+1];
+ WCHAR wpath[MAX_PATH+1];
+ int folder;
+ int create = 0;
+ HMODULE module;
+
+ if (items != 1 && items != 2)
+ croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
+
+ folder = (int)SvIV(ST(0));
+ if (items == 2)
+ create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
+
+ module = LoadLibrary("shfolder.dll");
+ if (module) {
+ PFNSHGetFolderPathA pfna;
+ if (IsWin2000()) {
+ PFNSHGetFolderPathW pfnw;
+ pfnw = (PFNSHGetFolderPathW)GetProcAddress(module, "SHGetFolderPathW");
+ if (pfnw && SUCCEEDED(pfnw(NULL, folder|create, NULL, 0, wpath))) {
+ FreeLibrary(module);
+ ST(0) = wstr_to_ansipath(aTHX_ wpath);
+ XSRETURN(1);
+ }
+ }
+ pfna = (PFNSHGetFolderPathA)GetProcAddress(module, "SHGetFolderPathA");
+ if (pfna && SUCCEEDED(pfna(NULL, folder|create, NULL, 0, path))) {
+ FreeLibrary(module);
+ XSRETURN_PV(path);
+ }
+ FreeLibrary(module);
+ }
+
+ module = LoadLibrary("shell32.dll");
+ if (module) {
+ PFNSHGetSpecialFolderPathA pfna;
+ if (IsWin2000()) {
+ PFNSHGetSpecialFolderPathW pfnw;
+ pfnw = (PFNSHGetSpecialFolderPathW)GetProcAddress(module, "SHGetSpecialFolderPathW");
+ if (pfnw && pfnw(NULL, wpath, folder, !!create)) {
+ FreeLibrary(module);
+ ST(0) = wstr_to_ansipath(aTHX_ wpath);
+ XSRETURN(1);
+ }
+ }
+ pfna = (PFNSHGetSpecialFolderPathA)GetProcAddress(module, "SHGetSpecialFolderPathA");
+ if (pfna && pfna(NULL, path, folder, !!create)) {
+ FreeLibrary(module);
+ XSRETURN_PV(path);
+ }
+ FreeLibrary(module);
+ }
+
+ /* SHGetFolderPathW() and SHGetSpecialFolderPathW() may fail on older
+ * Perl versions that have replaced the Unicode environment with an
+ * ANSI version. Let's go spelunking in the registry now...
+ */
+ if (IsWin2000()) {
+ SV *sv;
+ HKEY hkey;
+ HKEY root = HKEY_CURRENT_USER;
+ WCHAR *name = NULL;
+
+ switch (folder) {
+ case CSIDL_ADMINTOOLS: name = L"Administrative Tools"; break;
+ case CSIDL_APPDATA: name = L"AppData"; break;
+ case CSIDL_CDBURN_AREA: name = L"CD Burning"; break;
+ case CSIDL_COOKIES: name = L"Cookies"; break;
+ case CSIDL_DESKTOP:
+ case CSIDL_DESKTOPDIRECTORY: name = L"Desktop"; break;
+ case CSIDL_FAVORITES: name = L"Favorites"; break;
+ case CSIDL_FONTS: name = L"Fonts"; break;
+ case CSIDL_HISTORY: name = L"History"; break;
+ case CSIDL_INTERNET_CACHE: name = L"Cache"; break;
+ case CSIDL_LOCAL_APPDATA: name = L"Local AppData"; break;
+ case CSIDL_MYMUSIC: name = L"My Music"; break;
+ case CSIDL_MYPICTURES: name = L"My Pictures"; break;
+ case CSIDL_MYVIDEO: name = L"My Video"; break;
+ case CSIDL_NETHOOD: name = L"NetHood"; break;
+ case CSIDL_PERSONAL: name = L"Personal"; break;
+ case CSIDL_PRINTHOOD: name = L"PrintHood"; break;
+ case CSIDL_PROGRAMS: name = L"Programs"; break;
+ case CSIDL_RECENT: name = L"Recent"; break;
+ case CSIDL_SENDTO: name = L"SendTo"; break;
+ case CSIDL_STARTMENU: name = L"Start Menu"; break;
+ case CSIDL_STARTUP: name = L"Startup"; break;
+ case CSIDL_TEMPLATES: name = L"Templates"; break;
+ /* XXX L"Local Settings" */
+ }
+
+ if (!name) {
+ root = HKEY_LOCAL_MACHINE;
+ switch (folder) {
+ case CSIDL_COMMON_ADMINTOOLS: name = L"Common Administrative Tools"; break;
+ case CSIDL_COMMON_APPDATA: name = L"Common AppData"; break;
+ case CSIDL_COMMON_DESKTOPDIRECTORY: name = L"Common Desktop"; break;
+ case CSIDL_COMMON_DOCUMENTS: name = L"Common Documents"; break;
+ case CSIDL_COMMON_FAVORITES: name = L"Common Favorites"; break;
+ case CSIDL_COMMON_PROGRAMS: name = L"Common Programs"; break;
+ case CSIDL_COMMON_STARTMENU: name = L"Common Start Menu"; break;
+ case CSIDL_COMMON_STARTUP: name = L"Common Startup"; break;
+ case CSIDL_COMMON_TEMPLATES: name = L"Common Templates"; break;
+ case CSIDL_COMMON_MUSIC: name = L"CommonMusic"; break;
+ case CSIDL_COMMON_PICTURES: name = L"CommonPictures"; break;
+ case CSIDL_COMMON_VIDEO: name = L"CommonVideo"; break;
+ }
+ }
+ /* XXX todo
+ * case CSIDL_SYSTEM # GetSystemDirectory()
+ * case CSIDL_RESOURCES # %windir%\Resources\, For theme and other windows resources.
+ * case CSIDL_RESOURCES_LOCALIZED # %windir%\Resources\<LangID>, for theme and other windows specific resources.
+ */
+
+#define SHELL_FOLDERS "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"
+
+ if (name && RegOpenKeyEx(root, SHELL_FOLDERS, 0, KEY_QUERY_VALUE, &hkey) == ERROR_SUCCESS) {
+ WCHAR data[MAX_PATH+1];
+ DWORD cb = sizeof(data)-sizeof(WCHAR);
+ DWORD type = REG_NONE;
+ long rc = RegQueryValueExW(hkey, name, NULL, &type, (BYTE*)&data, &cb);
+ RegCloseKey(hkey);
+ if (rc == ERROR_SUCCESS && type == REG_SZ && cb > sizeof(WCHAR) && data[0]) {
+ /* Make sure the string is properly terminated */
+ data[cb/sizeof(WCHAR)] = '\0';
+ ST(0) = wstr_to_ansipath(aTHX_ data);
+ XSRETURN(1);
+ }
+ }
+
+#undef SHELL_FOLDERS
+
+ /* Unders some circumstances the registry entries seem to have a null string
+ * as their value even when the directory already exists. The environment
+ * variables do get set though, so try re-create a Unicode environment and
+ * check if they are there.
+ */
+ sv = NULL;
+ switch (folder) {
+ case CSIDL_APPDATA: sv = get_unicode_env(aTHX_ L"APPDATA"); break;
+ case CSIDL_PROFILE: sv = get_unicode_env(aTHX_ L"USERPROFILE"); break;
+ case CSIDL_PROGRAM_FILES: sv = get_unicode_env(aTHX_ L"ProgramFiles"); break;
+ case CSIDL_PROGRAM_FILES_COMMON: sv = get_unicode_env(aTHX_ L"CommonProgramFiles"); break;
+ case CSIDL_WINDOWS: sv = get_unicode_env(aTHX_ L"SystemRoot"); break;
+ }
+ if (sv) {
+ ST(0) = sv;
+ XSRETURN(1);
+ }
+ }
+
+ XSRETURN_UNDEF;
+}
+
+XS(w32_GetFileVersion)
+{
+ dXSARGS;
+ DWORD size;
+ DWORD handle;
+ char *filename;
+ char *data;
+
+ if (items != 1)
+ croak("usage: Win32::GetFileVersion($filename)\n");
+
+ filename = SvPV_nolen(ST(0));
+ size = GetFileVersionInfoSize(filename, &handle);
+ if (!size)
+ XSRETURN_UNDEF;
+
+ New(0, data, size, char);
+ if (!data)
+ XSRETURN_UNDEF;
+
+ if (GetFileVersionInfo(filename, handle, size, data)) {
+ VS_FIXEDFILEINFO *info;
+ UINT len;
+ if (VerQueryValue(data, "\\", (void**)&info, &len)) {
+ int dwValueMS1 = (info->dwFileVersionMS>>16);
+ int dwValueMS2 = (info->dwFileVersionMS&0xffff);
+ int dwValueLS1 = (info->dwFileVersionLS>>16);
+ int dwValueLS2 = (info->dwFileVersionLS&0xffff);
+
+ if (GIMME_V == G_ARRAY) {
+ EXTEND(SP, 4);
+ XST_mIV(0, dwValueMS1);
+ XST_mIV(1, dwValueMS2);
+ XST_mIV(2, dwValueLS1);
+ XST_mIV(3, dwValueLS2);
+ items = 4;
+ }
+ else {
+ char version[50];
+ sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
+ XST_mPV(0, version);
+ }
+ }
+ }
+ else
+ items = 0;
+
+ Safefree(data);
+ XSRETURN(items);
+}
+
+#ifdef __CYGWIN__
+XS(w32_SetChildShowWindow)
+{
+ /* This function doesn't do anything useful for cygwin. In the
+ * MSWin32 case it modifies w32_showwindow, which is used by
+ * win32_spawnvp(). Since w32_showwindow is an internal variable
+ * inside the thread_intern structure, the MSWin32 implementation
+ * lives in win32/win32.c in the core Perl distribution.
+ */
+ dXSARGS;
+ XSRETURN_UNDEF;
+}
+#endif
+
+XS(w32_GetCwd)
+{
+ dXSARGS;
+ /* Make the host for current directory */
+ char* ptr = PerlEnv_get_childdir();
+ /*
+ * If ptr != Nullch
+ * then it worked, set PV valid,
+ * else return 'undef'
+ */
+ if (ptr) {
+ SV *sv = sv_newmortal();
+ sv_setpv(sv, ptr);
+ PerlEnv_free_childdir(ptr);
+
+#ifndef INCOMPLETE_TAINTS
+ SvTAINTED_on(sv);
+#endif
+
+ EXTEND(SP,1);
+ ST(0) = sv;
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(w32_SetCwd)
+{
+ dXSARGS;
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)");
+
+ if (IsWin2000() && SvUTF8(ST(0))) {
+ WCHAR *wide = sv_to_wstr(aTHX_ ST(0));
+ char *ansi = my_ansipath(wide);
+ int rc = PerlDir_chdir(ansi);
+ Safefree(wide);
+ Safefree(ansi);
+ if (!rc)
+ XSRETURN_YES;
+ }
+ else {
+ if (!PerlDir_chdir(SvPV_nolen(ST(0))))
+ XSRETURN_YES;
+ }
+
+ XSRETURN_NO;
+}
+
+XS(w32_GetNextAvailDrive)
+{
+ dXSARGS;
+ char ix = 'C';
+ char root[] = "_:\\";
+
+ EXTEND(SP,1);
+ while (ix <= 'Z') {
+ root[0] = ix++;
+ if (GetDriveType(root) == 1) {
+ root[2] = '\0';
+ XSRETURN_PV(root);
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(w32_GetLastError)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetLastError());
+}
+
+XS(w32_SetLastError)
+{
+ dXSARGS;
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
+ SetLastError((DWORD)SvIV(ST(0)));
+ XSRETURN_EMPTY;
+}
+
+XS(w32_LoginName)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ if (IsWin2000()) {
+ WCHAR name[128];
+ DWORD size = countof(name);
+ if (GetUserNameW(name, &size)) {
+ ST(0) = wstr_to_sv(aTHX_ name);
+ XSRETURN(1);
+ }
+ }
+ else {
+ char name[128];
+ DWORD size = countof(name);
+ if (GetUserNameA(name, &size)) {
+ /* size includes NULL */
+ ST(0) = sv_2mortal(newSVpvn(name, size-1));
+ XSRETURN(1);
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(w32_NodeName)
+{
+ dXSARGS;
+ char name[MAX_COMPUTERNAME_LENGTH+1];
+ DWORD size = sizeof(name);
+ EXTEND(SP,1);
+ if (GetComputerName(name,&size)) {
+ /* size does NOT include NULL :-( */
+ ST(0) = sv_2mortal(newSVpvn(name,size));
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+}
+
+
+XS(w32_DomainName)
+{
+ dXSARGS;
+ HMODULE module = LoadLibrary("netapi32.dll");
+ PFNNetApiBufferFree pfnNetApiBufferFree;
+ PFNNetWkstaGetInfo pfnNetWkstaGetInfo;
+
+ if (module) {
+ GETPROC(NetApiBufferFree);
+ GETPROC(NetWkstaGetInfo);
+ }
+ EXTEND(SP,1);
+ if (module && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
+ /* this way is more reliable, in case user has a local account. */
+ char dname[256];
+ DWORD dnamelen = sizeof(dname);
+ struct {
+ DWORD wki100_platform_id;
+ LPWSTR wki100_computername;
+ LPWSTR wki100_langroup;
+ DWORD wki100_ver_major;
+ DWORD wki100_ver_minor;
+ } *pwi;
+ DWORD retval;
+ retval = pfnNetWkstaGetInfo(NULL, 100, &pwi);
+ /* NERR_Success *is* 0*/
+ if (retval == 0) {
+ if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
+ WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);
+ }
+ else {
+ WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);
+ }
+ pfnNetApiBufferFree(pwi);
+ FreeLibrary(module);
+ XSRETURN_PV(dname);
+ }
+ FreeLibrary(module);
+ SetLastError(retval);
+ }
+ else {
+ /* Win95 doesn't have NetWksta*(), so do it the old way */
+ char name[256];
+ DWORD size = sizeof(name);
+ if (module)
+ FreeLibrary(module);
+ if (GetUserName(name,&size)) {
+ char sid[ONE_K_BUFSIZE];
+ DWORD sidlen = sizeof(sid);
+ char dname[256];
+ DWORD dnamelen = sizeof(dname);
+ SID_NAME_USE snu;
+ if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
+ dname, &dnamelen, &snu)) {
+ XSRETURN_PV(dname); /* all that for this */
+ }
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(w32_FsType)
+{
+ dXSARGS;
+ char fsname[256];
+ DWORD flags, filecomplen;
+ if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
+ &flags, fsname, sizeof(fsname))) {
+ if (GIMME_V == G_ARRAY) {
+ XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
+ XPUSHs(sv_2mortal(newSViv(flags)));
+ XPUSHs(sv_2mortal(newSViv(filecomplen)));
+ PUTBACK;
+ return;
+ }
+ EXTEND(SP,1);
+ XSRETURN_PV(fsname);
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(w32_GetOSVersion)
+{
+ dXSARGS;
+
+ if (GIMME_V == G_SCALAR) {
+ XSRETURN_IV(g_osver.dwPlatformId);
+ }
+ XPUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));
+
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
+ if (g_osver_ex) {
+ XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));
+ XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));
+ XPUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));
+ XPUSHs(sv_2mortal(newSViv(g_osver.wProductType)));
+ }
+ PUTBACK;
+}
+
+XS(w32_IsWinNT)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(IsWinNT());
+}
+
+XS(w32_IsWin95)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(IsWin95());
+}
+
+XS(w32_FormatMessage)
+{
+ dXSARGS;
+ DWORD source = 0;
+ char msgbuf[ONE_K_BUFSIZE];
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
+
+ if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
+ &source, (DWORD)SvIV(ST(0)), 0,
+ msgbuf, sizeof(msgbuf)-1, NULL))
+ {
+ XSRETURN_PV(msgbuf);
+ }
+
+ XSRETURN_UNDEF;
+}
+
+XS(w32_Spawn)
+{
+ dXSARGS;
+ char *cmd, *args;
+ void *env;
+ char *dir;
+ PROCESS_INFORMATION stProcInfo;
+ STARTUPINFO stStartInfo;
+ BOOL bSuccess = FALSE;
+
+ if (items != 3)
+ Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
+
+ cmd = SvPV_nolen(ST(0));
+ args = SvPV_nolen(ST(1));
+
+ env = PerlEnv_get_childenv();
+ dir = PerlEnv_get_childdir();
+
+ memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
+ stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
+ stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
+ stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
+
+ if (CreateProcess(
+ cmd, /* Image path */
+ args, /* Arguments for command line */
+ NULL, /* Default process security */
+ NULL, /* Default thread security */
+ FALSE, /* Must be TRUE to use std handles */
+ NORMAL_PRIORITY_CLASS, /* No special scheduling */
+ env, /* Inherit our environment block */
+ dir, /* Inherit our currrent directory */
+ &stStartInfo, /* -> Startup info */
+ &stProcInfo)) /* <- Process info (if OK) */
+ {
+ int pid = (int)stProcInfo.dwProcessId;
+ if (IsWin95() && pid < 0)
+ pid = -pid;
+ sv_setiv(ST(2), pid);
+ CloseHandle(stProcInfo.hThread);/* library source code does this. */
+ bSuccess = TRUE;
+ }
+ PerlEnv_free_childenv(env);
+ PerlEnv_free_childdir(dir);
+ XSRETURN_IV(bSuccess);
+}
+
+XS(w32_GetTickCount)
+{
+ dXSARGS;
+ DWORD msec = GetTickCount();
+ EXTEND(SP,1);
+ if ((IV)msec > 0)
+ XSRETURN_IV(msec);
+ XSRETURN_NV(msec);
+}
+
+XS(w32_GetShortPathName)
+{
+ dXSARGS;
+ SV *shortpath;
+ DWORD len;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
+
+ if (IsWin2000()) {
+ WCHAR wshort[MAX_PATH+1];
+ WCHAR *wlong = sv_to_wstr(aTHX_ ST(0));
+ len = GetShortPathNameW(wlong, wshort, countof(wshort));
+ Safefree(wlong);
+ if (len && len < sizeof(wshort)) {
+ ST(0) = wstr_to_sv(aTHX_ wshort);
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+ }
+
+ shortpath = sv_mortalcopy(ST(0));
+ SvUPGRADE(shortpath, SVt_PV);
+ if (!SvPVX(shortpath) || !SvLEN(shortpath))
+ XSRETURN_UNDEF;
+
+ /* src == target is allowed */
+ do {
+ len = GetShortPathName(SvPVX(shortpath),
+ SvPVX(shortpath),
+ (DWORD)SvLEN(shortpath));
+ } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
+ if (len) {
+ SvCUR_set(shortpath,len);
+ *SvEND(shortpath) = '\0';
+ ST(0) = shortpath;
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(w32_GetFullPathName)
+{
+ dXSARGS;
+ char *fullname;
+ char *ansi = NULL;
+
+/* The code below relies on the fact that PerlDir_mapX() returns an
+ * absolute path, which is only true under PERL_IMPLICIT_SYS when
+ * we use the virtualization code from win32/vdir.h.
+ * Without it PerlDir_mapX() is a no-op and we need to use the same
+ * code as we use for Cygwin.
+ */
+#if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
+ char buffer[2*MAX_PATH];
+#endif
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
+
+#if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)
+ if (IsWin2000()) {
+ WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
+ WCHAR full[2*MAX_PATH];
+ DWORD len = GetFullPathNameW(filename, countof(full), full, NULL);
+ Safefree(filename);
+ if (len == 0 || len >= countof(full))
+ XSRETURN_EMPTY;
+ ansi = fullname = my_ansipath(full);
+ }
+ else {
+ DWORD len = GetFullPathNameA(SvPV_nolen(ST(0)), countof(buffer), buffer, NULL);
+ if (len == 0 || len >= countof(buffer))
+ XSRETURN_EMPTY;
+ fullname = buffer;
+ }
+#else
+ /* Don't use my_ansipath() unless the $filename argument is in Unicode.
+ * If the relative path doesn't exist, GetShortPathName() will fail and
+ * my_ansipath() will use the long name with replacement characters.
+ * In that case we will be better off using PerlDir_mapA(), which
+ * already uses the ANSI name of the current directory.
+ *
+ * XXX The one missing case is where we could downgrade $filename
+ * XXX from UTF8 into the current codepage.
+ */
+ if (IsWin2000() && SvUTF8(ST(0))) {
+ WCHAR *filename = sv_to_wstr(aTHX_ ST(0));
+ WCHAR *mappedname = PerlDir_mapW(filename);
+ Safefree(filename);
+ ansi = fullname = my_ansipath(mappedname);
+ }
+ else {
+ fullname = PerlDir_mapA(SvPV_nolen(ST(0)));
+ }
+# if PERL_VERSION < 8
+ {
+ /* PerlDir_mapX() in Perl 5.6 used to return forward slashes */
+ char *str = fullname;
+ while (*str) {
+ if (*str == '/')
+ *str = '\\';
+ ++str;
+ }
+ }
+# endif
+#endif
+
+ /* GetFullPathName() on Windows NT drops trailing backslash */
+ if (g_osver.dwMajorVersion == 4 && *fullname) {
+ STRLEN len;
+ char *pv = SvPV(ST(0), len);
+ char *lastchar = fullname + strlen(fullname) - 1;
+ /* If ST(0) ends with a slash, but fullname doesn't ... */
+ if (len && (pv[len-1] == '/' || pv[len-1] == '\\') && *lastchar != '\\') {
+ /* fullname is the MAX_PATH+1 sized buffer returned from PerlDir_mapA()
+ * or the 2*MAX_PATH sized local buffer in the __CYGWIN__ case.
+ */
+ if (lastchar - fullname < MAX_PATH - 1)
+ strcpy(lastchar+1, "\\");
+ }
+ }
+
+ if (GIMME_V == G_ARRAY) {
+ char *filepart = strrchr(fullname, '\\');
+
+ EXTEND(SP,1);
+ if (filepart) {
+ XST_mPV(1, ++filepart);
+ *filepart = '\0';
+ }
+ else {
+ XST_mPVN(1, "", 0);
+ }
+ items = 2;
+ }
+ XST_mPV(0, fullname);
+
+ if (ansi)
+ Safefree(ansi);
+ XSRETURN(items);
+}
+
+XS(w32_GetLongPathName)
+{
+ dXSARGS;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
+
+ if (IsWin2000()) {
+ WCHAR *wstr = sv_to_wstr(aTHX_ ST(0));
+ WCHAR wide_path[MAX_PATH+1];
+ WCHAR *long_path;
+
+ if (wcslen(wstr) < countof(wide_path)) {
+ wcscpy(wide_path, wstr);
+ long_path = my_longpathW(wide_path);
+ if (long_path) {
+ Safefree(wstr);
+ ST(0) = wstr_to_sv(aTHX_ long_path);
+ XSRETURN(1);
+ }
+ }
+ Safefree(wstr);
+ }
+ else {
+ SV *path;
+ char tmpbuf[MAX_PATH+1];
+ char *pathstr;
+ STRLEN len;
+
+ path = ST(0);
+ pathstr = SvPV(path,len);
+ if (len < sizeof(tmpbuf)) {
+ strcpy(tmpbuf, pathstr);
+ pathstr = my_longpathA(tmpbuf);
+ if (pathstr) {
+ ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
+ XSRETURN(1);
+ }
+ }
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(w32_GetANSIPathName)
+{
+ dXSARGS;
+ WCHAR *wide_path;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::GetANSIPathName($pathname)");
+
+ wide_path = sv_to_wstr(aTHX_ ST(0));
+ ST(0) = wstr_to_ansipath(aTHX_ wide_path);
+ Safefree(wide_path);
+ XSRETURN(1);
+}
+
+XS(w32_Sleep)
+{
+ dXSARGS;
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
+ Sleep((DWORD)SvIV(ST(0)));
+ XSRETURN_YES;
+}
+
+XS(w32_CopyFile)
+{
+ dXSARGS;
+ BOOL bResult;
+ char *pszSourceFile;
+ char szSourceFile[MAX_PATH+1];
+
+ if (items != 3)
+ Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
+
+ pszSourceFile = PerlDir_mapA(SvPV_nolen(ST(0)));
+ if (strlen(pszSourceFile) < sizeof(szSourceFile)) {
+ strcpy(szSourceFile, pszSourceFile);
+ bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
+ if (bResult)
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+XS(w32_OutputDebugString)
+{
+ dXSARGS;
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::OutputDebugString($string)");
+
+ if (SvUTF8(ST(0))) {
+ WCHAR *str = sv_to_wstr(aTHX_ ST(0));
+ OutputDebugStringW(str);
+ Safefree(str);
+ }
+ else
+ OutputDebugStringA(SvPV_nolen(ST(0)));
+
+ XSRETURN_EMPTY;
+}
+
+XS(w32_GetCurrentProcessId)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetCurrentProcessId());
+}
+
+XS(w32_GetCurrentThreadId)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetCurrentThreadId());
+}
+
+XS(w32_CreateDirectory)
+{
+ dXSARGS;
+ BOOL result;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::CreateDirectory($dir)");
+
+ if (IsWin2000() && SvUTF8(ST(0))) {
+ WCHAR *dir = sv_to_wstr(aTHX_ ST(0));
+ result = CreateDirectoryW(dir, NULL);
+ Safefree(dir);
+ }
+ else {
+ result = CreateDirectoryA(SvPV_nolen(ST(0)), NULL);
+ }
+
+ ST(0) = boolSV(result);
+ XSRETURN(1);
+}
+
+XS(w32_CreateFile)
+{
+ dXSARGS;
+ HANDLE handle;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::CreateFile($file)");
+
+ if (IsWin2000() && SvUTF8(ST(0))) {
+ WCHAR *file = sv_to_wstr(aTHX_ ST(0));
+ handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_WRITE,
+ NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
+ Safefree(file);
+ }
+ else {
+ handle = CreateFileA(SvPV_nolen(ST(0)), GENERIC_WRITE, FILE_SHARE_WRITE,
+ NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);
+ }
+
+ if (handle != INVALID_HANDLE_VALUE)
+ CloseHandle(handle);
+
+ ST(0) = boolSV(handle != INVALID_HANDLE_VALUE);
+ XSRETURN(1);
+}
+
+XS(w32_GetSystemMetrics)
+{
+ dXSARGS;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::GetSystemMetrics($index)");
+
+ XSRETURN_IV(GetSystemMetrics((int)SvIV(ST(0))));
+}
+
+XS(w32_GetProductInfo)
+{
+ dXSARGS;
+ DWORD type;
+ HMODULE module;
+ PFNGetProductInfo pfnGetProductInfo;
+
+ if (items != 4)
+ Perl_croak(aTHX_ "usage: Win32::GetProductInfo($major,$minor,$spmajor,$spminor)");
+
+ module = GetModuleHandle("kernel32.dll");
+ GETPROC(GetProductInfo);
+ if (pfnGetProductInfo &&
+ pfnGetProductInfo((DWORD)SvIV(ST(0)), (DWORD)SvIV(ST(1)),
+ (DWORD)SvIV(ST(2)), (DWORD)SvIV(ST(3)), &type))
+ {
+ XSRETURN_IV(type);
+ }
+
+ /* PRODUCT_UNDEFINED */
+ XSRETURN_IV(0);
+}
+
+XS(w32_GetACP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetACP());
+}
+
+XS(w32_GetConsoleCP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetConsoleCP());
+}
+
+XS(w32_GetConsoleOutputCP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetConsoleOutputCP());
+}
+
+XS(w32_GetOEMCP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetOEMCP());
+}
+
+XS(w32_SetConsoleCP)
+{
+ dXSARGS;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::SetConsoleCP($id)");
+
+ XSRETURN_IV(SetConsoleCP((int)SvIV(ST(0))));
+}
+
+XS(w32_SetConsoleOutputCP)
+{
+ dXSARGS;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::SetConsoleOutputCP($id)");
+
+ XSRETURN_IV(SetConsoleOutputCP((int)SvIV(ST(0))));
+}
+
+MODULE = Win32 PACKAGE = Win32
+
+PROTOTYPES: DISABLE
+
+BOOT:
+{
+ char *file = __FILE__;
+
+ if (g_osver.dwOSVersionInfoSize == 0) {
+ g_osver.dwOSVersionInfoSize = sizeof(g_osver);
+ if (!GetVersionExA((OSVERSIONINFOA*)&g_osver)) {
+ g_osver_ex = FALSE;
+ g_osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+ GetVersionExA((OSVERSIONINFOA*)&g_osver);
+ }
+ }
+
+ 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);
+ newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
+
+ newXS("Win32::GetCwd", w32_GetCwd, file);
+ newXS("Win32::SetCwd", w32_SetCwd, file);
+ newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
+ newXS("Win32::GetLastError", w32_GetLastError, file);
+ newXS("Win32::SetLastError", w32_SetLastError, file);
+ newXS("Win32::LoginName", w32_LoginName, file);
+ newXS("Win32::NodeName", w32_NodeName, file);
+ newXS("Win32::DomainName", w32_DomainName, file);
+ newXS("Win32::FsType", w32_FsType, file);
+ newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
+ newXS("Win32::IsWinNT", w32_IsWinNT, file);
+ newXS("Win32::IsWin95", w32_IsWin95, file);
+ newXS("Win32::FormatMessage", w32_FormatMessage, file);
+ newXS("Win32::Spawn", w32_Spawn, file);
+ newXS("Win32::GetTickCount", w32_GetTickCount, file);
+ newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
+ newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
+ newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
+ newXS("Win32::GetANSIPathName", w32_GetANSIPathName, file);
+ newXS("Win32::CopyFile", w32_CopyFile, file);
+ newXS("Win32::Sleep", w32_Sleep, file);
+ newXS("Win32::OutputDebugString", w32_OutputDebugString, file);
+ newXS("Win32::GetCurrentProcessId", w32_GetCurrentProcessId, file);
+ newXS("Win32::GetCurrentThreadId", w32_GetCurrentThreadId, file);
+ newXS("Win32::CreateDirectory", w32_CreateDirectory, file);
+ newXS("Win32::CreateFile", w32_CreateFile, file);
+ newXS("Win32::GetSystemMetrics", w32_GetSystemMetrics, file);
+ newXS("Win32::GetProductInfo", w32_GetProductInfo, file);
+ newXS("Win32::GetACP", w32_GetACP, file);
+ newXS("Win32::GetConsoleCP", w32_GetConsoleCP, file);
+ newXS("Win32::GetConsoleOutputCP", w32_GetConsoleOutputCP, file);
+ newXS("Win32::GetOEMCP", w32_GetOEMCP, file);
+ newXS("Win32::SetConsoleCP", w32_SetConsoleCP, file);
+ newXS("Win32::SetConsoleOutputCP", w32_SetConsoleOutputCP, file);
+#ifdef __CYGWIN__
+ newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
+#endif
+ XSRETURN_YES;
+}
diff --git a/cpan/Win32/longpath.inc b/cpan/Win32/longpath.inc
index 2e5fd843a6..ea6c1de48a 100644
--- a/cpan/Win32/longpath.inc
+++ b/cpan/Win32/longpath.inc
@@ -1,111 +1,111 @@
-#ifndef isSLASH
-#define isSLASH(c) ((c) == '/' || (c) == '\\')
-#define SKIP_SLASHES(s) \
- STMT_START { \
- while (*(s) && isSLASH(*(s))) \
- ++(s); \
- } STMT_END
-#define COPY_NONSLASHES(d,s) \
- STMT_START { \
- while (*(s) && !isSLASH(*(s))) \
- *(d)++ = *(s)++; \
- } STMT_END
-#endif
-
-/* Find the longname of a given path. path is destructively modified.
- * It should have space for at least MAX_PATH characters. */
-
-CHAR_T *
-LONGPATH(CHAR_T *path)
-{
- WIN32_FIND_DATA_T fdata;
- HANDLE fhand;
- CHAR_T tmpbuf[MAX_PATH+1];
- CHAR_T *tmpstart = tmpbuf;
- CHAR_T *start = path;
- CHAR_T sep;
- if (!path)
- return NULL;
-
- /* drive prefix */
- if (isALPHA(path[0]) && path[1] == ':') {
- start = path + 2;
- *tmpstart++ = toupper(path[0]);
- *tmpstart++ = ':';
- }
- /* UNC prefix */
- else if (isSLASH(path[0]) && isSLASH(path[1])) {
- start = path + 2;
- *tmpstart++ = path[0];
- *tmpstart++ = path[1];
- SKIP_SLASHES(start);
- COPY_NONSLASHES(tmpstart,start); /* copy machine name */
- if (*start) {
- *tmpstart++ = *start++;
- SKIP_SLASHES(start);
- COPY_NONSLASHES(tmpstart,start); /* copy share name */
- }
- }
- *tmpstart = '\0';
- while (*start) {
- /* copy initial slash, if any */
- if (isSLASH(*start)) {
- *tmpstart++ = *start++;
- *tmpstart = '\0';
- SKIP_SLASHES(start);
- }
-
- /* FindFirstFile() expands "." and "..", so we need to pass
- * those through unmolested */
- if (*start == '.'
- && (!start[1] || isSLASH(start[1])
- || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
- {
- COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
- *tmpstart = '\0';
- continue;
- }
-
- /* if this is the end, bust outta here */
- if (!*start)
- break;
-
- /* now we're at a non-slash; walk up to next slash */
- while (*start && !isSLASH(*start))
- ++start;
-
- /* stop and find full name of component */
- sep = *start;
- *start = '\0';
- fhand = FN_FINDFIRSTFILE(path,&fdata);
- *start = sep;
- if (fhand != INVALID_HANDLE_VALUE) {
- STRLEN len = FN_STRLEN(fdata.cFileName);
- if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
- FN_STRCPY(tmpstart, fdata.cFileName);
- tmpstart += len;
- FindClose(fhand);
- }
- else {
- FindClose(fhand);
- errno = ERANGE;
- return NULL;
- }
- }
- else {
- /* failed a step, just return without side effects */
- /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
- errno = EINVAL;
- return NULL;
- }
- }
- FN_STRCPY(path,tmpbuf);
- return path;
-}
-
-#undef CHAR_T
-#undef WIN32_FIND_DATA_T
-#undef FN_FINDFIRSTFILE
-#undef FN_STRLEN
-#undef FN_STRCPY
-#undef LONGPATH
+#ifndef isSLASH
+#define isSLASH(c) ((c) == '/' || (c) == '\\')
+#define SKIP_SLASHES(s) \
+ STMT_START { \
+ while (*(s) && isSLASH(*(s))) \
+ ++(s); \
+ } STMT_END
+#define COPY_NONSLASHES(d,s) \
+ STMT_START { \
+ while (*(s) && !isSLASH(*(s))) \
+ *(d)++ = *(s)++; \
+ } STMT_END
+#endif
+
+/* Find the longname of a given path. path is destructively modified.
+ * It should have space for at least MAX_PATH characters. */
+
+CHAR_T *
+LONGPATH(CHAR_T *path)
+{
+ WIN32_FIND_DATA_T fdata;
+ HANDLE fhand;
+ CHAR_T tmpbuf[MAX_PATH+1];
+ CHAR_T *tmpstart = tmpbuf;
+ CHAR_T *start = path;
+ CHAR_T sep;
+ if (!path)
+ return NULL;
+
+ /* drive prefix */
+ if (isALPHA(path[0]) && path[1] == ':') {
+ start = path + 2;
+ *tmpstart++ = toupper(path[0]);
+ *tmpstart++ = ':';
+ }
+ /* UNC prefix */
+ else if (isSLASH(path[0]) && isSLASH(path[1])) {
+ start = path + 2;
+ *tmpstart++ = path[0];
+ *tmpstart++ = path[1];
+ SKIP_SLASHES(start);
+ COPY_NONSLASHES(tmpstart,start); /* copy machine name */
+ if (*start) {
+ *tmpstart++ = *start++;
+ SKIP_SLASHES(start);
+ COPY_NONSLASHES(tmpstart,start); /* copy share name */
+ }
+ }
+ *tmpstart = '\0';
+ while (*start) {
+ /* copy initial slash, if any */
+ if (isSLASH(*start)) {
+ *tmpstart++ = *start++;
+ *tmpstart = '\0';
+ SKIP_SLASHES(start);
+ }
+
+ /* FindFirstFile() expands "." and "..", so we need to pass
+ * those through unmolested */
+ if (*start == '.'
+ && (!start[1] || isSLASH(start[1])
+ || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
+ {
+ COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
+ *tmpstart = '\0';
+ continue;
+ }
+
+ /* if this is the end, bust outta here */
+ if (!*start)
+ break;
+
+ /* now we're at a non-slash; walk up to next slash */
+ while (*start && !isSLASH(*start))
+ ++start;
+
+ /* stop and find full name of component */
+ sep = *start;
+ *start = '\0';
+ fhand = FN_FINDFIRSTFILE(path,&fdata);
+ *start = sep;
+ if (fhand != INVALID_HANDLE_VALUE) {
+ STRLEN len = FN_STRLEN(fdata.cFileName);
+ if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
+ FN_STRCPY(tmpstart, fdata.cFileName);
+ tmpstart += len;
+ FindClose(fhand);
+ }
+ else {
+ FindClose(fhand);
+ errno = ERANGE;
+ return NULL;
+ }
+ }
+ else {
+ /* failed a step, just return without side effects */
+ /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
+ errno = EINVAL;
+ return NULL;
+ }
+ }
+ FN_STRCPY(path,tmpbuf);
+ return path;
+}
+
+#undef CHAR_T
+#undef WIN32_FIND_DATA_T
+#undef FN_FINDFIRSTFILE
+#undef FN_STRLEN
+#undef FN_STRCPY
+#undef LONGPATH
diff --git a/cpan/Win32/t/CodePage.t b/cpan/Win32/t/CodePage.t
new file mode 100644
index 0000000000..75741cc974
--- /dev/null
+++ b/cpan/Win32/t/CodePage.t
@@ -0,0 +1,27 @@
+use strict;
+use Test;
+use Win32;
+
+plan tests => 8;
+
+my $ansicp = Win32::GetACP();
+ok($ansicp > 0 && $ansicp <= 65001);
+
+my $inputcp = Win32::GetConsoleCP();
+ok($inputcp > 0 && $inputcp <= 65001);
+
+my $outputcp = Win32::GetConsoleOutputCP();
+ok($outputcp > 0 && $outputcp <= 65001);
+
+my $oemcp = Win32::GetOEMCP();
+ok($oemcp > 0 && $oemcp <= 65001);
+
+ok(Win32::SetConsoleCP($ansicp));
+ok(Win32::GetConsoleCP() == $ansicp);
+
+ok(Win32::SetConsoleOutputCP($ansicp));
+ok(Win32::GetConsoleOutputCP() == $ansicp);
+
+# Reset things when we're done.
+Win32::SetConsoleCP($inputcp);
+Win32::SetConsoleOutputCP($outputcp);
diff --git a/cpan/Win32/t/CreateFile.t b/cpan/Win32/t/CreateFile.t
index 63ce31694c..ee1bf46daf 100644
--- a/cpan/Win32/t/CreateFile.t
+++ b/cpan/Win32/t/CreateFile.t
@@ -1,31 +1,31 @@
-use strict;
-use Test;
-use Win32;
-
-my $path = "testing-$$";
-rmdir($path) if -d $path;
-unlink($path) if -f $path;
-
-plan tests => 15;
-
-ok(!-d $path);
-ok(!-f $path);
-
-ok(Win32::CreateDirectory($path));
-ok(-d $path);
-
-ok(!Win32::CreateDirectory($path));
-ok(!Win32::CreateFile($path));
-
-ok(rmdir($path));
-ok(!-d $path);
-
-ok(Win32::CreateFile($path));
-ok(-f $path);
-ok(-s $path, 0);
-
-ok(!Win32::CreateDirectory($path));
-ok(!Win32::CreateFile($path));
-
-ok(unlink($path));
-ok(!-f $path);
+use strict;
+use Test;
+use Win32;
+
+my $path = "testing-$$";
+rmdir($path) if -d $path;
+unlink($path) if -f $path;
+
+plan tests => 15;
+
+ok(!-d $path);
+ok(!-f $path);
+
+ok(Win32::CreateDirectory($path));
+ok(-d $path);
+
+ok(!Win32::CreateDirectory($path));
+ok(!Win32::CreateFile($path));
+
+ok(rmdir($path));
+ok(!-d $path);
+
+ok(Win32::CreateFile($path));
+ok(-f $path);
+ok(-s $path, 0);
+
+ok(!Win32::CreateDirectory($path));
+ok(!Win32::CreateFile($path));
+
+ok(unlink($path));
+ok(!-f $path);
diff --git a/cpan/Win32/t/ExpandEnvironmentStrings.t b/cpan/Win32/t/ExpandEnvironmentStrings.t
index 853be4aa0e..b57b47cddd 100644
--- a/cpan/Win32/t/ExpandEnvironmentStrings.t
+++ b/cpan/Win32/t/ExpandEnvironmentStrings.t
@@ -1,7 +1,7 @@
-use strict;
-use Test;
-use Win32;
-
-plan tests => 1;
-
-ok(Win32::ExpandEnvironmentStrings("%WINDIR%"), $ENV{WINDIR});
+use strict;
+use Test;
+use Win32;
+
+plan tests => 1;
+
+ok(Win32::ExpandEnvironmentStrings("%WINDIR%"), $ENV{WINDIR});
diff --git a/cpan/Win32/t/GetCurrentThreadId.t b/cpan/Win32/t/GetCurrentThreadId.t
index 6117e3ef66..ce98f3e562 100644
--- a/cpan/Win32/t/GetCurrentThreadId.t
+++ b/cpan/Win32/t/GetCurrentThreadId.t
@@ -1,38 +1,38 @@
-use strict;
-use Config qw(%Config);
-use Test;
-use Win32;
-
-my $fork_emulation = $Config{ccflags} =~ /PERL_IMPLICIT_SYS/;
-
-my $tests = $fork_emulation ? 4 : 2;
-plan tests => $tests;
-
-my $pid = $$+0; # make sure we don't copy any magic to $pid
-
-if ($^O eq "cygwin") {
- skip(!defined &Cygwin::pid_to_winpid,
- Cygwin::pid_to_winpid($pid),
- Win32::GetCurrentProcessId());
-}
-else {
- ok($pid, Win32::GetCurrentProcessId());
-}
-
-if ($fork_emulation) {
- # This test relies on the implementation detail that the fork() emulation
- # uses the negative value of the thread id as a pseudo process id.
- if (my $child = fork) {
- waitpid($child, 0);
- exit 0;
- }
- ok(-$$, Win32::GetCurrentThreadId());
-
- # GetCurrentProcessId() should still return the real PID
- ok($pid, Win32::GetCurrentProcessId());
- ok($$ != Win32::GetCurrentProcessId());
-}
-else {
- # here we just want to see something.
- ok(Win32::GetCurrentThreadId() > 0);
-}
+use strict;
+use Config qw(%Config);
+use Test;
+use Win32;
+
+my $fork_emulation = $Config{ccflags} =~ /PERL_IMPLICIT_SYS/;
+
+my $tests = $fork_emulation ? 4 : 2;
+plan tests => $tests;
+
+my $pid = $$+0; # make sure we don't copy any magic to $pid
+
+if ($^O eq "cygwin") {
+ skip(!defined &Cygwin::pid_to_winpid,
+ Cygwin::pid_to_winpid($pid),
+ Win32::GetCurrentProcessId());
+}
+else {
+ ok($pid, Win32::GetCurrentProcessId());
+}
+
+if ($fork_emulation) {
+ # This test relies on the implementation detail that the fork() emulation
+ # uses the negative value of the thread id as a pseudo process id.
+ if (my $child = fork) {
+ waitpid($child, 0);
+ exit 0;
+ }
+ ok(-$$, Win32::GetCurrentThreadId());
+
+ # GetCurrentProcessId() should still return the real PID
+ ok($pid, Win32::GetCurrentProcessId());
+ ok($$ != Win32::GetCurrentProcessId());
+}
+else {
+ # here we just want to see something.
+ ok(Win32::GetCurrentThreadId() > 0);
+}
diff --git a/cpan/Win32/t/GetFileVersion.t b/cpan/Win32/t/GetFileVersion.t
index 6e42fb779f..b9e51f821d 100644
--- a/cpan/Win32/t/GetFileVersion.t
+++ b/cpan/Win32/t/GetFileVersion.t
@@ -1,18 +1,18 @@
-use strict;
-use Test;
-use Win32;
-
-unless (defined &Win32::BuildNumber) {
- print "1..0 # Skip: Only ActivePerl seems to set the perl.exe fileversion\n";
- exit;
-}
-
-plan tests => 2;
-
-my @version = Win32::GetFileVersion($^X);
-my $version = $version[0] + $version[1] / 1000 + $version[2] / 1000000;
-
-# numify $] because it is a version object in 5.10 which will stringify with trailing 0s
-ok($version, 0+$]);
-
-ok($version[3], int(Win32::BuildNumber()));
+use strict;
+use Test;
+use Win32;
+
+unless (defined &Win32::BuildNumber) {
+ print "1..0 # Skip: Only ActivePerl seems to set the perl.exe fileversion\n";
+ exit;
+}
+
+plan tests => 2;
+
+my @version = Win32::GetFileVersion($^X);
+my $version = $version[0] + $version[1] / 1000 + $version[2] / 1000000;
+
+# numify $] because it is a version object in 5.10 which will stringify with trailing 0s
+ok($version, 0+$]);
+
+ok($version[3], int(Win32::BuildNumber()));
diff --git a/cpan/Win32/t/GetFolderPath.t b/cpan/Win32/t/GetFolderPath.t
index ad8df99ecc..c010c25aa8 100644
--- a/cpan/Win32/t/GetFolderPath.t
+++ b/cpan/Win32/t/GetFolderPath.t
@@ -1,8 +1,8 @@
-use strict;
-use Test;
-use Win32;
-
-plan tests => 1;
-
-# "windir" exists back to Win9X; "SystemRoot" only exists on WinNT and later.
-ok(Win32::GetFolderPath(Win32::CSIDL_WINDOWS), $ENV{WINDIR});
+use strict;
+use Test;
+use Win32;
+
+plan tests => 1;
+
+# "windir" exists back to Win9X; "SystemRoot" only exists on WinNT and later.
+ok(Win32::GetFolderPath(Win32::CSIDL_WINDOWS), $ENV{WINDIR});
diff --git a/cpan/Win32/t/GetFullPathName.t b/cpan/Win32/t/GetFullPathName.t
index 15542e5e65..ec716d15d2 100644
--- a/cpan/Win32/t/GetFullPathName.t
+++ b/cpan/Win32/t/GetFullPathName.t
@@ -1,34 +1,34 @@
-use strict;
-use Test;
-use Win32;
-
-plan tests => 16;
-
-my $cwd = Win32::GetCwd;
-my @cwd = split/\\/, $cwd;
-my $file = pop @cwd;
-my $dir = join('\\', @cwd);
-
-ok(scalar Win32::GetFullPathName('.'), $cwd);
-ok((Win32::GetFullPathName('.'))[0], "$dir\\");
-ok((Win32::GetFullPathName('.'))[1], $file);
-
-ok((Win32::GetFullPathName('./'))[0], "$cwd\\");
-ok((Win32::GetFullPathName('.\\'))[0], "$cwd\\");
-ok((Win32::GetFullPathName('./'))[1], "");
-
-ok(scalar Win32::GetFullPathName($cwd), $cwd);
-ok((Win32::GetFullPathName($cwd))[0], "$dir\\");
-ok((Win32::GetFullPathName($cwd))[1], $file);
-
-ok(scalar Win32::GetFullPathName(substr($cwd,2)), $cwd);
-ok((Win32::GetFullPathName(substr($cwd,2)))[0], "$dir\\");
-ok((Win32::GetFullPathName(substr($cwd,2)))[1], $file);
-
-ok(scalar Win32::GetFullPathName('/Foo Bar/'), substr($cwd,0,2)."\\Foo Bar\\");
-
-chdir($dir);
-ok(scalar Win32::GetFullPathName('.'), $dir);
-
-ok((Win32::GetFullPathName($file))[0], "$dir\\");
-ok((Win32::GetFullPathName($file))[1], $file);
+use strict;
+use Test;
+use Win32;
+
+plan tests => 16;
+
+my $cwd = Win32::GetCwd;
+my @cwd = split/\\/, $cwd;
+my $file = pop @cwd;
+my $dir = join('\\', @cwd);
+
+ok(scalar Win32::GetFullPathName('.'), $cwd);
+ok((Win32::GetFullPathName('.'))[0], "$dir\\");
+ok((Win32::GetFullPathName('.'))[1], $file);
+
+ok((Win32::GetFullPathName('./'))[0], "$cwd\\");
+ok((Win32::GetFullPathName('.\\'))[0], "$cwd\\");
+ok((Win32::GetFullPathName('./'))[1], "");
+
+ok(scalar Win32::GetFullPathName($cwd), $cwd);
+ok((Win32::GetFullPathName($cwd))[0], "$dir\\");
+ok((Win32::GetFullPathName($cwd))[1], $file);
+
+ok(scalar Win32::GetFullPathName(substr($cwd,2)), $cwd);
+ok((Win32::GetFullPathName(substr($cwd,2)))[0], "$dir\\");
+ok((Win32::GetFullPathName(substr($cwd,2)))[1], $file);
+
+ok(scalar Win32::GetFullPathName('/Foo Bar/'), substr($cwd,0,2)."\\Foo Bar\\");
+
+chdir($dir);
+ok(scalar Win32::GetFullPathName('.'), $dir);
+
+ok((Win32::GetFullPathName($file))[0], "$dir\\");
+ok((Win32::GetFullPathName($file))[1], $file);
diff --git a/cpan/Win32/t/GetLongPathName.t b/cpan/Win32/t/GetLongPathName.t
index b7da71991c..5019a2ba25 100644
--- a/cpan/Win32/t/GetLongPathName.t
+++ b/cpan/Win32/t/GetLongPathName.t
@@ -1,53 +1,53 @@
-use strict;
-use Test;
-use Win32;
-
-my @paths = qw(
- /
- //
- .
- ..
- c:
- c:/
- c:./
- c:/.
- c:/..
- c:./..
- //./
- //.
- //..
- //./..
-);
-push @paths, map { my $x = $_; $x =~ s,/,\\,g; $x } @paths;
-push @paths, qw(
- ../\
- c:.\\../\
- c:/\..//
- c://.\/./\
- \\.\\../\
- //\..//
- //.\/./\
-);
-
-my $drive = $ENV{SYSTEMDRIVE};
-if ($drive) {
- for (@paths) {
- s/^c:/$drive/;
- }
-}
-my %expect;
-@expect{@paths} = map { my $x = $_;
- $x =~ s,(.[/\\])[/\\]+,$1,g;
- $x =~ s,^(\w):,\U$1:,;
- $x } @paths;
-
-plan tests => scalar(@paths);
-
-my $i = 1;
-for (@paths) {
- my $got = Win32::GetLongPathName($_);
- print "# '$_' => expect '$expect{$_}' => got '$got'\n";
- print "not " unless $expect{$_} eq $got;
- print "ok $i\n";
- ++$i;
-}
+use strict;
+use Test;
+use Win32;
+
+my @paths = qw(
+ /
+ //
+ .
+ ..
+ c:
+ c:/
+ c:./
+ c:/.
+ c:/..
+ c:./..
+ //./
+ //.
+ //..
+ //./..
+);
+push @paths, map { my $x = $_; $x =~ s,/,\\,g; $x } @paths;
+push @paths, qw(
+ ../\
+ c:.\\../\
+ c:/\..//
+ c://.\/./\
+ \\.\\../\
+ //\..//
+ //.\/./\
+);
+
+my $drive = $ENV{SYSTEMDRIVE};
+if ($drive) {
+ for (@paths) {
+ s/^c:/$drive/;
+ }
+}
+my %expect;
+@expect{@paths} = map { my $x = $_;
+ $x =~ s,(.[/\\])[/\\]+,$1,g;
+ $x =~ s,^(\w):,\U$1:,;
+ $x } @paths;
+
+plan tests => scalar(@paths);
+
+my $i = 1;
+for (@paths) {
+ my $got = Win32::GetLongPathName($_);
+ print "# '$_' => expect '$expect{$_}' => got '$got'\n";
+ print "not " unless $expect{$_} eq $got;
+ print "ok $i\n";
+ ++$i;
+}
diff --git a/cpan/Win32/t/GetOSVersion.t b/cpan/Win32/t/GetOSVersion.t
index 0038ef70e6..cb3f36490b 100644
--- a/cpan/Win32/t/GetOSVersion.t
+++ b/cpan/Win32/t/GetOSVersion.t
@@ -1,11 +1,11 @@
-use strict;
-use Test;
-use Win32;
-
-plan tests => 1;
-
-my $scalar = Win32::GetOSVersion();
-my @array = Win32::GetOSVersion();
-
-print "not " unless $scalar == $array[4];
-print "ok 1\n";
+use strict;
+use Test;
+use Win32;
+
+plan tests => 1;
+
+my $scalar = Win32::GetOSVersion();
+my @array = Win32::GetOSVersion();
+
+print "not " unless $scalar == $array[4];
+print "ok 1\n";
diff --git a/cpan/Win32/t/GetShortPathName.t b/cpan/Win32/t/GetShortPathName.t
index 34adf96572..455385418c 100644
--- a/cpan/Win32/t/GetShortPathName.t
+++ b/cpan/Win32/t/GetShortPathName.t
@@ -1,20 +1,20 @@
-use strict;
-use Test;
-use Win32;
-
-my $path = "Long Path $$";
-unlink($path);
-END { unlink $path }
-
-plan tests => 5;
-
-Win32::CreateFile($path);
-ok(-f $path);
-
-my $short = Win32::GetShortPathName($path);
-ok($short, qr/^\S{1,8}(\.\S{1,3})?$/);
-ok(-f $short);
-
-unlink($path);
-ok(!-f $path);
-ok(!defined Win32::GetShortPathName($path));
+use strict;
+use Test;
+use Win32;
+
+my $path = "Long Path $$";
+unlink($path);
+END { unlink $path }
+
+plan tests => 5;
+
+Win32::CreateFile($path);
+ok(-f $path);
+
+my $short = Win32::GetShortPathName($path);
+ok($short, qr/^\S{1,8}(\.\S{1,3})?$/);
+ok(-f $short);
+
+unlink($path);
+ok(!-f $path);
+ok(!defined Win32::GetShortPathName($path));
diff --git a/cpan/Win32/t/GuidGen.t b/cpan/Win32/t/GuidGen.t
index 9ee8ede934..7011e2f149 100644
--- a/cpan/Win32/t/GuidGen.t
+++ b/cpan/Win32/t/GuidGen.t
@@ -1,15 +1,15 @@
-use strict;
-use Test;
-use Win32;
-
-plan tests => 3;
-
-my $guid1 = Win32::GuidGen();
-my $guid2 = Win32::GuidGen();
-
-# {FB9586CD-273B-43BE-A20C-485A6BD4FCD6}
-ok($guid1, qr/^{\w{8}(-\w{4}){3}-\w{12}}$/);
-ok($guid2, qr/^{\w{8}(-\w{4}){3}-\w{12}}$/);
-
-# Every GUID is unique
-ok($guid1 ne $guid2);
+use strict;
+use Test;
+use Win32;
+
+plan tests => 3;
+
+my $guid1 = Win32::GuidGen();
+my $guid2 = Win32::GuidGen();
+
+# {FB9586CD-273B-43BE-A20C-485A6BD4FCD6}
+ok($guid1, qr/^{\w{8}(-\w{4}){3}-\w{12}}$/);
+ok($guid2, qr/^{\w{8}(-\w{4}){3}-\w{12}}$/);
+
+# Every GUID is unique
+ok($guid1 ne $guid2);
diff --git a/cpan/Win32/t/Names.t b/cpan/Win32/t/Names.t
index ecab79f78b..509751d7de 100644
--- a/cpan/Win32/t/Names.t
+++ b/cpan/Win32/t/Names.t
@@ -1,56 +1,56 @@
-use strict;
-BEGIN {
- eval "use Test::More";
- return unless $@;
- print "1..0 # Skip: Test requires Test::More module\n";
- exit 0;
-}
-use Win32;
-
-my $tests = 14;
-$tests += 2 if Win32::IsWinNT();
-
-plan tests => $tests;
-
-# test Win32::DomainName()
-if (Win32::IsWinNT()) {
- my $domain = eval { Win32::DomainName() };
- SKIP: {
- skip('The Workstation service has not been started', 2) if (Win32::GetLastError() == 2138);
- is( $@, '', "Win32::DomainName()" );
- like( $domain, '/^[a-zA-Z0-9!@#$%^&()_\'{}.~-]+$/', " - checking returned domain" );
- }
-}
-
-# test Win32::GetArchName()
-my $archname = eval { Win32::GetArchName() };
-is( $@, '', "Win32::GetArchName()" );
-cmp_ok( length($archname), '>=', 3, " - checking returned architecture name" );
-
-# test Win32::GetChipName()
-my $chipname = eval { Win32::GetChipName() };
-is( $@, '', "Win32::GetChipName()" );
-cmp_ok( length($chipname), '>=', 3, " - checking returned chip name" );
-
-# test Win32::GetOSName()
-# - scalar context
-my $osname = eval { Win32::GetOSName() };
-is( $@, '', "Win32::GetOSName() in scalar context" );
-cmp_ok( length($osname), '>', 3, " - checking returned OS name" );
-
-# - list context
-my ($osname2, $desc) = eval { Win32::GetOSName() };
-is( $@, '', "Win32::GetOSName() in list context" );
-cmp_ok( length($osname2), '>', 3, " - checking returned OS name" );
-ok( defined($desc), " - checking returned description" );
-is( $osname2, $osname, " - checking that OS name is the same in both calls" );
-
-# test Win32::LoginName()
-my $login = eval { Win32::LoginName() };
-is( $@, '', "Win32::LoginName()" );
-cmp_ok( length($login), '>', 1, " - checking returned login name" );
-
-# test Win32::NodeName()
-my $nodename = eval { Win32::NodeName() };
-is( $@, '', "Win32::NodeName()" );
-cmp_ok( length($nodename), '>', 1, " - checking returned node name" );
+use strict;
+BEGIN {
+ eval "use Test::More";
+ return unless $@;
+ print "1..0 # Skip: Test requires Test::More module\n";
+ exit 0;
+}
+use Win32;
+
+my $tests = 14;
+$tests += 2 if Win32::IsWinNT();
+
+plan tests => $tests;
+
+# test Win32::DomainName()
+if (Win32::IsWinNT()) {
+ my $domain = eval { Win32::DomainName() };
+ SKIP: {
+ skip('The Workstation service has not been started', 2) if (Win32::GetLastError() == 2138);
+ is( $@, '', "Win32::DomainName()" );
+ like( $domain, '/^[a-zA-Z0-9!@#$%^&()_\'{}.~-]+$/', " - checking returned domain" );
+ }
+}
+
+# test Win32::GetArchName()
+my $archname = eval { Win32::GetArchName() };
+is( $@, '', "Win32::GetArchName()" );
+cmp_ok( length($archname), '>=', 3, " - checking returned architecture name" );
+
+# test Win32::GetChipName()
+my $chipname = eval { Win32::GetChipName() };
+is( $@, '', "Win32::GetChipName()" );
+cmp_ok( length($chipname), '>=', 3, " - checking returned chip name" );
+
+# test Win32::GetOSName()
+# - scalar context
+my $osname = eval { Win32::GetOSName() };
+is( $@, '', "Win32::GetOSName() in scalar context" );
+cmp_ok( length($osname), '>', 3, " - checking returned OS name" );
+
+# - list context
+my ($osname2, $desc) = eval { Win32::GetOSName() };
+is( $@, '', "Win32::GetOSName() in list context" );
+cmp_ok( length($osname2), '>', 3, " - checking returned OS name" );
+ok( defined($desc), " - checking returned description" );
+is( $osname2, $osname, " - checking that OS name is the same in both calls" );
+
+# test Win32::LoginName()
+my $login = eval { Win32::LoginName() };
+is( $@, '', "Win32::LoginName()" );
+cmp_ok( length($login), '>', 1, " - checking returned login name" );
+
+# test Win32::NodeName()
+my $nodename = eval { Win32::NodeName() };
+is( $@, '', "Win32::NodeName()" );
+cmp_ok( length($nodename), '>', 1, " - checking returned node name" );
diff --git a/cpan/Win32/t/Unicode.t b/cpan/Win32/t/Unicode.t
index 3570142665..2d03fd6dcd 100644
--- a/cpan/Win32/t/Unicode.t
+++ b/cpan/Win32/t/Unicode.t
@@ -1,85 +1,90 @@
-use strict;
-use Test;
-use Cwd qw(cwd);
-use Win32;
-
-BEGIN {
- unless (defined &Win32::BuildNumber && Win32::BuildNumber() >= 820 or $] >= 5.008009) {
- print "1..0 # Skip: Needs ActivePerl 820 or Perl 5.8.9 or later\n";
- exit 0;
- }
- if ((((Win32::FsType())[1] & 4) == 0) || (Win32::FsType() =~ /^FAT/)) {
- print "1..0 # Skip: Filesystem doesn't support Unicode\n";
- exit 0;
- }
- unless ((Win32::GetOSVersion())[1] > 4) {
- print "1..0 # Skip: Unicode support requires Windows 2000 or later\n";
- exit 0;
- }
-}
-
-my $home = Win32::GetCwd();
-my $cwd = cwd(); # may be a Cygwin path
-my $dir = "Foo \x{394}\x{419} Bar \x{5E7}\x{645} Baz";
-my $file = "$dir\\xyzzy \x{394}\x{419} plugh \x{5E7}\x{645}";
-
-sub cleanup {
- chdir($home);
- my $ansi = Win32::GetANSIPathName($file);
- unlink($ansi) if -f $ansi;
- $ansi = Win32::GetANSIPathName($dir);
- rmdir($ansi) if -d $ansi;
-}
-
-cleanup();
-END { cleanup() }
-
-plan test => 12;
-
-# Create Unicode directory
-Win32::CreateDirectory($dir);
-ok(-d Win32::GetANSIPathName($dir));
-
-# Create Unicode file
-Win32::CreateFile($file);
-ok(-f Win32::GetANSIPathName($file));
-
-# readdir() returns ANSI form of Unicode filename
-ok(opendir(my $dh, Win32::GetANSIPathName($dir)));
-while ($_ = readdir($dh)) {
- next if /^\./;
- ok($file, Win32::GetLongPathName("$dir\\$_"));
-}
-closedir($dh);
-
-# Win32::GetLongPathName() of the absolute path restores the Unicode dir name
-my $full = Win32::GetFullPathName($dir);
-my $long = Win32::GetLongPathName($full);
-
-ok($long, Win32::GetLongPathName($home)."\\$dir");
-
-# We can Win32::SetCwd() into the Unicode directory
-ok(Win32::SetCwd($dir));
-
-my $w32dir = Win32::GetCwd();
-# cwd() also returns a usable ANSI directory name
-my $subdir = cwd();
-
-# change back to home directory to make sure relative paths
-# in @INC continue to work
-ok(chdir($home));
-ok(Win32::GetCwd(), $home);
-
-ok(Win32::GetLongPathName($w32dir), $long);
-
-# cwd() on Cygwin returns a mapped path that we need to translate
-# back to a Windows path. Invoking `cygpath` on $subdir doesn't work.
-if ($^O eq "cygwin") {
- $subdir = Cygwin::posix_to_win_path($subdir, 1);
-}
-$subdir =~ s,/,\\,g;
-ok(Win32::GetLongPathName($subdir), $long);
-
-# We can chdir() into the Unicode directory if we use the ANSI name
-ok(chdir(Win32::GetANSIPathName($dir)));
-ok(Win32::GetLongPathName(Win32::GetCwd()), $long);
+use strict;
+use Test;
+use Config qw(%Config);
+use Cwd qw(cwd);
+use Encode qw();
+use Win32;
+
+BEGIN {
+ unless (defined &Win32::BuildNumber && Win32::BuildNumber() >= 820 or $] >= 5.008009) {
+ print "1..0 # Skip: Needs ActivePerl 820 or Perl 5.8.9 or later\n";
+ exit 0;
+ }
+ if ((((Win32::FsType())[1] & 4) == 0) || (Win32::FsType() =~ /^FAT/)) {
+ print "1..0 # Skip: Filesystem doesn't support Unicode\n";
+ exit 0;
+ }
+ unless ((Win32::GetOSVersion())[1] > 4) {
+ print "1..0 # Skip: Unicode support requires Windows 2000 or later\n";
+ exit 0;
+ }
+}
+
+my $home = Win32::GetCwd();
+my $cwd = cwd(); # may be a Cygwin path
+my $dir = "Foo \x{394}\x{419} Bar \x{5E7}\x{645} Baz";
+my $file = "$dir\\xyzzy \x{394}\x{419} plugh \x{5E7}\x{645}";
+
+sub cleanup {
+ chdir($home);
+ my $ansi = Win32::GetANSIPathName($file);
+ unlink($ansi) if -f $ansi;
+ $ansi = Win32::GetANSIPathName($dir);
+ rmdir($ansi) if -d $ansi;
+}
+
+cleanup();
+END { cleanup() }
+
+plan test => 12;
+
+# Create Unicode directory
+Win32::CreateDirectory($dir);
+ok(-d Win32::GetANSIPathName($dir));
+
+# Create Unicode file
+Win32::CreateFile($file);
+ok(-f Win32::GetANSIPathName($file));
+
+# readdir() returns ANSI form of Unicode filename
+ok(opendir(my $dh, Win32::GetANSIPathName($dir)));
+while ($_ = readdir($dh)) {
+ next if /^\./;
+ # On Cygwin 1.7 readdir() returns the utf8 representation of the
+ # filename but doesn't turn on the SvUTF8 bit
+ Encode::_utf8_on($_) if $^O eq "cygwin" && $Config{osvers} !~ /^1.5/;
+ ok($file, Win32::GetLongPathName("$dir\\$_"));
+}
+closedir($dh);
+
+# Win32::GetLongPathName() of the absolute path restores the Unicode dir name
+my $full = Win32::GetFullPathName($dir);
+my $long = Win32::GetLongPathName($full);
+
+ok($long, Win32::GetLongPathName($home)."\\$dir");
+
+# We can Win32::SetCwd() into the Unicode directory
+ok(Win32::SetCwd($dir));
+
+my $w32dir = Win32::GetCwd();
+# cwd() also returns a usable ANSI directory name
+my $subdir = cwd();
+
+# change back to home directory to make sure relative paths
+# in @INC continue to work
+ok(chdir($home));
+ok(Win32::GetCwd(), $home);
+
+ok(Win32::GetLongPathName($w32dir), $long);
+
+# cwd() on Cygwin returns a mapped path that we need to translate
+# back to a Windows path. Invoking `cygpath` on $subdir doesn't work.
+if ($^O eq "cygwin") {
+ $subdir = Cygwin::posix_to_win_path($subdir, 1);
+}
+$subdir =~ s,/,\\,g;
+ok(Win32::GetLongPathName($subdir), $long);
+
+# We can chdir() into the Unicode directory if we use the ANSI name
+ok(chdir(Win32::GetANSIPathName($dir)));
+ok(Win32::GetLongPathName(Win32::GetCwd()), $long);
View Lorry Controller Status