-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.39';
- $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
-
-### 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, undef, $producttype)
- = Win32::GetOSVersion();
- ($cached_os, $cached_desc) = _GetOSName($desc, $major, $minor, $build, $id, $producttype);
- }
- return wantarray ? ($cached_os, $cached_desc) : $cached_os;
-}
-
-sub _GetOSName {
- my($desc, $major, $minor, $build, $id, $producttype) = @_;
-
- my($os,$tag);
- if ($id == 0) {
- $os = "Win32s";
- }
- elsif ($id == 1) {
- $os = { 0 => "95", 10 => "98", 90 => "Me" }->{$minor};
- }
- elsif ($id == 2) {
- if ($major == 3) {
- $os = "NT3.51";
- }
- elsif ($major == 4) {
- $os = "NT4";
- }
- elsif ($major == 5) {
- $os = { 0 => "2000", 1 => "XP/.Net", 2 => "2003" }->{$minor};
- }
- elsif ($major == 6) {
- $os = { 0 => "Vista", 1 => "7" }->{$minor};
- # 2008 is same as Vista but has "Domaincontroller" or "Server" type
- $os = "2008" if $os eq "Vista" && $producttype != 1;
- }
- }
-
- unless (defined $os) {
- warn "Unknown Windows version [$id:$major:$minor]";
- return;
- }
-
- # Take a look at the build numbers and try to deduce
- # the exact release name, but we put that in the $desc
- if ($os eq "95") {
- $tag = { 67109814 => "(a)", 67306684 => "(b1)", "67109975" => "(b2)" }->{$build};
- }
- elsif ($os eq "98" && $build eq "67766446") {
- $tag = "(2nd ed)";
- }
- if ($tag) {
- $desc = length($desc) ? "$tag $desc" : $tag;
- }
-
- 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 Intel processors,
-21064 for the Alpha chip.
-
-=item Win32::GetCwd()
-
-[CORE] Returns the current active drive and directory. This function
-does not return a UNC path, since the functionality required for such
-a feature is not available under Windows 95.
-
-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::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 Vista 2 6 0
- Windows Server 2008 2 6 0
- Windows 7 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 Vista and Windows Server 2008 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
-
-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::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.
-
-Currently the possible values for the OS name are
-
- WinWin32s
- Win95
- Win98
- WinMe
- WinNT3.51
- WinNT4
- Win2000
- WinXP/.Net
- Win2003
- 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::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::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::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;\r
+\r
+BEGIN {\r
+ use strict;\r
+ use vars qw|$VERSION $XS_VERSION @ISA @EXPORT @EXPORT_OK|;\r
+\r
+ require Exporter;\r
+ require DynaLoader;\r
+\r
+ @ISA = qw|Exporter DynaLoader|;\r
+ $VERSION = '0.39';\r
+ $XS_VERSION = $VERSION;\r
+ $VERSION = eval $VERSION;\r
+\r
+ @EXPORT = qw(\r
+ NULL\r
+ WIN31_CLASS\r
+ OWNER_SECURITY_INFORMATION\r
+ GROUP_SECURITY_INFORMATION\r
+ DACL_SECURITY_INFORMATION\r
+ SACL_SECURITY_INFORMATION\r
+ MB_ICONHAND\r
+ MB_ICONQUESTION\r
+ MB_ICONEXCLAMATION\r
+ MB_ICONASTERISK\r
+ MB_ICONWARNING\r
+ MB_ICONERROR\r
+ MB_ICONINFORMATION\r
+ MB_ICONSTOP\r
+ );\r
+ @EXPORT_OK = qw(\r
+ GetOSName\r
+ SW_HIDE\r
+ SW_SHOWNORMAL\r
+ SW_SHOWMINIMIZED\r
+ SW_SHOWMAXIMIZED\r
+ SW_SHOWNOACTIVATE\r
+\r
+ CSIDL_DESKTOP\r
+ CSIDL_PROGRAMS\r
+ CSIDL_PERSONAL\r
+ CSIDL_FAVORITES\r
+ CSIDL_STARTUP\r
+ CSIDL_RECENT\r
+ CSIDL_SENDTO\r
+ CSIDL_STARTMENU\r
+ CSIDL_MYMUSIC\r
+ CSIDL_MYVIDEO\r
+ CSIDL_DESKTOPDIRECTORY\r
+ CSIDL_NETHOOD\r
+ CSIDL_FONTS\r
+ CSIDL_TEMPLATES\r
+ CSIDL_COMMON_STARTMENU\r
+ CSIDL_COMMON_PROGRAMS\r
+ CSIDL_COMMON_STARTUP\r
+ CSIDL_COMMON_DESKTOPDIRECTORY\r
+ CSIDL_APPDATA\r
+ CSIDL_PRINTHOOD\r
+ CSIDL_LOCAL_APPDATA\r
+ CSIDL_COMMON_FAVORITES\r
+ CSIDL_INTERNET_CACHE\r
+ CSIDL_COOKIES\r
+ CSIDL_HISTORY\r
+ CSIDL_COMMON_APPDATA\r
+ CSIDL_WINDOWS\r
+ CSIDL_SYSTEM\r
+ CSIDL_PROGRAM_FILES\r
+ CSIDL_MYPICTURES\r
+ CSIDL_PROFILE\r
+ CSIDL_PROGRAM_FILES_COMMON\r
+ CSIDL_COMMON_TEMPLATES\r
+ CSIDL_COMMON_DOCUMENTS\r
+ CSIDL_COMMON_ADMINTOOLS\r
+ CSIDL_ADMINTOOLS\r
+ CSIDL_COMMON_MUSIC\r
+ CSIDL_COMMON_PICTURES\r
+ CSIDL_COMMON_VIDEO\r
+ CSIDL_RESOURCES\r
+ CSIDL_RESOURCES_LOCALIZED\r
+ CSIDL_CDBURN_AREA\r
+ );\r
+}\r
+\r
+# We won't bother with the constant stuff, too much of a hassle. Just hard\r
+# code it here.\r
+\r
+sub NULL { 0 }\r
+sub WIN31_CLASS { &NULL }\r
+\r
+sub OWNER_SECURITY_INFORMATION { 0x00000001 }\r
+sub GROUP_SECURITY_INFORMATION { 0x00000002 }\r
+sub DACL_SECURITY_INFORMATION { 0x00000004 }\r
+sub SACL_SECURITY_INFORMATION { 0x00000008 }\r
+\r
+sub MB_ICONHAND { 0x00000010 }\r
+sub MB_ICONQUESTION { 0x00000020 }\r
+sub MB_ICONEXCLAMATION { 0x00000030 }\r
+sub MB_ICONASTERISK { 0x00000040 }\r
+sub MB_ICONWARNING { 0x00000030 }\r
+sub MB_ICONERROR { 0x00000010 }\r
+sub MB_ICONINFORMATION { 0x00000040 }\r
+sub MB_ICONSTOP { 0x00000010 }\r
+\r
+#\r
+# Newly added constants. These have an empty prototype, unlike the\r
+# the ones above, which aren't prototyped for compatibility reasons.\r
+#\r
+sub SW_HIDE () { 0 }\r
+sub SW_SHOWNORMAL () { 1 }\r
+sub SW_SHOWMINIMIZED () { 2 }\r
+sub SW_SHOWMAXIMIZED () { 3 }\r
+sub SW_SHOWNOACTIVATE () { 4 }\r
+\r
+sub CSIDL_DESKTOP () { 0x0000 } # <desktop>\r
+sub CSIDL_PROGRAMS () { 0x0002 } # Start Menu\Programs\r
+sub CSIDL_PERSONAL () { 0x0005 } # "My Documents" folder\r
+sub CSIDL_FAVORITES () { 0x0006 } # <user name>\Favorites\r
+sub CSIDL_STARTUP () { 0x0007 } # Start Menu\Programs\Startup\r
+sub CSIDL_RECENT () { 0x0008 } # <user name>\Recent\r
+sub CSIDL_SENDTO () { 0x0009 } # <user name>\SendTo\r
+sub CSIDL_STARTMENU () { 0x000B } # <user name>\Start Menu\r
+sub CSIDL_MYMUSIC () { 0x000D } # "My Music" folder\r
+sub CSIDL_MYVIDEO () { 0x000E } # "My Videos" folder\r
+sub CSIDL_DESKTOPDIRECTORY () { 0x0010 } # <user name>\Desktop\r
+sub CSIDL_NETHOOD () { 0x0013 } # <user name>\nethood\r
+sub CSIDL_FONTS () { 0x0014 } # windows\fonts\r
+sub CSIDL_TEMPLATES () { 0x0015 }\r
+sub CSIDL_COMMON_STARTMENU () { 0x0016 } # All Users\Start Menu\r
+sub CSIDL_COMMON_PROGRAMS () { 0x0017 } # All Users\Start Menu\Programs\r
+sub CSIDL_COMMON_STARTUP () { 0x0018 } # All Users\Startup\r
+sub CSIDL_COMMON_DESKTOPDIRECTORY () { 0x0019 } # All Users\Desktop\r
+sub CSIDL_APPDATA () { 0x001A } # Application Data, new for NT4\r
+sub CSIDL_PRINTHOOD () { 0x001B } # <user name>\PrintHood\r
+sub CSIDL_LOCAL_APPDATA () { 0x001C } # non roaming, user\Local Settings\Application Data\r
+sub CSIDL_COMMON_FAVORITES () { 0x001F }\r
+sub CSIDL_INTERNET_CACHE () { 0x0020 }\r
+sub CSIDL_COOKIES () { 0x0021 }\r
+sub CSIDL_HISTORY () { 0x0022 }\r
+sub CSIDL_COMMON_APPDATA () { 0x0023 } # All Users\Application Data\r
+sub CSIDL_WINDOWS () { 0x0024 } # GetWindowsDirectory()\r
+sub CSIDL_SYSTEM () { 0x0025 } # GetSystemDirectory()\r
+sub CSIDL_PROGRAM_FILES () { 0x0026 } # C:\Program Files\r
+sub CSIDL_MYPICTURES () { 0x0027 } # "My Pictures", new for Win2K\r
+sub CSIDL_PROFILE () { 0x0028 } # USERPROFILE\r
+sub CSIDL_PROGRAM_FILES_COMMON () { 0x002B } # C:\Program Files\Common\r
+sub CSIDL_COMMON_TEMPLATES () { 0x002D } # All Users\Templates\r
+sub CSIDL_COMMON_DOCUMENTS () { 0x002E } # All Users\Documents\r
+sub CSIDL_COMMON_ADMINTOOLS () { 0x002F } # All Users\Start Menu\Programs\Administrative Tools\r
+sub CSIDL_ADMINTOOLS () { 0x0030 } # <user name>\Start Menu\Programs\Administrative Tools\r
+sub CSIDL_COMMON_MUSIC () { 0x0035 } # All Users\My Music\r
+sub CSIDL_COMMON_PICTURES () { 0x0036 } # All Users\My Pictures\r
+sub CSIDL_COMMON_VIDEO () { 0x0037 } # All Users\My Video\r
+sub CSIDL_RESOURCES () { 0x0038 } # %windir%\Resources\, For theme and other windows resources.\r
+sub CSIDL_RESOURCES_LOCALIZED () { 0x0039 } # %windir%\Resources\<LangID>, for theme and other windows specific resources.\r
+sub CSIDL_CDBURN_AREA () { 0x003B } # <user name>\Local Settings\Application Data\Microsoft\CD Burning\r
+\r
+### This method is just a simple interface into GetOSVersion(). More\r
+### specific or demanding situations should use that instead.\r
+\r
+my ($cached_os, $cached_desc);\r
+\r
+sub GetOSName {\r
+ unless (defined $cached_os) {\r
+ my($desc, $major, $minor, $build, $id, undef, undef, undef, $producttype)\r
+ = Win32::GetOSVersion();\r
+ ($cached_os, $cached_desc) = _GetOSName($desc, $major, $minor, $build, $id, $producttype);\r
+ }\r
+ return wantarray ? ($cached_os, $cached_desc) : $cached_os;\r
+}\r
+\r
+sub _GetOSName {\r
+ my($desc, $major, $minor, $build, $id, $producttype) = @_;\r
+\r
+ my($os,$tag);\r
+ if ($id == 0) {\r
+ $os = "Win32s";\r
+ }\r
+ elsif ($id == 1) {\r
+ $os = { 0 => "95", 10 => "98", 90 => "Me" }->{$minor};\r
+ }\r
+ elsif ($id == 2) {\r
+ if ($major == 3) {\r
+ $os = "NT3.51";\r
+ }\r
+ elsif ($major == 4) {\r
+ $os = "NT4";\r
+ }\r
+ elsif ($major == 5) {\r
+ $os = { 0 => "2000", 1 => "XP/.Net", 2 => "2003" }->{$minor};\r
+ }\r
+ elsif ($major == 6) {\r
+ $os = { 0 => "Vista", 1 => "7" }->{$minor};\r
+ # 2008 is same as Vista but has "Domaincontroller" or "Server" type\r
+ $os = "2008" if $os eq "Vista" && $producttype != 1;\r
+ }\r
+ }\r
+\r
+ unless (defined $os) {\r
+ warn "Unknown Windows version [$id:$major:$minor]";\r
+ return;\r
+ }\r
+\r
+ # Take a look at the build numbers and try to deduce\r
+ # the exact release name, but we put that in the $desc\r
+ if ($os eq "95") {\r
+ $tag = { 67109814 => "(a)", 67306684 => "(b1)", "67109975" => "(b2)" }->{$build};\r
+ }\r
+ elsif ($os eq "98" && $build eq "67766446") {\r
+ $tag = "(2nd ed)";\r
+ }\r
+ if ($tag) {\r
+ $desc = length($desc) ? "$tag $desc" : $tag;\r
+ }\r
+\r
+ return ("Win$os", $desc);\r
+}\r
+\r
+# "no warnings 'redefine';" doesn't work for 5.8.7 and earlier\r
+local $^W = 0;\r
+bootstrap Win32;\r
+\r
+1;\r
+\r
+__END__\r
+\r
+=head1 NAME\r
+\r
+Win32 - Interfaces to some Win32 API Functions\r
+\r
+=head1 DESCRIPTION\r
+\r
+The Win32 module contains functions to access Win32 APIs.\r
+\r
+=head2 Alphabetical Listing of Win32 Functions\r
+\r
+It is recommended to C<use Win32;> before any of these functions;\r
+however, for backwards compatibility, those marked as [CORE] will\r
+automatically do this for you.\r
+\r
+In the function descriptions below the term I<Unicode string> is used\r
+to indicate that the string may contain characters outside the system\r
+codepage. The caveat I<If supported by the core Perl version>\r
+generally means Perl 5.8.9 and later, though some Unicode pathname\r
+functionality may work on earlier versions.\r
+\r
+=over\r
+\r
+=item Win32::AbortSystemShutdown(MACHINE)\r
+\r
+Aborts a system shutdown (started by the\r
+InitiateSystemShutdown function) on the specified MACHINE.\r
+\r
+=item Win32::BuildNumber()\r
+\r
+[CORE] Returns the ActivePerl build number. This function is\r
+only available in the ActivePerl binary distribution.\r
+\r
+=item Win32::CopyFile(FROM, TO, OVERWRITE)\r
+\r
+[CORE] The Win32::CopyFile() function copies an existing file to a new\r
+file. All file information like creation time and file attributes will\r
+be copied to the new file. However it will B<not> copy the security\r
+information. If the destination file already exists it will only be\r
+overwritten when the OVERWRITE parameter is true. But even this will\r
+not overwrite a read-only file; you have to unlink() it first\r
+yourself.\r
+\r
+=item Win32::CreateDirectory(DIRECTORY)\r
+\r
+Creates the DIRECTORY and returns a true value on success. Check $^E\r
+on failure for extended error information.\r
+\r
+DIRECTORY may contain Unicode characters outside the system codepage.\r
+Once the directory has been created you can use\r
+Win32::GetANSIPathName() to get a name that can be passed to system\r
+calls and external programs.\r
+\r
+=item Win32::CreateFile(FILE)\r
+\r
+Creates the FILE and returns a true value on success. Check $^E on\r
+failure for extended error information.\r
+\r
+FILE may contain Unicode characters outside the system codepage. Once\r
+the file has been created you can use Win32::GetANSIPathName() to get\r
+a name that can be passed to system calls and external programs.\r
+\r
+=item Win32::DomainName()\r
+\r
+[CORE] Returns the name of the Microsoft Network domain or workgroup\r
+that the owner of the current perl process is logged into. The\r
+"Workstation" service must be running to determine this\r
+information. This function does B<not> work on Windows 9x.\r
+\r
+=item Win32::ExpandEnvironmentStrings(STRING)\r
+\r
+Takes STRING and replaces all referenced environment variable\r
+names with their defined values. References to environment variables\r
+take the form C<%VariableName%>. Case is ignored when looking up the\r
+VariableName in the environment. If the variable is not found then the\r
+original C<%VariableName%> text is retained. Has the same effect\r
+as the following:\r
+\r
+ $string =~ s/%([^%]*)%/$ENV{$1} || "%$1%"/eg\r
+\r
+However, this function may return a Unicode string if the environment\r
+variable being expanded hasn't been assigned to via %ENV. Access\r
+to %ENV is currently always using byte semantics.\r
+\r
+=item Win32::FormatMessage(ERRORCODE)\r
+\r
+[CORE] Converts the supplied Win32 error number (e.g. returned by\r
+Win32::GetLastError()) to a descriptive string. Analogous to the\r
+perror() standard-C library function. Note that C<$^E> used\r
+in a string context has much the same effect.\r
+\r
+ C:\> perl -e "$^E = 26; print $^E;"\r
+ The specified disk or diskette cannot be accessed\r
+\r
+=item Win32::FsType()\r
+\r
+[CORE] Returns the name of the filesystem of the currently active\r
+drive (like 'FAT' or 'NTFS'). In list context it returns three values:\r
+(FSTYPE, FLAGS, MAXCOMPLEN). FSTYPE is the filesystem type as\r
+before. FLAGS is a combination of values of the following table:\r
+\r
+ 0x00000001 supports case-sensitive filenames\r
+ 0x00000002 preserves the case of filenames\r
+ 0x00000004 supports Unicode in filenames\r
+ 0x00000008 preserves and enforces ACLs\r
+ 0x00000010 supports file-based compression\r
+ 0x00000020 supports disk quotas\r
+ 0x00000040 supports sparse files\r
+ 0x00000080 supports reparse points\r
+ 0x00000100 supports remote storage\r
+ 0x00008000 is a compressed volume (e.g. DoubleSpace)\r
+ 0x00010000 supports object identifiers\r
+ 0x00020000 supports the Encrypted File System (EFS)\r
+\r
+MAXCOMPLEN is the maximum length of a filename component (the part\r
+between two backslashes) on this file system.\r
+\r
+=item Win32::FreeLibrary(HANDLE)\r
+\r
+Unloads a previously loaded dynamic-link library. The HANDLE is\r
+no longer valid after this call. See L<LoadLibrary|Win32::LoadLibrary(LIBNAME)>\r
+for information on dynamically loading a library.\r
+\r
+=item Win32::GetANSIPathName(FILENAME)\r
+\r
+Returns an ANSI version of FILENAME. This may be the short name\r
+if the long name cannot be represented in the system codepage.\r
+\r
+While not currently implemented, it is possible that in the future\r
+this function will convert only parts of the path to FILENAME to a\r
+short form.\r
+\r
+If FILENAME doesn't exist on the filesystem, or if the filesystem\r
+doesn't support short ANSI filenames, then this function will\r
+translate the Unicode name into the system codepage using replacement\r
+characters.\r
+\r
+=item Win32::GetArchName()\r
+\r
+Use of this function is deprecated. It is equivalent with\r
+$ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X.\r
+\r
+=item Win32::GetChipName()\r
+\r
+Returns the processor type: 386, 486 or 586 for Intel processors,\r
+21064 for the Alpha chip.\r
+\r
+=item Win32::GetCwd()\r
+\r
+[CORE] Returns the current active drive and directory. This function\r
+does not return a UNC path, since the functionality required for such\r
+a feature is not available under Windows 95.\r
+\r
+If supported by the core Perl version, this function will return an\r
+ANSI path name for the current directory if the long pathname cannot\r
+be represented in the system codepage.\r
+\r
+=item Win32::GetCurrentProcessId()\r
+\r
+Returns the process identifier of the current process. Until the\r
+process terminates, the process identifier uniquely identifies the\r
+process throughout the system.\r
+\r
+The current process identifier is normally also available via the\r
+predefined $$ variable. Under fork() emulation however $$ may contain\r
+a pseudo-process identifier that is only meaningful to the Perl\r
+kill(), wait() and waitpid() functions. The\r
+Win32::GetCurrentProcessId() function will always return the regular\r
+Windows process id, even when called from inside a pseudo-process.\r
+\r
+=item Win32::GetCurrentThreadId()\r
+\r
+Returns the thread identifier of the calling thread. Until the thread\r
+terminates, the thread identifier uniquely identifies the thread\r
+throughout the system.\r
+\r
+=item Win32::GetFileVersion(FILENAME)\r
+\r
+Returns the file version number from the VERSIONINFO resource of\r
+the executable file or DLL. This is a tuple of four 16 bit numbers.\r
+In list context these four numbers will be returned. In scalar context\r
+they are concatenated into a string, separated by dots.\r
+\r
+=item Win32::GetFolderPath(FOLDER [, CREATE])\r
+\r
+Returns the full pathname of one of the Windows special folders.\r
+The folder will be created if it doesn't exist and the optional CREATE\r
+argument is true. The following FOLDER constants are defined by the\r
+Win32 module, but only exported on demand:\r
+\r
+ CSIDL_ADMINTOOLS\r
+ CSIDL_APPDATA\r
+ CSIDL_CDBURN_AREA\r
+ CSIDL_COMMON_ADMINTOOLS\r
+ CSIDL_COMMON_APPDATA\r
+ CSIDL_COMMON_DESKTOPDIRECTORY\r
+ CSIDL_COMMON_DOCUMENTS\r
+ CSIDL_COMMON_FAVORITES\r
+ CSIDL_COMMON_MUSIC\r
+ CSIDL_COMMON_PICTURES\r
+ CSIDL_COMMON_PROGRAMS\r
+ CSIDL_COMMON_STARTMENU\r
+ CSIDL_COMMON_STARTUP\r
+ CSIDL_COMMON_TEMPLATES\r
+ CSIDL_COMMON_VIDEO\r
+ CSIDL_COOKIES\r
+ CSIDL_DESKTOP\r
+ CSIDL_DESKTOPDIRECTORY\r
+ CSIDL_FAVORITES\r
+ CSIDL_FONTS\r
+ CSIDL_HISTORY\r
+ CSIDL_INTERNET_CACHE\r
+ CSIDL_LOCAL_APPDATA\r
+ CSIDL_MYMUSIC\r
+ CSIDL_MYPICTURES\r
+ CSIDL_MYVIDEO\r
+ CSIDL_NETHOOD\r
+ CSIDL_PERSONAL\r
+ CSIDL_PRINTHOOD\r
+ CSIDL_PROFILE\r
+ CSIDL_PROGRAMS\r
+ CSIDL_PROGRAM_FILES\r
+ CSIDL_PROGRAM_FILES_COMMON\r
+ CSIDL_RECENT\r
+ CSIDL_RESOURCES\r
+ CSIDL_RESOURCES_LOCALIZED\r
+ CSIDL_SENDTO\r
+ CSIDL_STARTMENU\r
+ CSIDL_STARTUP\r
+ CSIDL_SYSTEM\r
+ CSIDL_TEMPLATES\r
+ CSIDL_WINDOWS\r
+\r
+Note that not all folders are defined on all versions of Windows.\r
+\r
+Please refer to the MSDN documentation of the CSIDL constants,\r
+currently available at:\r
+\r
+http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/enums/csidl.asp\r
+\r
+This function will return an ANSI folder path if the long name cannot\r
+be represented in the system codepage. Use Win32::GetLongPathName()\r
+on the result of Win32::GetFolderPath() if you want the Unicode\r
+version of the folder name.\r
+\r
+=item Win32::GetFullPathName(FILENAME)\r
+\r
+[CORE] GetFullPathName combines the FILENAME with the current drive\r
+and directory name and returns a fully qualified (aka, absolute)\r
+path name. In list context it returns two elements: (PATH, FILE) where\r
+PATH is the complete pathname component (including trailing backslash)\r
+and FILE is just the filename part. Note that no attempt is made to\r
+convert 8.3 components in the supplied FILENAME to longnames or\r
+vice-versa. Compare with Win32::GetShortPathName() and\r
+Win32::GetLongPathName().\r
+\r
+If supported by the core Perl version, this function will return an\r
+ANSI path name if the full pathname cannot be represented in the\r
+system codepage.\r
+\r
+=item Win32::GetLastError()\r
+\r
+[CORE] Returns the last error value generated by a call to a Win32 API\r
+function. Note that C<$^E> used in a numeric context amounts to the\r
+same value.\r
+\r
+=item Win32::GetLongPathName(PATHNAME)\r
+\r
+[CORE] Returns a representation of PATHNAME composed of longname\r
+components (if any). The result may not necessarily be longer\r
+than PATHNAME. No attempt is made to convert PATHNAME to the\r
+absolute path. Compare with Win32::GetShortPathName() and\r
+Win32::GetFullPathName().\r
+\r
+This function may return the pathname in Unicode if it cannot be\r
+represented in the system codepage. Use Win32::GetANSIPathName()\r
+before passing the path to a system call or another program.\r
+\r
+=item Win32::GetNextAvailDrive()\r
+\r
+[CORE] Returns a string in the form of "<d>:" where <d> is the first\r
+available drive letter.\r
+\r
+=item Win32::GetOSVersion()\r
+\r
+[CORE] Returns the list (STRING, MAJOR, MINOR, BUILD, ID), where the\r
+elements are, respectively: An arbitrary descriptive string, the major\r
+version number of the operating system, the minor version number, the\r
+build number, and a digit indicating the actual operating system.\r
+For the ID, the values are 0 for Win32s, 1 for Windows 9X/Me and 2 for\r
+Windows NT/2000/XP/2003/Vista/2008/7. In scalar context it returns just\r
+the ID.\r
+\r
+Currently known values for ID MAJOR and MINOR are as follows:\r
+\r
+ OS ID MAJOR MINOR\r
+ Win32s 0 - -\r
+ Windows 95 1 4 0\r
+ Windows 98 1 4 10\r
+ Windows Me 1 4 90\r
+ Windows NT 3.51 2 3 51\r
+ Windows NT 4 2 4 0\r
+ Windows 2000 2 5 0\r
+ Windows XP 2 5 1\r
+ Windows Server 2003 2 5 2\r
+ Windows Vista 2 6 0\r
+ Windows Server 2008 2 6 0\r
+ Windows 7 2 6 1\r
+\r
+On Windows NT 4 SP6 and later this function returns the following\r
+additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE.\r
+\r
+The version numbers for Windows Vista and Windows Server 2008 are\r
+identical; the PRODUCTTYPE field must be used to differentiate\r
+between them.\r
+\r
+SPMAJOR and SPMINOR are are the version numbers of the latest\r
+installed service pack.\r
+\r
+SUITEMASK is a bitfield identifying the product suites available on\r
+the system. Known bits are:\r
+\r
+ VER_SUITE_SMALLBUSINESS 0x00000001\r
+ VER_SUITE_ENTERPRISE 0x00000002\r
+ VER_SUITE_BACKOFFICE 0x00000004\r
+ VER_SUITE_COMMUNICATIONS 0x00000008\r
+ VER_SUITE_TERMINAL 0x00000010\r
+ VER_SUITE_SMALLBUSINESS_RESTRICTED 0x00000020\r
+ VER_SUITE_EMBEDDEDNT 0x00000040\r
+ VER_SUITE_DATACENTER 0x00000080\r
+ VER_SUITE_SINGLEUSERTS 0x00000100\r
+ VER_SUITE_PERSONAL 0x00000200\r
+ VER_SUITE_BLADE 0x00000400\r
+ VER_SUITE_EMBEDDED_RESTRICTED 0x00000800\r
+ VER_SUITE_SECURITY_APPLIANCE 0x00001000\r
+\r
+The VER_SUITE_xxx names are listed here to crossreference the Microsoft\r
+documentation. The Win32 module does not provide symbolic names for these\r
+constants.\r
+\r
+PRODUCTTYPE provides additional information about the system. It should\r
+be one of the following integer values:\r
+\r
+ 1 - Workstation (NT 4, 2000 Pro, XP Home, XP Pro, Vista)\r
+ 2 - Domaincontroller\r
+ 3 - Server (2000 Server, Server 2003, Server 2008)\r
+\r
+Note that a server that is also a domain controller is reported as\r
+PRODUCTTYPE 2 (Domaincontroller) and not PRODUCTTYPE 3 (Server).\r
+\r
+=item Win32::GetOSName()\r
+\r
+In scalar context returns the name of the Win32 operating system\r
+being used. In list context returns a two element list of the OS name\r
+and whatever edition information is known about the particular build\r
+(for Win9X boxes) and whatever service packs have been installed.\r
+The latter is roughly equivalent to the first item returned by\r
+GetOSVersion() in list context.\r
+\r
+Currently the possible values for the OS name are\r
+\r
+ WinWin32s\r
+ Win95\r
+ Win98\r
+ WinMe\r
+ WinNT3.51\r
+ WinNT4\r
+ Win2000\r
+ WinXP/.Net\r
+ Win2003\r
+ WinVista\r
+ Win2008\r
+ Win7\r
+\r
+This routine is just a simple interface into GetOSVersion(). More\r
+specific or demanding situations should use that instead. Another\r
+option would be to use POSIX::uname(), however the latter appears to\r
+report only the OS family name and not the specific OS. In scalar\r
+context it returns just the ID.\r
+\r
+The name "WinXP/.Net" is used for historical reasons only, to maintain\r
+backwards compatibility of the Win32 module. Windows .NET Server has\r
+been renamed as Windows 2003 Server before final release and uses a\r
+different major/minor version number than Windows XP.\r
+\r
+Similarly the name "WinWin32s" should have been "Win32s" but has been\r
+kept as-is for backwards compatibility reasons too.\r
+\r
+=item Win32::GetShortPathName(PATHNAME)\r
+\r
+[CORE] Returns a representation of PATHNAME that is composed of short\r
+(8.3) path components where available. For path components where the\r
+file system has not generated the short form the returned path will\r
+use the long form, so this function might still for instance return a\r
+path containing spaces. Returns C<undef> when the PATHNAME does not\r
+exist. Compare with Win32::GetFullPathName() and\r
+Win32::GetLongPathName().\r
+\r
+=item Win32::GetProcAddress(INSTANCE, PROCNAME)\r
+\r
+Returns the address of a function inside a loaded library. The\r
+information about what you can do with this address has been lost in\r
+the mist of time. Use the Win32::API module instead of this deprecated\r
+function.\r
+\r
+=item Win32::GetTickCount()\r
+\r
+[CORE] Returns the number of milliseconds elapsed since the last\r
+system boot. Resolution is limited to system timer ticks (about 10ms\r
+on WinNT and 55ms on Win9X).\r
+\r
+=item Win32::GuidGen()\r
+\r
+Creates a globally unique 128 bit integer that can be used as a\r
+persistent identifier in a distributed setting. To a very high degree\r
+of certainty this function returns a unique value. No other\r
+invocation, on the same or any other system (networked or not), should\r
+return the same value.\r
+\r
+The return value is formatted according to OLE conventions, as groups\r
+of hex digits with surrounding braces. For example:\r
+\r
+ {09531CF1-D0C7-4860-840C-1C8C8735E2AD}\r
+ \r
+=item Win32::InitiateSystemShutdown\r
+\r
+(MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT)\r
+\r
+Shutsdown the specified MACHINE, notifying users with the\r
+supplied MESSAGE, within the specified TIMEOUT interval. Forces\r
+closing of all documents without prompting the user if FORCECLOSE is\r
+true, and reboots the machine if REBOOT is true. This function works\r
+only on WinNT.\r
+\r
+=item Win32::IsAdminUser()\r
+\r
+Returns non zero if the account in whose security context the\r
+current process/thread is running belongs to the local group of\r
+Administrators in the built-in system domain; returns 0 if not.\r
+On Windows Vista it will only return non-zero if the process is\r
+actually running with elevated privileges. Returns C<undef>\r
+and prints a warning if an error occurred. This function always\r
+returns 1 on Win9X.\r
+\r
+=item Win32::IsWinNT()\r
+\r
+[CORE] Returns non zero if the Win32 subsystem is Windows NT.\r
+\r
+=item Win32::IsWin95()\r
+\r
+[CORE] Returns non zero if the Win32 subsystem is Windows 95.\r
+\r
+=item Win32::LoadLibrary(LIBNAME)\r
+\r
+Loads a dynamic link library into memory and returns its module\r
+handle. This handle can be used with Win32::GetProcAddress() and\r
+Win32::FreeLibrary(). This function is deprecated. Use the Win32::API\r
+module instead.\r
+\r
+=item Win32::LoginName()\r
+\r
+[CORE] Returns the username of the owner of the current perl process.\r
+The return value may be a Unicode string.\r
+\r
+=item Win32::LookupAccountName(SYSTEM, ACCOUNT, DOMAIN, SID, SIDTYPE)\r
+\r
+Looks up ACCOUNT on SYSTEM and returns the domain name the SID and\r
+the SID type.\r
+\r
+=item Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE)\r
+\r
+Looks up SID on SYSTEM and returns the account name, domain name,\r
+and the SID type.\r
+\r
+=item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]])\r
+\r
+Create a dialogbox containing MESSAGE. FLAGS specifies the\r
+required icon and buttons according to the following table:\r
+\r
+ 0 = OK\r
+ 1 = OK and Cancel\r
+ 2 = Abort, Retry, and Ignore\r
+ 3 = Yes, No and Cancel\r
+ 4 = Yes and No\r
+ 5 = Retry and Cancel\r
+\r
+ MB_ICONSTOP "X" in a red circle\r
+ MB_ICONQUESTION question mark in a bubble\r
+ MB_ICONEXCLAMATION exclamation mark in a yellow triangle\r
+ MB_ICONINFORMATION "i" in a bubble\r
+\r
+TITLE specifies an optional window title. The default is "Perl".\r
+\r
+The function returns the menu id of the selected push button:\r
+\r
+ 0 Error\r
+\r
+ 1 OK\r
+ 2 Cancel\r
+ 3 Abort\r
+ 4 Retry\r
+ 5 Ignore\r
+ 6 Yes\r
+ 7 No\r
+\r
+=item Win32::NodeName()\r
+\r
+[CORE] Returns the Microsoft Network node-name of the current machine.\r
+\r
+=item Win32::OutputDebugString(STRING)\r
+\r
+Sends a string to the application or system debugger for display.\r
+The function does nothing if there is no active debugger.\r
+\r
+Alternatively one can use the I<Debug Viewer> application to\r
+watch the OutputDebugString() output:\r
+\r
+http://www.microsoft.com/technet/sysinternals/utilities/debugview.mspx\r
+\r
+=item Win32::RegisterServer(LIBRARYNAME)\r
+\r
+Loads the DLL LIBRARYNAME and calls the function DllRegisterServer.\r
+\r
+=item Win32::SetChildShowWindow(SHOWWINDOW)\r
+\r
+[CORE] Sets the I<ShowMode> of child processes started by system().\r
+By default system() will create a new console window for child\r
+processes if Perl itself is not running from a console. Calling\r
+SetChildShowWindow(0) will make these new console windows invisible.\r
+Calling SetChildShowWindow() without arguments reverts system() to the\r
+default behavior. The return value of SetChildShowWindow() is the\r
+previous setting or C<undef>.\r
+\r
+The following symbolic constants for SHOWWINDOW are available\r
+(but not exported) from the Win32 module: SW_HIDE, SW_SHOWNORMAL,\r
+SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED and SW_SHOWNOACTIVATE.\r
+\r
+=item Win32::SetCwd(NEWDIRECTORY)\r
+\r
+[CORE] Sets the current active drive and directory. This function does not\r
+work with UNC paths, since the functionality required to required for\r
+such a feature is not available under Windows 95.\r
+\r
+=item Win32::SetLastError(ERROR)\r
+\r
+[CORE] Sets the value of the last error encountered to ERROR. This is\r
+that value that will be returned by the Win32::GetLastError()\r
+function.\r
+\r
+=item Win32::Sleep(TIME)\r
+\r
+[CORE] Pauses for TIME milliseconds. The timeslices are made available\r
+to other processes and threads.\r
+\r
+=item Win32::Spawn(COMMAND, ARGS, PID)\r
+\r
+[CORE] Spawns a new process using the supplied COMMAND, passing in\r
+arguments in the string ARGS. The pid of the new process is stored in\r
+PID. This function is deprecated. Please use the Win32::Process module\r
+instead.\r
+\r
+=item Win32::UnregisterServer(LIBRARYNAME)\r
+\r
+Loads the DLL LIBRARYNAME and calls the function\r
+DllUnregisterServer.\r
+\r
+=back\r
+\r
+=cut\r
-#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);
-
-#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;
-
- Zero(&sysinfo,1,SYSTEM_INFO);
- GetSystemInfo(&sysinfo);
- /* XXX docs say dwProcessorType is deprecated on NT */
- XSRETURN_IV(sysinfo.dwProcessorType);
-}
-
-XS(w32_GuidGen)
-{
- dXSARGS;
- GUID guid;
- char szGUID[50] = {'\0'};
- HRESULT hr = CoCreateGuid(&guid);
-
- if (SUCCEEDED(hr)) {
- LPOLESTR pStr = NULL;
- 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.
- */
- 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;
-
- wcscpy(wide_path, wstr);
- Safefree(wstr);
- long_path = my_longpathW(wide_path);
- if (long_path) {
- ST(0) = wstr_to_sv(aTHX_ long_path);
- XSRETURN(1);
- }
- }
- else {
- SV *path;
- char tmpbuf[MAX_PATH+1];
- char *pathstr;
- STRLEN len;
-
- path = ST(0);
- pathstr = SvPV(path,len);
- 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 szSourceFile[MAX_PATH+1];
-
- if (items != 3)
- Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
- strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
- 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);
-}
-
-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);
-#ifdef __CYGWIN__
- newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
-#endif
- XSRETURN_YES;
-}
+#include <wctype.h>\r
+#include <windows.h>\r
+#include <shlobj.h>\r
+\r
+#define PERL_NO_GET_CONTEXT\r
+#include "EXTERN.h"\r
+#include "perl.h"\r
+#include "XSUB.h"\r
+\r
+#ifndef countof\r
+# define countof(array) (sizeof (array) / sizeof (*(array)))\r
+#endif\r
+\r
+#define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege"\r
+\r
+#ifndef WC_NO_BEST_FIT_CHARS\r
+# define WC_NO_BEST_FIT_CHARS 0x00000400\r
+#endif\r
+\r
+#define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn)\r
+\r
+typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathA)(HWND, char*, int, BOOL);\r
+typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathW)(HWND, WCHAR*, int, BOOL);\r
+typedef HRESULT (WINAPI *PFNSHGetFolderPathA)(HWND, int, HANDLE, DWORD, LPTSTR);\r
+typedef HRESULT (WINAPI *PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR);\r
+typedef BOOL (WINAPI *PFNCreateEnvironmentBlock)(void**, HANDLE, BOOL);\r
+typedef BOOL (WINAPI *PFNDestroyEnvironmentBlock)(void*);\r
+typedef int (__stdcall *PFNDllRegisterServer)(void);\r
+typedef int (__stdcall *PFNDllUnregisterServer)(void);\r
+typedef DWORD (__stdcall *PFNNetApiBufferFree)(void*);\r
+typedef DWORD (__stdcall *PFNNetWkstaGetInfo)(LPWSTR, DWORD, void*);\r
+\r
+typedef BOOL (__stdcall *PFNOpenProcessToken)(HANDLE, DWORD, HANDLE*);\r
+typedef BOOL (__stdcall *PFNOpenThreadToken)(HANDLE, DWORD, BOOL, HANDLE*);\r
+typedef BOOL (__stdcall *PFNGetTokenInformation)(HANDLE, TOKEN_INFORMATION_CLASS, void*, DWORD, DWORD*);\r
+typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD,\r
+ DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*);\r
+typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);\r
+typedef void* (__stdcall *PFNFreeSid)(PSID);\r
+typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);\r
+\r
+#ifndef CSIDL_MYMUSIC\r
+# define CSIDL_MYMUSIC 0x000D\r
+#endif\r
+#ifndef CSIDL_MYVIDEO\r
+# define CSIDL_MYVIDEO 0x000E\r
+#endif\r
+#ifndef CSIDL_LOCAL_APPDATA\r
+# define CSIDL_LOCAL_APPDATA 0x001C\r
+#endif\r
+#ifndef CSIDL_COMMON_FAVORITES\r
+# define CSIDL_COMMON_FAVORITES 0x001F\r
+#endif\r
+#ifndef CSIDL_INTERNET_CACHE\r
+# define CSIDL_INTERNET_CACHE 0x0020\r
+#endif\r
+#ifndef CSIDL_COOKIES\r
+# define CSIDL_COOKIES 0x0021\r
+#endif\r
+#ifndef CSIDL_HISTORY\r
+# define CSIDL_HISTORY 0x0022\r
+#endif\r
+#ifndef CSIDL_COMMON_APPDATA\r
+# define CSIDL_COMMON_APPDATA 0x0023\r
+#endif\r
+#ifndef CSIDL_WINDOWS\r
+# define CSIDL_WINDOWS 0x0024\r
+#endif\r
+#ifndef CSIDL_PROGRAM_FILES\r
+# define CSIDL_PROGRAM_FILES 0x0026\r
+#endif\r
+#ifndef CSIDL_MYPICTURES\r
+# define CSIDL_MYPICTURES 0x0027\r
+#endif\r
+#ifndef CSIDL_PROFILE\r
+# define CSIDL_PROFILE 0x0028\r
+#endif\r
+#ifndef CSIDL_PROGRAM_FILES_COMMON\r
+# define CSIDL_PROGRAM_FILES_COMMON 0x002B\r
+#endif\r
+#ifndef CSIDL_COMMON_TEMPLATES\r
+# define CSIDL_COMMON_TEMPLATES 0x002D\r
+#endif\r
+#ifndef CSIDL_COMMON_DOCUMENTS\r
+# define CSIDL_COMMON_DOCUMENTS 0x002E\r
+#endif\r
+#ifndef CSIDL_COMMON_ADMINTOOLS\r
+# define CSIDL_COMMON_ADMINTOOLS 0x002F\r
+#endif\r
+#ifndef CSIDL_ADMINTOOLS\r
+# define CSIDL_ADMINTOOLS 0x0030\r
+#endif\r
+#ifndef CSIDL_COMMON_MUSIC\r
+# define CSIDL_COMMON_MUSIC 0x0035\r
+#endif\r
+#ifndef CSIDL_COMMON_PICTURES\r
+# define CSIDL_COMMON_PICTURES 0x0036\r
+#endif\r
+#ifndef CSIDL_COMMON_VIDEO\r
+# define CSIDL_COMMON_VIDEO 0x0037\r
+#endif\r
+#ifndef CSIDL_CDBURN_AREA\r
+# define CSIDL_CDBURN_AREA 0x003B\r
+#endif\r
+#ifndef CSIDL_FLAG_CREATE\r
+# define CSIDL_FLAG_CREATE 0x8000\r
+#endif\r
+\r
+/* Use explicit struct definition because wSuiteMask and\r
+ * wProductType are not defined in the VC++ 6.0 headers.\r
+ * WORD type has been replaced by unsigned short because\r
+ * WORD is already used by Perl itself.\r
+ */\r
+struct {\r
+ DWORD dwOSVersionInfoSize;\r
+ DWORD dwMajorVersion;\r
+ DWORD dwMinorVersion;\r
+ DWORD dwBuildNumber;\r
+ DWORD dwPlatformId;\r
+ CHAR szCSDVersion[128];\r
+ unsigned short wServicePackMajor;\r
+ unsigned short wServicePackMinor;\r
+ unsigned short wSuiteMask;\r
+ BYTE wProductType;\r
+ BYTE wReserved;\r
+} g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0};\r
+BOOL g_osver_ex = TRUE;\r
+\r
+#define ONE_K_BUFSIZE 1024\r
+\r
+int\r
+IsWin95(void)\r
+{\r
+ return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);\r
+}\r
+\r
+int\r
+IsWinNT(void)\r
+{\r
+ return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);\r
+}\r
+\r
+int\r
+IsWin2000(void)\r
+{\r
+ return (g_osver.dwMajorVersion > 4);\r
+}\r
+\r
+/* Convert SV to wide character string. The return value must be\r
+ * freed using Safefree().\r
+ */\r
+WCHAR*\r
+sv_to_wstr(pTHX_ SV *sv)\r
+{\r
+ DWORD wlen;\r
+ WCHAR *wstr;\r
+ STRLEN len;\r
+ char *str = SvPV(sv, len);\r
+ UINT cp = SvUTF8(sv) ? CP_UTF8 : CP_ACP;\r
+\r
+ wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0);\r
+ New(0, wstr, wlen, WCHAR);\r
+ MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen);\r
+\r
+ return wstr;\r
+}\r
+\r
+/* Convert wide character string to mortal SV. Use UTF8 encoding\r
+ * if the string cannot be represented in the system codepage.\r
+ */\r
+SV *\r
+wstr_to_sv(pTHX_ WCHAR *wstr)\r
+{\r
+ int wlen = (int)wcslen(wstr)+1;\r
+ BOOL use_default = FALSE;\r
+ int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, NULL, 0, NULL, NULL);\r
+ SV *sv = sv_2mortal(newSV(len));\r
+\r
+ len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, SvPVX(sv), len, NULL, &use_default);\r
+ if (use_default) {\r
+ len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, NULL, 0, NULL, NULL);\r
+ sv_grow(sv, len);\r
+ len = WideCharToMultiByte(CP_UTF8, 0, wstr, wlen, SvPVX(sv), len, NULL, NULL);\r
+ SvUTF8_on(sv);\r
+ }\r
+ /* Shouldn't really ever fail since we ask for the required length first, but who knows... */\r
+ if (len) {\r
+ SvPOK_on(sv);\r
+ SvCUR_set(sv, len-1);\r
+ }\r
+ return sv;\r
+}\r
+\r
+/* Retrieve a variable from the Unicode environment in a mortal SV.\r
+ *\r
+ * Recreates the Unicode environment because a bug in earlier Perl versions\r
+ * overwrites it with the ANSI version, which contains replacement\r
+ * characters for the characters not in the ANSI codepage.\r
+ */\r
+SV*\r
+get_unicode_env(pTHX_ WCHAR *name)\r
+{\r
+ SV *sv = NULL;\r
+ void *env;\r
+ HANDLE token;\r
+ HMODULE module;\r
+ PFNOpenProcessToken pfnOpenProcessToken;\r
+\r
+ /* Get security token for the current process owner */\r
+ module = LoadLibrary("advapi32.dll");\r
+ if (!module)\r
+ return NULL;\r
+\r
+ GETPROC(OpenProcessToken);\r
+\r
+ if (pfnOpenProcessToken == NULL ||\r
+ !pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY | TOKEN_DUPLICATE, &token))\r
+ {\r
+ FreeLibrary(module);\r
+ return NULL;\r
+ }\r
+ FreeLibrary(module);\r
+\r
+ /* Create a Unicode environment block for this process */\r
+ module = LoadLibrary("userenv.dll");\r
+ if (module) {\r
+ PFNCreateEnvironmentBlock pfnCreateEnvironmentBlock;\r
+ PFNDestroyEnvironmentBlock pfnDestroyEnvironmentBlock;\r
+\r
+ GETPROC(CreateEnvironmentBlock);\r
+ GETPROC(DestroyEnvironmentBlock);\r
+\r
+ if (pfnCreateEnvironmentBlock && pfnDestroyEnvironmentBlock &&\r
+ pfnCreateEnvironmentBlock(&env, token, FALSE))\r
+ {\r
+ size_t name_len = wcslen(name);\r
+ WCHAR *entry = env;\r
+ while (*entry) {\r
+ size_t i;\r
+ size_t entry_len = wcslen(entry);\r
+ BOOL equal = (entry_len > name_len) && (entry[name_len] == '=');\r
+\r
+ for (i=0; equal && i < name_len; ++i)\r
+ equal = (towupper(entry[i]) == towupper(name[i]));\r
+\r
+ if (equal) {\r
+ sv = wstr_to_sv(aTHX_ entry+name_len+1);\r
+ break;\r
+ }\r
+ entry += entry_len+1;\r
+ }\r
+ pfnDestroyEnvironmentBlock(env);\r
+ }\r
+ FreeLibrary(module);\r
+ }\r
+ CloseHandle(token);\r
+ return sv;\r
+}\r
+\r
+/* Define both an ANSI and a Wide version of win32_longpath */\r
+\r
+#define CHAR_T char\r
+#define WIN32_FIND_DATA_T WIN32_FIND_DATAA\r
+#define FN_FINDFIRSTFILE FindFirstFileA\r
+#define FN_STRLEN strlen\r
+#define FN_STRCPY strcpy\r
+#define LONGPATH my_longpathA\r
+#include "longpath.inc"\r
+\r
+#define CHAR_T WCHAR\r
+#define WIN32_FIND_DATA_T WIN32_FIND_DATAW\r
+#define FN_FINDFIRSTFILE FindFirstFileW\r
+#define FN_STRLEN wcslen\r
+#define FN_STRCPY wcscpy\r
+#define LONGPATH my_longpathW\r
+#include "longpath.inc"\r
+\r
+/* The my_ansipath() function takes a Unicode filename and converts it\r
+ * into the current Windows codepage. If some characters cannot be mapped,\r
+ * then it will convert the short name instead.\r
+ *\r
+ * The buffer to the ansi pathname must be freed with Safefree() when it\r
+ * it no longer needed.\r
+ *\r
+ * The argument to my_ansipath() must exist before this function is\r
+ * called; otherwise there is no way to determine the short path name.\r
+ *\r
+ * Ideas for future refinement:\r
+ * - Only convert those segments of the path that are not in the current\r
+ * codepage, but leave the other segments in their long form.\r
+ * - If the resulting name is longer than MAX_PATH, start converting\r
+ * additional path segments into short names until the full name\r
+ * is shorter than MAX_PATH. Shorten the filename part last!\r
+ */\r
+\r
+/* This is a modified version of core Perl win32/win32.c(win32_ansipath).\r
+ * It uses New() etc. instead of win32_malloc().\r
+ */\r
+\r
+char *\r
+my_ansipath(const WCHAR *widename)\r
+{\r
+ char *name;\r
+ BOOL use_default = FALSE;\r
+ int widelen = (int)wcslen(widename)+1;\r
+ int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,\r
+ NULL, 0, NULL, NULL);\r
+ New(0, name, len, char);\r
+ WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,\r
+ name, len, NULL, &use_default);\r
+ if (use_default) {\r
+ DWORD shortlen = GetShortPathNameW(widename, NULL, 0);\r
+ if (shortlen) {\r
+ WCHAR *shortname;\r
+ New(0, shortname, shortlen, WCHAR);\r
+ shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;\r
+\r
+ len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,\r
+ NULL, 0, NULL, NULL);\r
+ Renew(name, len, char);\r
+ WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,\r
+ name, len, NULL, NULL);\r
+ Safefree(shortname);\r
+ }\r
+ }\r
+ return name;\r
+}\r
+\r
+/* Convert wide character path to ANSI path and return as mortal SV. */\r
+SV*\r
+wstr_to_ansipath(pTHX_ WCHAR *wstr)\r
+{\r
+ char *ansi = my_ansipath(wstr);\r
+ SV *sv = sv_2mortal(newSVpvn(ansi, strlen(ansi)));\r
+ Safefree(ansi);\r
+ return sv;\r
+}\r
+\r
+#ifdef __CYGWIN__\r
+\r
+char*\r
+get_childdir(void)\r
+{\r
+ dTHX;\r
+ char* ptr;\r
+\r
+ if (IsWin2000()) {\r
+ WCHAR filename[MAX_PATH+1];\r
+ GetCurrentDirectoryW(MAX_PATH+1, filename);\r
+ ptr = my_ansipath(filename);\r
+ }\r
+ else {\r
+ char filename[MAX_PATH+1];\r
+ GetCurrentDirectoryA(MAX_PATH+1, filename);\r
+ New(0, ptr, strlen(filename)+1, char);\r
+ strcpy(ptr, filename);\r
+ }\r
+ return ptr;\r
+}\r
+\r
+void\r
+free_childdir(char *d)\r
+{\r
+ dTHX;\r
+ Safefree(d);\r
+}\r
+\r
+void*\r
+get_childenv(void)\r
+{\r
+ return NULL;\r
+}\r
+\r
+void\r
+free_childenv(void *d)\r
+{\r
+}\r
+\r
+# define PerlDir_mapA(dir) (dir)\r
+\r
+#endif\r
+\r
+XS(w32_ExpandEnvironmentStrings)\r
+{\r
+ dXSARGS;\r
+\r
+ if (items != 1)\r
+ croak("usage: Win32::ExpandEnvironmentStrings($String);\n");\r
+\r
+ if (IsWin2000()) {\r
+ WCHAR value[31*1024];\r
+ WCHAR *source = sv_to_wstr(aTHX_ ST(0));\r
+ ExpandEnvironmentStringsW(source, value, countof(value)-1);\r
+ ST(0) = wstr_to_sv(aTHX_ value);\r
+ Safefree(source);\r
+ XSRETURN(1);\r
+ }\r
+ else {\r
+ char value[31*1024];\r
+ ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), value, countof(value)-2);\r
+ XSRETURN_PV(value);\r
+ }\r
+}\r
+\r
+XS(w32_IsAdminUser)\r
+{\r
+ dXSARGS;\r
+ HMODULE module;\r
+ PFNIsUserAnAdmin pfnIsUserAnAdmin;\r
+ PFNOpenThreadToken pfnOpenThreadToken;\r
+ PFNOpenProcessToken pfnOpenProcessToken;\r
+ PFNGetTokenInformation pfnGetTokenInformation;\r
+ PFNAllocateAndInitializeSid pfnAllocateAndInitializeSid;\r
+ PFNEqualSid pfnEqualSid;\r
+ PFNFreeSid pfnFreeSid;\r
+ HANDLE hTok;\r
+ DWORD dwTokInfoLen;\r
+ TOKEN_GROUPS *lpTokInfo;\r
+ SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY;\r
+ PSID pAdminSid;\r
+ int iRetVal;\r
+ unsigned int i;\r
+\r
+ if (items)\r
+ croak("usage: Win32::IsAdminUser()");\r
+\r
+ /* There is no concept of "Administrator" user accounts on Win9x systems,\r
+ so just return true. */\r
+ if (IsWin95())\r
+ XSRETURN_YES;\r
+\r
+ /* Use IsUserAnAdmin() when available. On Vista this will only return TRUE\r
+ * if the process is running with elevated privileges and not just when the\r
+ * process owner is a member of the "Administrators" group.\r
+ */\r
+ module = LoadLibrary("shell32.dll");\r
+ if (module) {\r
+ GETPROC(IsUserAnAdmin);\r
+ if (pfnIsUserAnAdmin) {\r
+ EXTEND(SP, 1);\r
+ ST(0) = sv_2mortal(newSViv(pfnIsUserAnAdmin() ? 1 : 0));\r
+ FreeLibrary(module);\r
+ XSRETURN(1);\r
+ }\r
+ FreeLibrary(module);\r
+ }\r
+\r
+ module = LoadLibrary("advapi32.dll");\r
+ if (!module) {\r
+ warn("Cannot load advapi32.dll library");\r
+ XSRETURN_UNDEF;\r
+ }\r
+\r
+ GETPROC(OpenThreadToken);\r
+ GETPROC(OpenProcessToken);\r
+ GETPROC(GetTokenInformation);\r
+ GETPROC(AllocateAndInitializeSid);\r
+ GETPROC(EqualSid);\r
+ GETPROC(FreeSid);\r
+\r
+ if (!(pfnOpenThreadToken && pfnOpenProcessToken &&\r
+ pfnGetTokenInformation && pfnAllocateAndInitializeSid &&\r
+ pfnEqualSid && pfnFreeSid))\r
+ {\r
+ warn("Cannot load functions from advapi32.dll library");\r
+ FreeLibrary(module);\r
+ XSRETURN_UNDEF;\r
+ }\r
+\r
+ if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {\r
+ if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {\r
+ warn("Cannot open thread token or process token");\r
+ FreeLibrary(module);\r
+ XSRETURN_UNDEF;\r
+ }\r
+ }\r
+\r
+ pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);\r
+ if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {\r
+ warn("Cannot allocate token information structure");\r
+ CloseHandle(hTok);\r
+ FreeLibrary(module);\r
+ XSRETURN_UNDEF;\r
+ }\r
+\r
+ if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,\r
+ &dwTokInfoLen))\r
+ {\r
+ warn("Cannot get token information");\r
+ Safefree(lpTokInfo);\r
+ CloseHandle(hTok);\r
+ FreeLibrary(module);\r
+ XSRETURN_UNDEF;\r
+ }\r
+\r
+ if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,\r
+ DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))\r
+ {\r
+ warn("Cannot allocate administrators' SID");\r
+ Safefree(lpTokInfo);\r
+ CloseHandle(hTok);\r
+ FreeLibrary(module);\r
+ XSRETURN_UNDEF;\r
+ }\r
+\r
+ iRetVal = 0;\r
+ for (i = 0; i < lpTokInfo->GroupCount; ++i) {\r
+ if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {\r
+ iRetVal = 1;\r
+ break;\r
+ }\r
+ }\r
+\r
+ pfnFreeSid(pAdminSid);\r
+ Safefree(lpTokInfo);\r
+ CloseHandle(hTok);\r
+ FreeLibrary(module);\r
+\r
+ EXTEND(SP, 1);\r
+ ST(0) = sv_2mortal(newSViv(iRetVal));\r
+ XSRETURN(1);\r
+}\r
+\r
+XS(w32_LookupAccountName)\r
+{\r
+ dXSARGS;\r
+ char SID[400];\r
+ DWORD SIDLen;\r
+ SID_NAME_USE snu;\r
+ char Domain[256];\r
+ DWORD DomLen;\r
+ BOOL bResult;\r
+\r
+ if (items != 5)\r
+ croak("usage: Win32::LookupAccountName($system, $account, $domain, "\r
+ "$sid, $sidtype);\n");\r
+\r
+ SIDLen = sizeof(SID);\r
+ DomLen = sizeof(Domain);\r
+\r
+ bResult = LookupAccountNameA(SvPV_nolen(ST(0)), /* System */\r
+ SvPV_nolen(ST(1)), /* Account name */\r
+ &SID, /* SID structure */\r
+ &SIDLen, /* Size of SID buffer */\r
+ Domain, /* Domain buffer */\r
+ &DomLen, /* Domain buffer size */\r
+ &snu); /* SID name type */\r
+ if (bResult) {\r
+ sv_setpv(ST(2), Domain);\r
+ sv_setpvn(ST(3), SID, SIDLen);\r
+ sv_setiv(ST(4), snu);\r
+ XSRETURN_YES;\r
+ }\r
+ XSRETURN_NO;\r
+}\r
+\r
+\r
+XS(w32_LookupAccountSID)\r
+{\r
+ dXSARGS;\r
+ PSID sid;\r
+ char Account[256];\r
+ DWORD AcctLen = sizeof(Account);\r
+ char Domain[256];\r
+ DWORD DomLen = sizeof(Domain);\r
+ SID_NAME_USE snu;\r
+ BOOL bResult;\r
+\r
+ if (items != 5)\r
+ croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");\r
+\r
+ sid = SvPV_nolen(ST(1));\r
+ if (IsValidSid(sid)) {\r
+ bResult = LookupAccountSidA(SvPV_nolen(ST(0)), /* System */\r
+ sid, /* SID structure */\r
+ Account, /* Account name buffer */\r
+ &AcctLen, /* name buffer length */\r
+ Domain, /* Domain buffer */\r
+ &DomLen, /* Domain buffer length */\r
+ &snu); /* SID name type */\r
+ if (bResult) {\r
+ sv_setpv(ST(2), Account);\r
+ sv_setpv(ST(3), Domain);\r
+ sv_setiv(ST(4), (IV)snu);\r
+ XSRETURN_YES;\r
+ }\r
+ }\r
+ XSRETURN_NO;\r
+}\r
+\r
+XS(w32_InitiateSystemShutdown)\r
+{\r
+ dXSARGS;\r
+ HANDLE hToken; /* handle to process token */\r
+ TOKEN_PRIVILEGES tkp; /* pointer to token structure */\r
+ BOOL bRet;\r
+ char *machineName, *message;\r
+\r
+ if (items != 5)\r
+ croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "\r
+ "$timeOut, $forceClose, $reboot);\n");\r
+\r
+ machineName = SvPV_nolen(ST(0));\r
+\r
+ if (OpenProcessToken(GetCurrentProcess(),\r
+ TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,\r
+ &hToken))\r
+ {\r
+ LookupPrivilegeValueA(machineName,\r
+ SE_SHUTDOWN_NAMEA,\r
+ &tkp.Privileges[0].Luid);\r
+\r
+ tkp.PrivilegeCount = 1; /* only setting one */\r
+ tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;\r
+\r
+ /* Get shutdown privilege for this process. */\r
+ AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,\r
+ (PTOKEN_PRIVILEGES)NULL, 0);\r
+ }\r
+\r
+ message = SvPV_nolen(ST(1));\r
+ bRet = InitiateSystemShutdownA(machineName, message, (DWORD)SvIV(ST(2)),\r
+ (BOOL)SvIV(ST(3)), (BOOL)SvIV(ST(4)));\r
+\r
+ /* Disable shutdown privilege. */\r
+ tkp.Privileges[0].Attributes = 0; \r
+ AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,\r
+ (PTOKEN_PRIVILEGES)NULL, 0); \r
+ CloseHandle(hToken);\r
+ XSRETURN_IV(bRet);\r
+}\r
+\r
+XS(w32_AbortSystemShutdown)\r
+{\r
+ dXSARGS;\r
+ HANDLE hToken; /* handle to process token */\r
+ TOKEN_PRIVILEGES tkp; /* pointer to token structure */\r
+ BOOL bRet;\r
+ char *machineName;\r
+\r
+ if (items != 1)\r
+ croak("usage: Win32::AbortSystemShutdown($machineName);\n");\r
+\r
+ machineName = SvPV_nolen(ST(0));\r
+\r
+ if (OpenProcessToken(GetCurrentProcess(),\r
+ TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,\r
+ &hToken))\r
+ {\r
+ LookupPrivilegeValueA(machineName,\r
+ SE_SHUTDOWN_NAMEA,\r
+ &tkp.Privileges[0].Luid);\r
+\r
+ tkp.PrivilegeCount = 1; /* only setting one */\r
+ tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;\r
+\r
+ /* Get shutdown privilege for this process. */\r
+ AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,\r
+ (PTOKEN_PRIVILEGES)NULL, 0);\r
+ }\r
+\r
+ bRet = AbortSystemShutdownA(machineName);\r
+\r
+ /* Disable shutdown privilege. */\r
+ tkp.Privileges[0].Attributes = 0;\r
+ AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,\r
+ (PTOKEN_PRIVILEGES)NULL, 0);\r
+ CloseHandle(hToken);\r
+ XSRETURN_IV(bRet);\r
+}\r
+\r
+\r
+XS(w32_MsgBox)\r
+{\r
+ dXSARGS;\r
+ DWORD flags = MB_ICONEXCLAMATION;\r
+ I32 result;\r
+\r
+ if (items < 1 || items > 3)\r
+ croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");\r
+\r
+ if (items > 1)\r
+ flags = (DWORD)SvIV(ST(1));\r
+\r
+ if (IsWin2000()) {\r
+ WCHAR *title = NULL;\r
+ WCHAR *msg = sv_to_wstr(aTHX_ ST(0));\r
+ if (items > 2)\r
+ title = sv_to_wstr(aTHX_ ST(2));\r
+ result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags);\r
+ Safefree(msg);\r
+ if (title)\r
+ Safefree(title);\r
+ }\r
+ else {\r
+ char *title = "Perl";\r
+ char *msg = SvPV_nolen(ST(0));\r
+ if (items > 2)\r
+ title = SvPV_nolen(ST(2));\r
+ result = MessageBoxA(GetActiveWindow(), msg, title, flags);\r
+ }\r
+ XSRETURN_IV(result);\r
+}\r
+\r
+XS(w32_LoadLibrary)\r
+{\r
+ dXSARGS;\r
+ HANDLE hHandle;\r
+\r
+ if (items != 1)\r
+ croak("usage: Win32::LoadLibrary($libname)\n");\r
+ hHandle = LoadLibraryA(SvPV_nolen(ST(0)));\r
+#ifdef _WIN64\r
+ XSRETURN_IV((DWORD_PTR)hHandle);\r
+#else\r
+ XSRETURN_IV((DWORD)hHandle);\r
+#endif\r
+}\r
+\r
+XS(w32_FreeLibrary)\r
+{\r
+ dXSARGS;\r
+\r
+ if (items != 1)\r
+ croak("usage: Win32::FreeLibrary($handle)\n");\r
+ if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {\r
+ XSRETURN_YES;\r
+ }\r
+ XSRETURN_NO;\r
+}\r
+\r
+XS(w32_GetProcAddress)\r
+{\r
+ dXSARGS;\r
+\r
+ if (items != 2)\r
+ croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");\r
+ XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));\r
+}\r
+\r
+XS(w32_RegisterServer)\r
+{\r
+ dXSARGS;\r
+ BOOL result = FALSE;\r
+ HMODULE module;\r
+\r
+ if (items != 1)\r
+ croak("usage: Win32::RegisterServer($libname)\n");\r
+\r
+ module = LoadLibraryA(SvPV_nolen(ST(0)));\r
+ if (module) {\r
+ PFNDllRegisterServer pfnDllRegisterServer;\r
+ GETPROC(DllRegisterServer);\r
+ if (pfnDllRegisterServer && pfnDllRegisterServer() == 0)\r
+ result = TRUE;\r
+ FreeLibrary(module);\r
+ }\r
+ ST(0) = boolSV(result);\r
+ XSRETURN(1);\r
+}\r
+\r
+XS(w32_UnregisterServer)\r
+{\r
+ dXSARGS;\r
+ BOOL result = FALSE;\r
+ HINSTANCE module;\r
+\r
+ if (items != 1)\r
+ croak("usage: Win32::UnregisterServer($libname)\n");\r
+\r
+ module = LoadLibraryA(SvPV_nolen(ST(0)));\r
+ if (module) {\r
+ PFNDllUnregisterServer pfnDllUnregisterServer;\r
+ GETPROC(DllUnregisterServer);\r
+ if (pfnDllUnregisterServer && pfnDllUnregisterServer() == 0)\r
+ result = TRUE;\r
+ FreeLibrary(module);\r
+ }\r
+ ST(0) = boolSV(result);\r
+ XSRETURN(1);\r
+}\r
+\r
+/* XXX rather bogus */\r
+XS(w32_GetArchName)\r
+{\r
+ dXSARGS;\r
+ XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));\r
+}\r
+\r
+XS(w32_GetChipName)\r
+{\r
+ dXSARGS;\r
+ SYSTEM_INFO sysinfo;\r
+\r
+ Zero(&sysinfo,1,SYSTEM_INFO);\r
+ GetSystemInfo(&sysinfo);\r
+ /* XXX docs say dwProcessorType is deprecated on NT */\r
+ XSRETURN_IV(sysinfo.dwProcessorType);\r
+}\r
+\r
+XS(w32_GuidGen)\r
+{\r
+ dXSARGS;\r
+ GUID guid;\r
+ char szGUID[50] = {'\0'};\r
+ HRESULT hr = CoCreateGuid(&guid);\r
+\r
+ if (SUCCEEDED(hr)) {\r
+ LPOLESTR pStr = NULL;\r
+ if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {\r
+ WideCharToMultiByte(CP_ACP, 0, pStr, (int)wcslen(pStr), szGUID,\r
+ sizeof(szGUID), NULL, NULL);\r
+ CoTaskMemFree(pStr);\r
+ XSRETURN_PV(szGUID);\r
+ }\r
+ }\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_GetFolderPath)\r
+{\r
+ dXSARGS;\r
+ char path[MAX_PATH+1];\r
+ WCHAR wpath[MAX_PATH+1];\r
+ int folder;\r
+ int create = 0;\r
+ HMODULE module;\r
+\r
+ if (items != 1 && items != 2)\r
+ croak("usage: Win32::GetFolderPath($csidl [, $create])\n");\r
+\r
+ folder = (int)SvIV(ST(0));\r
+ if (items == 2)\r
+ create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;\r
+\r
+ module = LoadLibrary("shfolder.dll");\r
+ if (module) {\r
+ PFNSHGetFolderPathA pfna;\r
+ if (IsWin2000()) {\r
+ PFNSHGetFolderPathW pfnw;\r
+ pfnw = (PFNSHGetFolderPathW)GetProcAddress(module, "SHGetFolderPathW");\r
+ if (pfnw && SUCCEEDED(pfnw(NULL, folder|create, NULL, 0, wpath))) {\r
+ FreeLibrary(module);\r
+ ST(0) = wstr_to_ansipath(aTHX_ wpath);\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+ pfna = (PFNSHGetFolderPathA)GetProcAddress(module, "SHGetFolderPathA");\r
+ if (pfna && SUCCEEDED(pfna(NULL, folder|create, NULL, 0, path))) {\r
+ FreeLibrary(module);\r
+ XSRETURN_PV(path);\r
+ }\r
+ FreeLibrary(module);\r
+ }\r
+\r
+ module = LoadLibrary("shell32.dll");\r
+ if (module) {\r
+ PFNSHGetSpecialFolderPathA pfna;\r
+ if (IsWin2000()) {\r
+ PFNSHGetSpecialFolderPathW pfnw;\r
+ pfnw = (PFNSHGetSpecialFolderPathW)GetProcAddress(module, "SHGetSpecialFolderPathW");\r
+ if (pfnw && pfnw(NULL, wpath, folder, !!create)) {\r
+ FreeLibrary(module);\r
+ ST(0) = wstr_to_ansipath(aTHX_ wpath);\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+ pfna = (PFNSHGetSpecialFolderPathA)GetProcAddress(module, "SHGetSpecialFolderPathA");\r
+ if (pfna && pfna(NULL, path, folder, !!create)) {\r
+ FreeLibrary(module);\r
+ XSRETURN_PV(path);\r
+ }\r
+ FreeLibrary(module);\r
+ }\r
+\r
+ /* SHGetFolderPathW() and SHGetSpecialFolderPathW() may fail on older\r
+ * Perl versions that have replaced the Unicode environment with an\r
+ * ANSI version. Let's go spelunking in the registry now...\r
+ */\r
+ if (IsWin2000()) {\r
+ SV *sv;\r
+ HKEY hkey;\r
+ HKEY root = HKEY_CURRENT_USER;\r
+ WCHAR *name = NULL;\r
+\r
+ switch (folder) {\r
+ case CSIDL_ADMINTOOLS: name = L"Administrative Tools"; break;\r
+ case CSIDL_APPDATA: name = L"AppData"; break;\r
+ case CSIDL_CDBURN_AREA: name = L"CD Burning"; break;\r
+ case CSIDL_COOKIES: name = L"Cookies"; break;\r
+ case CSIDL_DESKTOP:\r
+ case CSIDL_DESKTOPDIRECTORY: name = L"Desktop"; break;\r
+ case CSIDL_FAVORITES: name = L"Favorites"; break;\r
+ case CSIDL_FONTS: name = L"Fonts"; break;\r
+ case CSIDL_HISTORY: name = L"History"; break;\r
+ case CSIDL_INTERNET_CACHE: name = L"Cache"; break;\r
+ case CSIDL_LOCAL_APPDATA: name = L"Local AppData"; break;\r
+ case CSIDL_MYMUSIC: name = L"My Music"; break;\r
+ case CSIDL_MYPICTURES: name = L"My Pictures"; break;\r
+ case CSIDL_MYVIDEO: name = L"My Video"; break;\r
+ case CSIDL_NETHOOD: name = L"NetHood"; break;\r
+ case CSIDL_PERSONAL: name = L"Personal"; break;\r
+ case CSIDL_PRINTHOOD: name = L"PrintHood"; break;\r
+ case CSIDL_PROGRAMS: name = L"Programs"; break;\r
+ case CSIDL_RECENT: name = L"Recent"; break;\r
+ case CSIDL_SENDTO: name = L"SendTo"; break;\r
+ case CSIDL_STARTMENU: name = L"Start Menu"; break;\r
+ case CSIDL_STARTUP: name = L"Startup"; break;\r
+ case CSIDL_TEMPLATES: name = L"Templates"; break;\r
+ /* XXX L"Local Settings" */\r
+ }\r
+\r
+ if (!name) {\r
+ root = HKEY_LOCAL_MACHINE;\r
+ switch (folder) {\r
+ case CSIDL_COMMON_ADMINTOOLS: name = L"Common Administrative Tools"; break;\r
+ case CSIDL_COMMON_APPDATA: name = L"Common AppData"; break;\r
+ case CSIDL_COMMON_DESKTOPDIRECTORY: name = L"Common Desktop"; break;\r
+ case CSIDL_COMMON_DOCUMENTS: name = L"Common Documents"; break;\r
+ case CSIDL_COMMON_FAVORITES: name = L"Common Favorites"; break;\r
+ case CSIDL_COMMON_PROGRAMS: name = L"Common Programs"; break;\r
+ case CSIDL_COMMON_STARTMENU: name = L"Common Start Menu"; break;\r
+ case CSIDL_COMMON_STARTUP: name = L"Common Startup"; break;\r
+ case CSIDL_COMMON_TEMPLATES: name = L"Common Templates"; break;\r
+ case CSIDL_COMMON_MUSIC: name = L"CommonMusic"; break;\r
+ case CSIDL_COMMON_PICTURES: name = L"CommonPictures"; break;\r
+ case CSIDL_COMMON_VIDEO: name = L"CommonVideo"; break;\r
+ }\r
+ }\r
+ /* XXX todo\r
+ * case CSIDL_SYSTEM # GetSystemDirectory()\r
+ * case CSIDL_RESOURCES # %windir%\Resources\, For theme and other windows resources.\r
+ * case CSIDL_RESOURCES_LOCALIZED # %windir%\Resources\<LangID>, for theme and other windows specific resources.\r
+ */\r
+\r
+#define SHELL_FOLDERS "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"\r
+\r
+ if (name && RegOpenKeyEx(root, SHELL_FOLDERS, 0, KEY_QUERY_VALUE, &hkey) == ERROR_SUCCESS) {\r
+ WCHAR data[MAX_PATH+1];\r
+ DWORD cb = sizeof(data)-sizeof(WCHAR);\r
+ DWORD type = REG_NONE;\r
+ long rc = RegQueryValueExW(hkey, name, NULL, &type, (BYTE*)&data, &cb);\r
+ RegCloseKey(hkey);\r
+ if (rc == ERROR_SUCCESS && type == REG_SZ && cb > sizeof(WCHAR) && data[0]) {\r
+ /* Make sure the string is properly terminated */\r
+ data[cb/sizeof(WCHAR)] = '\0';\r
+ ST(0) = wstr_to_ansipath(aTHX_ data);\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+\r
+#undef SHELL_FOLDERS\r
+\r
+ /* Unders some circumstances the registry entries seem to have a null string\r
+ * as their value even when the directory already exists. The environment\r
+ * variables do get set though, so try re-create a Unicode environment and\r
+ * check if they are there.\r
+ */\r
+ sv = NULL;\r
+ switch (folder) {\r
+ case CSIDL_APPDATA: sv = get_unicode_env(aTHX_ L"APPDATA"); break;\r
+ case CSIDL_PROFILE: sv = get_unicode_env(aTHX_ L"USERPROFILE"); break;\r
+ case CSIDL_PROGRAM_FILES: sv = get_unicode_env(aTHX_ L"ProgramFiles"); break;\r
+ case CSIDL_PROGRAM_FILES_COMMON: sv = get_unicode_env(aTHX_ L"CommonProgramFiles"); break;\r
+ case CSIDL_WINDOWS: sv = get_unicode_env(aTHX_ L"SystemRoot"); break;\r
+ }\r
+ if (sv) {\r
+ ST(0) = sv;\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_GetFileVersion)\r
+{\r
+ dXSARGS;\r
+ DWORD size;\r
+ DWORD handle;\r
+ char *filename;\r
+ char *data;\r
+\r
+ if (items != 1)\r
+ croak("usage: Win32::GetFileVersion($filename)\n");\r
+\r
+ filename = SvPV_nolen(ST(0));\r
+ size = GetFileVersionInfoSize(filename, &handle);\r
+ if (!size)\r
+ XSRETURN_UNDEF;\r
+\r
+ New(0, data, size, char);\r
+ if (!data)\r
+ XSRETURN_UNDEF;\r
+\r
+ if (GetFileVersionInfo(filename, handle, size, data)) {\r
+ VS_FIXEDFILEINFO *info;\r
+ UINT len;\r
+ if (VerQueryValue(data, "\\", (void**)&info, &len)) {\r
+ int dwValueMS1 = (info->dwFileVersionMS>>16);\r
+ int dwValueMS2 = (info->dwFileVersionMS&0xffff);\r
+ int dwValueLS1 = (info->dwFileVersionLS>>16);\r
+ int dwValueLS2 = (info->dwFileVersionLS&0xffff);\r
+\r
+ if (GIMME_V == G_ARRAY) {\r
+ EXTEND(SP, 4);\r
+ XST_mIV(0, dwValueMS1);\r
+ XST_mIV(1, dwValueMS2);\r
+ XST_mIV(2, dwValueLS1);\r
+ XST_mIV(3, dwValueLS2);\r
+ items = 4;\r
+ }\r
+ else {\r
+ char version[50];\r
+ sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);\r
+ XST_mPV(0, version);\r
+ }\r
+ }\r
+ }\r
+ else\r
+ items = 0;\r
+\r
+ Safefree(data);\r
+ XSRETURN(items);\r
+}\r
+\r
+#ifdef __CYGWIN__\r
+XS(w32_SetChildShowWindow)\r
+{\r
+ /* This function doesn't do anything useful for cygwin. In the\r
+ * MSWin32 case it modifies w32_showwindow, which is used by\r
+ * win32_spawnvp(). Since w32_showwindow is an internal variable\r
+ * inside the thread_intern structure, the MSWin32 implementation\r
+ * lives in win32/win32.c in the core Perl distribution.\r
+ */\r
+ dXSARGS;\r
+ XSRETURN_UNDEF;\r
+}\r
+#endif\r
+\r
+XS(w32_GetCwd)\r
+{\r
+ dXSARGS;\r
+ /* Make the host for current directory */\r
+ char* ptr = PerlEnv_get_childdir();\r
+ /*\r
+ * If ptr != Nullch\r
+ * then it worked, set PV valid,\r
+ * else return 'undef'\r
+ */\r
+ if (ptr) {\r
+ SV *sv = sv_newmortal();\r
+ sv_setpv(sv, ptr);\r
+ PerlEnv_free_childdir(ptr);\r
+\r
+#ifndef INCOMPLETE_TAINTS\r
+ SvTAINTED_on(sv);\r
+#endif\r
+\r
+ EXTEND(SP,1);\r
+ ST(0) = sv;\r
+ XSRETURN(1);\r
+ }\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_SetCwd)\r
+{\r
+ dXSARGS;\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)");\r
+\r
+ if (IsWin2000() && SvUTF8(ST(0))) {\r
+ WCHAR *wide = sv_to_wstr(aTHX_ ST(0));\r
+ char *ansi = my_ansipath(wide);\r
+ int rc = PerlDir_chdir(ansi);\r
+ Safefree(wide);\r
+ Safefree(ansi);\r
+ if (!rc)\r
+ XSRETURN_YES;\r
+ }\r
+ else {\r
+ if (!PerlDir_chdir(SvPV_nolen(ST(0))))\r
+ XSRETURN_YES;\r
+ }\r
+\r
+ XSRETURN_NO;\r
+}\r
+\r
+XS(w32_GetNextAvailDrive)\r
+{\r
+ dXSARGS;\r
+ char ix = 'C';\r
+ char root[] = "_:\\";\r
+\r
+ EXTEND(SP,1);\r
+ while (ix <= 'Z') {\r
+ root[0] = ix++;\r
+ if (GetDriveType(root) == 1) {\r
+ root[2] = '\0';\r
+ XSRETURN_PV(root);\r
+ }\r
+ }\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_GetLastError)\r
+{\r
+ dXSARGS;\r
+ EXTEND(SP,1);\r
+ XSRETURN_IV(GetLastError());\r
+}\r
+\r
+XS(w32_SetLastError)\r
+{\r
+ dXSARGS;\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");\r
+ SetLastError((DWORD)SvIV(ST(0)));\r
+ XSRETURN_EMPTY;\r
+}\r
+\r
+XS(w32_LoginName)\r
+{\r
+ dXSARGS;\r
+ EXTEND(SP,1);\r
+ if (IsWin2000()) {\r
+ WCHAR name[128];\r
+ DWORD size = countof(name);\r
+ if (GetUserNameW(name, &size)) {\r
+ ST(0) = wstr_to_sv(aTHX_ name);\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+ else {\r
+ char name[128];\r
+ DWORD size = countof(name);\r
+ if (GetUserNameA(name, &size)) {\r
+ /* size includes NULL */\r
+ ST(0) = sv_2mortal(newSVpvn(name, size-1));\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_NodeName)\r
+{\r
+ dXSARGS;\r
+ char name[MAX_COMPUTERNAME_LENGTH+1];\r
+ DWORD size = sizeof(name);\r
+ EXTEND(SP,1);\r
+ if (GetComputerName(name,&size)) {\r
+ /* size does NOT include NULL :-( */\r
+ ST(0) = sv_2mortal(newSVpvn(name,size));\r
+ XSRETURN(1);\r
+ }\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+\r
+XS(w32_DomainName)\r
+{\r
+ dXSARGS;\r
+ HMODULE module = LoadLibrary("netapi32.dll");\r
+ PFNNetApiBufferFree pfnNetApiBufferFree;\r
+ PFNNetWkstaGetInfo pfnNetWkstaGetInfo;\r
+\r
+ if (module) {\r
+ GETPROC(NetApiBufferFree);\r
+ GETPROC(NetWkstaGetInfo);\r
+ }\r
+ EXTEND(SP,1);\r
+ if (module && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {\r
+ /* this way is more reliable, in case user has a local account. */\r
+ char dname[256];\r
+ DWORD dnamelen = sizeof(dname);\r
+ struct {\r
+ DWORD wki100_platform_id;\r
+ LPWSTR wki100_computername;\r
+ LPWSTR wki100_langroup;\r
+ DWORD wki100_ver_major;\r
+ DWORD wki100_ver_minor;\r
+ } *pwi;\r
+ DWORD retval;\r
+ retval = pfnNetWkstaGetInfo(NULL, 100, &pwi);\r
+ /* NERR_Success *is* 0*/\r
+ if (retval == 0) {\r
+ if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {\r
+ WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,\r
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);\r
+ }\r
+ else {\r
+ WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,\r
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);\r
+ }\r
+ pfnNetApiBufferFree(pwi);\r
+ FreeLibrary(module);\r
+ XSRETURN_PV(dname);\r
+ }\r
+ FreeLibrary(module);\r
+ SetLastError(retval);\r
+ }\r
+ else {\r
+ /* Win95 doesn't have NetWksta*(), so do it the old way */\r
+ char name[256];\r
+ DWORD size = sizeof(name);\r
+ if (module)\r
+ FreeLibrary(module);\r
+ if (GetUserName(name,&size)) {\r
+ char sid[ONE_K_BUFSIZE];\r
+ DWORD sidlen = sizeof(sid);\r
+ char dname[256];\r
+ DWORD dnamelen = sizeof(dname);\r
+ SID_NAME_USE snu;\r
+ if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,\r
+ dname, &dnamelen, &snu)) {\r
+ XSRETURN_PV(dname); /* all that for this */\r
+ }\r
+ }\r
+ }\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_FsType)\r
+{\r
+ dXSARGS;\r
+ char fsname[256];\r
+ DWORD flags, filecomplen;\r
+ if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,\r
+ &flags, fsname, sizeof(fsname))) {\r
+ if (GIMME_V == G_ARRAY) {\r
+ XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));\r
+ XPUSHs(sv_2mortal(newSViv(flags)));\r
+ XPUSHs(sv_2mortal(newSViv(filecomplen)));\r
+ PUTBACK;\r
+ return;\r
+ }\r
+ EXTEND(SP,1);\r
+ XSRETURN_PV(fsname);\r
+ }\r
+ XSRETURN_EMPTY;\r
+}\r
+\r
+XS(w32_GetOSVersion)\r
+{\r
+ dXSARGS;\r
+\r
+ if (GIMME_V == G_SCALAR) {\r
+ XSRETURN_IV(g_osver.dwPlatformId);\r
+ }\r
+ XPUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));\r
+\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));\r
+ if (g_osver_ex) {\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));\r
+ XPUSHs(sv_2mortal(newSViv(g_osver.wProductType)));\r
+ }\r
+ PUTBACK;\r
+}\r
+\r
+XS(w32_IsWinNT)\r
+{\r
+ dXSARGS;\r
+ EXTEND(SP,1);\r
+ XSRETURN_IV(IsWinNT());\r
+}\r
+\r
+XS(w32_IsWin95)\r
+{\r
+ dXSARGS;\r
+ EXTEND(SP,1);\r
+ XSRETURN_IV(IsWin95());\r
+}\r
+\r
+XS(w32_FormatMessage)\r
+{\r
+ dXSARGS;\r
+ DWORD source = 0;\r
+ char msgbuf[ONE_K_BUFSIZE];\r
+\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");\r
+\r
+ if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,\r
+ &source, (DWORD)SvIV(ST(0)), 0,\r
+ msgbuf, sizeof(msgbuf)-1, NULL))\r
+ {\r
+ XSRETURN_PV(msgbuf);\r
+ }\r
+\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_Spawn)\r
+{\r
+ dXSARGS;\r
+ char *cmd, *args;\r
+ void *env;\r
+ char *dir;\r
+ PROCESS_INFORMATION stProcInfo;\r
+ STARTUPINFO stStartInfo;\r
+ BOOL bSuccess = FALSE;\r
+\r
+ if (items != 3)\r
+ Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");\r
+\r
+ cmd = SvPV_nolen(ST(0));\r
+ args = SvPV_nolen(ST(1));\r
+\r
+ env = PerlEnv_get_childenv();\r
+ dir = PerlEnv_get_childdir();\r
+\r
+ memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */\r
+ stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */\r
+ stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */\r
+ stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */\r
+\r
+ if (CreateProcess(\r
+ cmd, /* Image path */\r
+ args, /* Arguments for command line */\r
+ NULL, /* Default process security */\r
+ NULL, /* Default thread security */\r
+ FALSE, /* Must be TRUE to use std handles */\r
+ NORMAL_PRIORITY_CLASS, /* No special scheduling */\r
+ env, /* Inherit our environment block */\r
+ dir, /* Inherit our currrent directory */\r
+ &stStartInfo, /* -> Startup info */\r
+ &stProcInfo)) /* <- Process info (if OK) */\r
+ {\r
+ int pid = (int)stProcInfo.dwProcessId;\r
+ if (IsWin95() && pid < 0)\r
+ pid = -pid;\r
+ sv_setiv(ST(2), pid);\r
+ CloseHandle(stProcInfo.hThread);/* library source code does this. */\r
+ bSuccess = TRUE;\r
+ }\r
+ PerlEnv_free_childenv(env);\r
+ PerlEnv_free_childdir(dir);\r
+ XSRETURN_IV(bSuccess);\r
+}\r
+\r
+XS(w32_GetTickCount)\r
+{\r
+ dXSARGS;\r
+ DWORD msec = GetTickCount();\r
+ EXTEND(SP,1);\r
+ if ((IV)msec > 0)\r
+ XSRETURN_IV(msec);\r
+ XSRETURN_NV(msec);\r
+}\r
+\r
+XS(w32_GetShortPathName)\r
+{\r
+ dXSARGS;\r
+ SV *shortpath;\r
+ DWORD len;\r
+\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");\r
+\r
+ if (IsWin2000()) {\r
+ WCHAR wshort[MAX_PATH+1];\r
+ WCHAR *wlong = sv_to_wstr(aTHX_ ST(0));\r
+ len = GetShortPathNameW(wlong, wshort, countof(wshort));\r
+ Safefree(wlong);\r
+ if (len && len < sizeof(wshort)) {\r
+ ST(0) = wstr_to_sv(aTHX_ wshort);\r
+ XSRETURN(1);\r
+ }\r
+ XSRETURN_UNDEF;\r
+ }\r
+\r
+ shortpath = sv_mortalcopy(ST(0));\r
+ SvUPGRADE(shortpath, SVt_PV);\r
+ if (!SvPVX(shortpath) || !SvLEN(shortpath))\r
+ XSRETURN_UNDEF;\r
+\r
+ /* src == target is allowed */\r
+ do {\r
+ len = GetShortPathName(SvPVX(shortpath),\r
+ SvPVX(shortpath),\r
+ (DWORD)SvLEN(shortpath));\r
+ } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));\r
+ if (len) {\r
+ SvCUR_set(shortpath,len);\r
+ *SvEND(shortpath) = '\0';\r
+ ST(0) = shortpath;\r
+ XSRETURN(1);\r
+ }\r
+ XSRETURN_UNDEF;\r
+}\r
+\r
+XS(w32_GetFullPathName)\r
+{\r
+ dXSARGS;\r
+ char *fullname;\r
+ char *ansi = NULL;\r
+\r
+/* The code below relies on the fact that PerlDir_mapX() returns an\r
+ * absolute path, which is only true under PERL_IMPLICIT_SYS when\r
+ * we use the virtualization code from win32/vdir.h.\r
+ * Without it PerlDir_mapX() is a no-op and we need to use the same\r
+ * code as we use for Cygwin.\r
+ */\r
+#if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)\r
+ char buffer[2*MAX_PATH];\r
+#endif\r
+\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");\r
+\r
+#if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS)\r
+ if (IsWin2000()) {\r
+ WCHAR *filename = sv_to_wstr(aTHX_ ST(0));\r
+ WCHAR full[2*MAX_PATH];\r
+ DWORD len = GetFullPathNameW(filename, countof(full), full, NULL);\r
+ Safefree(filename);\r
+ if (len == 0 || len >= countof(full))\r
+ XSRETURN_EMPTY;\r
+ ansi = fullname = my_ansipath(full);\r
+ }\r
+ else {\r
+ DWORD len = GetFullPathNameA(SvPV_nolen(ST(0)), countof(buffer), buffer, NULL);\r
+ if (len == 0 || len >= countof(buffer))\r
+ XSRETURN_EMPTY;\r
+ fullname = buffer;\r
+ }\r
+#else\r
+ /* Don't use my_ansipath() unless the $filename argument is in Unicode.\r
+ * If the relative path doesn't exist, GetShortPathName() will fail and\r
+ * my_ansipath() will use the long name with replacement characters.\r
+ * In that case we will be better off using PerlDir_mapA(), which\r
+ * already uses the ANSI name of the current directory.\r
+ *\r
+ * XXX The one missing case is where we could downgrade $filename\r
+ * XXX from UTF8 into the current codepage.\r
+ */\r
+ if (IsWin2000() && SvUTF8(ST(0))) {\r
+ WCHAR *filename = sv_to_wstr(aTHX_ ST(0));\r
+ WCHAR *mappedname = PerlDir_mapW(filename);\r
+ Safefree(filename);\r
+ ansi = fullname = my_ansipath(mappedname);\r
+ }\r
+ else {\r
+ fullname = PerlDir_mapA(SvPV_nolen(ST(0)));\r
+ }\r
+# if PERL_VERSION < 8\r
+ {\r
+ /* PerlDir_mapX() in Perl 5.6 used to return forward slashes */\r
+ char *str = fullname;\r
+ while (*str) {\r
+ if (*str == '/')\r
+ *str = '\\';\r
+ ++str;\r
+ }\r
+ }\r
+# endif\r
+#endif\r
+\r
+ /* GetFullPathName() on Windows NT drops trailing backslash */\r
+ if (g_osver.dwMajorVersion == 4 && *fullname) {\r
+ STRLEN len;\r
+ char *pv = SvPV(ST(0), len);\r
+ char *lastchar = fullname + strlen(fullname) - 1;\r
+ /* If ST(0) ends with a slash, but fullname doesn't ... */\r
+ if (len && (pv[len-1] == '/' || pv[len-1] == '\\') && *lastchar != '\\') {\r
+ /* fullname is the MAX_PATH+1 sized buffer returned from PerlDir_mapA()\r
+ * or the 2*MAX_PATH sized local buffer in the __CYGWIN__ case.\r
+ */\r
+ strcpy(lastchar+1, "\\");\r
+ }\r
+ }\r
+\r
+ if (GIMME_V == G_ARRAY) {\r
+ char *filepart = strrchr(fullname, '\\');\r
+\r
+ EXTEND(SP,1);\r
+ if (filepart) {\r
+ XST_mPV(1, ++filepart);\r
+ *filepart = '\0';\r
+ }\r
+ else {\r
+ XST_mPVN(1, "", 0);\r
+ }\r
+ items = 2;\r
+ }\r
+ XST_mPV(0, fullname);\r
+\r
+ if (ansi)\r
+ Safefree(ansi);\r
+ XSRETURN(items);\r
+}\r
+\r
+XS(w32_GetLongPathName)\r
+{\r
+ dXSARGS;\r
+\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");\r
+\r
+ if (IsWin2000()) {\r
+ WCHAR *wstr = sv_to_wstr(aTHX_ ST(0));\r
+ WCHAR wide_path[MAX_PATH+1];\r
+ WCHAR *long_path;\r
+\r
+ wcscpy(wide_path, wstr);\r
+ Safefree(wstr);\r
+ long_path = my_longpathW(wide_path);\r
+ if (long_path) {\r
+ ST(0) = wstr_to_sv(aTHX_ long_path);\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+ else {\r
+ SV *path;\r
+ char tmpbuf[MAX_PATH+1];\r
+ char *pathstr;\r
+ STRLEN len;\r
+\r
+ path = ST(0);\r
+ pathstr = SvPV(path,len);\r
+ strcpy(tmpbuf, pathstr);\r
+ pathstr = my_longpathA(tmpbuf);\r
+ if (pathstr) {\r
+ ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));\r
+ XSRETURN(1);\r
+ }\r
+ }\r
+ XSRETURN_EMPTY;\r
+}\r
+\r
+XS(w32_GetANSIPathName)\r
+{\r
+ dXSARGS;\r
+ WCHAR *wide_path;\r
+\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::GetANSIPathName($pathname)");\r
+\r
+ wide_path = sv_to_wstr(aTHX_ ST(0));\r
+ ST(0) = wstr_to_ansipath(aTHX_ wide_path);\r
+ Safefree(wide_path);\r
+ XSRETURN(1);\r
+}\r
+\r
+XS(w32_Sleep)\r
+{\r
+ dXSARGS;\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");\r
+ Sleep((DWORD)SvIV(ST(0)));\r
+ XSRETURN_YES;\r
+}\r
+\r
+XS(w32_CopyFile)\r
+{\r
+ dXSARGS;\r
+ BOOL bResult;\r
+ char szSourceFile[MAX_PATH+1];\r
+\r
+ if (items != 3)\r
+ Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");\r
+ strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));\r
+ bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));\r
+ if (bResult)\r
+ XSRETURN_YES;\r
+ XSRETURN_NO;\r
+}\r
+\r
+XS(w32_OutputDebugString)\r
+{\r
+ dXSARGS;\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::OutputDebugString($string)");\r
+\r
+ if (SvUTF8(ST(0))) {\r
+ WCHAR *str = sv_to_wstr(aTHX_ ST(0));\r
+ OutputDebugStringW(str);\r
+ Safefree(str);\r
+ }\r
+ else\r
+ OutputDebugStringA(SvPV_nolen(ST(0)));\r
+\r
+ XSRETURN_EMPTY;\r
+}\r
+\r
+XS(w32_GetCurrentProcessId)\r
+{\r
+ dXSARGS;\r
+ EXTEND(SP,1);\r
+ XSRETURN_IV(GetCurrentProcessId());\r
+}\r
+\r
+XS(w32_GetCurrentThreadId)\r
+{\r
+ dXSARGS;\r
+ EXTEND(SP,1);\r
+ XSRETURN_IV(GetCurrentThreadId());\r
+}\r
+\r
+XS(w32_CreateDirectory)\r
+{\r
+ dXSARGS;\r
+ BOOL result;\r
+\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::CreateDirectory($dir)");\r
+\r
+ if (IsWin2000() && SvUTF8(ST(0))) {\r
+ WCHAR *dir = sv_to_wstr(aTHX_ ST(0));\r
+ result = CreateDirectoryW(dir, NULL);\r
+ Safefree(dir);\r
+ }\r
+ else {\r
+ result = CreateDirectoryA(SvPV_nolen(ST(0)), NULL);\r
+ }\r
+\r
+ ST(0) = boolSV(result);\r
+ XSRETURN(1);\r
+}\r
+\r
+XS(w32_CreateFile)\r
+{\r
+ dXSARGS;\r
+ HANDLE handle;\r
+\r
+ if (items != 1)\r
+ Perl_croak(aTHX_ "usage: Win32::CreateFile($file)");\r
+\r
+ if (IsWin2000() && SvUTF8(ST(0))) {\r
+ WCHAR *file = sv_to_wstr(aTHX_ ST(0));\r
+ handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_WRITE,\r
+ NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);\r
+ Safefree(file);\r
+ }\r
+ else {\r
+ handle = CreateFileA(SvPV_nolen(ST(0)), GENERIC_WRITE, FILE_SHARE_WRITE,\r
+ NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL);\r
+ }\r
+\r
+ if (handle != INVALID_HANDLE_VALUE)\r
+ CloseHandle(handle);\r
+\r
+ ST(0) = boolSV(handle != INVALID_HANDLE_VALUE);\r
+ XSRETURN(1);\r
+}\r
+\r
+MODULE = Win32 PACKAGE = Win32\r
+\r
+PROTOTYPES: DISABLE\r
+\r
+BOOT:\r
+{\r
+ char *file = __FILE__;\r
+\r
+ if (g_osver.dwOSVersionInfoSize == 0) {\r
+ g_osver.dwOSVersionInfoSize = sizeof(g_osver);\r
+ if (!GetVersionExA((OSVERSIONINFOA*)&g_osver)) {\r
+ g_osver_ex = FALSE;\r
+ g_osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);\r
+ GetVersionExA((OSVERSIONINFOA*)&g_osver);\r
+ }\r
+ }\r
+\r
+ newXS("Win32::LookupAccountName", w32_LookupAccountName, file);\r
+ newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);\r
+ newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);\r
+ newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file);\r
+ newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file);\r
+ newXS("Win32::MsgBox", w32_MsgBox, file);\r
+ newXS("Win32::LoadLibrary", w32_LoadLibrary, file);\r
+ newXS("Win32::FreeLibrary", w32_FreeLibrary, file);\r
+ newXS("Win32::GetProcAddress", w32_GetProcAddress, file);\r
+ newXS("Win32::RegisterServer", w32_RegisterServer, file);\r
+ newXS("Win32::UnregisterServer", w32_UnregisterServer, file);\r
+ newXS("Win32::GetArchName", w32_GetArchName, file);\r
+ newXS("Win32::GetChipName", w32_GetChipName, file);\r
+ newXS("Win32::GuidGen", w32_GuidGen, file);\r
+ newXS("Win32::GetFolderPath", w32_GetFolderPath, file);\r
+ newXS("Win32::IsAdminUser", w32_IsAdminUser, file);\r
+ newXS("Win32::GetFileVersion", w32_GetFileVersion, file);\r
+\r
+ newXS("Win32::GetCwd", w32_GetCwd, file);\r
+ newXS("Win32::SetCwd", w32_SetCwd, file);\r
+ newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);\r
+ newXS("Win32::GetLastError", w32_GetLastError, file);\r
+ newXS("Win32::SetLastError", w32_SetLastError, file);\r
+ newXS("Win32::LoginName", w32_LoginName, file);\r
+ newXS("Win32::NodeName", w32_NodeName, file);\r
+ newXS("Win32::DomainName", w32_DomainName, file);\r
+ newXS("Win32::FsType", w32_FsType, file);\r
+ newXS("Win32::GetOSVersion", w32_GetOSVersion, file);\r
+ newXS("Win32::IsWinNT", w32_IsWinNT, file);\r
+ newXS("Win32::IsWin95", w32_IsWin95, file);\r
+ newXS("Win32::FormatMessage", w32_FormatMessage, file);\r
+ newXS("Win32::Spawn", w32_Spawn, file);\r
+ newXS("Win32::GetTickCount", w32_GetTickCount, file);\r
+ newXS("Win32::GetShortPathName", w32_GetShortPathName, file);\r
+ newXS("Win32::GetFullPathName", w32_GetFullPathName, file);\r
+ newXS("Win32::GetLongPathName", w32_GetLongPathName, file);\r
+ newXS("Win32::GetANSIPathName", w32_GetANSIPathName, file);\r
+ newXS("Win32::CopyFile", w32_CopyFile, file);\r
+ newXS("Win32::Sleep", w32_Sleep, file);\r
+ newXS("Win32::OutputDebugString", w32_OutputDebugString, file);\r
+ newXS("Win32::GetCurrentProcessId", w32_GetCurrentProcessId, file);\r
+ newXS("Win32::GetCurrentThreadId", w32_GetCurrentThreadId, file);\r
+ newXS("Win32::CreateDirectory", w32_CreateDirectory, file);\r
+ newXS("Win32::CreateFile", w32_CreateFile, file);\r
+#ifdef __CYGWIN__\r
+ newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);\r
+#endif\r
+ XSRETURN_YES;\r
+}\r
projects / p5sagit/p5-mst-13.2.git / commitdiff