# $Id$
package Win32::kernel32;
use Win32::API;
$VERSION = '0.50';
%APIs = (
Beep => [[N, N], N],
CopyFile => [[P, P, N], N],
GetBinaryType => [[P, P], N],
GetCommandLine => [[], P],
GetCompressedFileSize => [[P, P], N],
GetCurrencyFormat => [[N, N, P, P, P, N], N],
GetDiskFreeSpace => [[P, P, P, P, P], N],
GetDriveType => [[P], N],
GetSystemTime => [[P], V],
GetTempPath => [[N, P], N],
GetVolumeInformation => [[P, P, N, P, P, P, P, N], N],
MultiByteToWideChar => [[N, N, P, N, P, N], N],
QueryDosDevice => [[P, P, N], N],
QueryPerformanceCounter => [[P], N],
QueryPerformanceFrequency => [[P], N],
SearchPath => [[P, P, P, N, P, P], N],
SetLastError => [[N], V],
Sleep => [[N], V],
VerLanguageName => [[N, P, N], N],
WideCharToMultiByte => [[N, N, P, N, P, N, P, P], N],
);
%SUBs = (
Beep => sub {
my ($freq, $duration) = @_;
return $Win32::kernel32::Beep->Call($freq, $duration);
},
CopyFile => sub {
my ($old, $new, $flag) = @_;
$flag = 1 unless defined($flag);
return $Win32::kernel32::CopyFile->Call($old, $new, $flag);
},
GetBinaryType => sub {
warn "The Win32::GetBinaryType API works only on Windows NT"
unless Win32::IsWinNT();
my ($appname) = @_;
my $type = pack("L", 0);
my $result = $Win32::kernel32::GetBinaryType->Call($appname, $type);
return ($result) ? unpack("L", $type) : undef;
},
GetCompressedFileSize => sub {
warn "The Win32::GetCompressedFileSize API works only on Windows NT"
unless Win32::IsWinNT();
my ($filename) = @_;
my $hiword = pack("L", 0);
my $loword = $Win32::kernel32::GetCompressedFileSize->Call($filename, $hiword);
return $loword + $hiword * 4 * 1024**3;
},
GetCommandLine => sub {
my $cmdline = $Win32::kernel32::GetCommandLine->Call();
my $string = pack("a1024", $cmdline);
$string =~ s/\0*$//;
return $string;
},
GetCurrencyFormat => sub {
my ($number, $locale) = @_;
$locale = 2048 unless defined($locale);
my $output = "\0" x 1024;
my $result =
$Win32::kernel32::GetCurrencyFormat->Call($locale, 0, $number, 0, $output,
1024,);
if ($result) {
return substr($output, 0, $result - 1);
}
else {
return undef;
}
},
GetDiskFreeSpace => sub {
my ($root) = @_;
$root = 0 unless defined($root);
my $SectorsPerCluster = pack("L", 0);
my $BytesPerSector = pack("L", 0);
my $FreeClusters = pack("L", 0);
my $TotalClusters = pack("L", 0);
my $result =
$Win32::kernel32::GetDiskFreeSpace->Call($root, $SectorsPerCluster,
$BytesPerSector, $FreeClusters, $TotalClusters,);
if ($result) {
$SectorsPerCluster = unpack("L", $SectorsPerCluster);
$BytesPerSector = unpack("L", $BytesPerSector);
$FreeClusters = unpack("L", $FreeClusters);
$TotalClusters = unpack("L", $TotalClusters);
return wantarray
? (
$BytesPerSector * $SectorsPerCluster * $FreeClusters,
$BytesPerSector * $SectorsPerCluster * $TotalClusters,
)
: $BytesPerSector * $SectorsPerCluster * $FreeClusters;
}
else {
return undef;
}
},
GetDriveType => sub {
my ($root) = @_;
$root = 0 unless defined($root);
return $Win32::kernel32::GetDriveType->Call($root);
},
GetSystemTime => sub {
my $SYSTEMTIME = pack("SSSSSSSS", 0, 0, 0, 0, 0, 0, 0, 0);
$Win32::kernel32::GetSystemTime->Call($SYSTEMTIME);
return wantarray ? unpack("SSSSSSSS", $SYSTEMTIME) : $SYSTEMTIME;
},
GetTempPath => sub {
my $string = " " x 256;
my $result = $Win32::kernel32::GetTempPath->Call(256, $string);
return substr($string, 0, $result) if $result;
return undef;
},
GetVolumeInformation => sub {
my ($root) = @_;
$root = 0 unless defined($root);
my $name = "\0" x 256;
my $serial = pack("L", 0);
my $maxlen = pack("L", 0);
my $flags = pack("L", 0);
my $fstype = "\0" x 256;
my $result =
$Win32::kernel32::GetVolumeInformation->Call($root, $name, 256, $serial,
$maxlen, $flags, $fstype, 256,);
if ($result) {
$name =~ s/\0*$//;
$fstype =~ s/\0*$//;
return wantarray
? (
$name,
unpack("L", $serial),
unpack("L", $maxlen),
unpack("L", $flags), $fstype,
)
: $name;
}
else {
return undef;
}
},
MultiByteToWideChar => sub {
my ($string, $codepage) = @_;
$codepage = 0 unless defined($codepage);
my $result =
$Win32::kernel32::MultiByteToWideChar->Call($codepage, 0, $string,
length($string), 0, 0,);
return undef unless $result;
my $ustring = " " x ($result * 2);
$result =
$Win32::kernel32::MultiByteToWideChar->Call($codepage, 0, $string,
length($string), $ustring, $result,);
return undef unless $result;
return $ustring;
},
QueryDosDevice => sub {
warn "The Win32::QueryDosDevice API works only on Windows NT"
unless Win32::IsWinNT();
my ($name) = @_;
$name = 0 unless defined($name);
my $path = "\0" x 1024;
my $result = $Win32::kernel32::QueryDosDevice->Call($name, $path, 1024);
if ($result) {
return wantarray
? split(/\0/, $path)
: join(";", split(/\0/, $path));
}
else {
return undef;
}
},
QueryPerformanceCounter => sub {
my $count = pack("b64", 0);
if ($Win32::kernel32::QueryPerformanceCounter->Call($count)) {
my ($clo, $chi) = unpack("ll", $count);
return $clo + $chi * 4 * 1024**3;
}
else {
return undef;
}
},
QueryPerformanceFrequency => sub {
my $freq = pack("b64", 0);
if ($Win32::kernel32::QueryPerformanceFrequency->Call($freq)) {
my ($flo, $fhi) = unpack("ll", $freq);
return $flo + $fhi * 4 * 1024**3;
}
else {
return undef;
}
},
SearchPath => sub {
my ($name, $ext) = @_;
$ext = 0 unless defined($ext);
my $path = "\0" x 1024;
my $pext = pack("L", 0);
my $result =
$Win32::kernel32::SearchPath->Call(0, $name, $extension, 1024, $path, $pext,);
if ($result) {
$path =~ s/\0*$//;
return $path;
}
else {
return undef;
}
},
SetLastError => sub {
$Win32::kernel32::SetLastError->Call($_[0]) if $_[0];
},
Sleep => sub {
$Win32::kernel32::Sleep->Call($_[0]) if $_[0];
},
VerLanguageName => sub {
my ($lang) = @_;
if ($lang) {
my $langdesc = "\0" x 256;
my $result = $Win32::kernel32::VerLanguageName->Call($lang, $langdesc, 256);
if ($result > 0 and $result < 256) {
return substr($langdesc, 0, $result);
}
else {
return 0;
}
}
},
WideCharToMultiByte => sub {
my ($ustring, $codepage) = @_;
$codepage = 0 unless defined($codepage);
my $result =
$Win32::kernel32::WideCharToMultiByte->Call($codepage, 0, $ustring, -1, 0, 0,
0, 0,);
return undef unless $result;
my $string = " " x $result;
$result =
$Win32::kernel32::WideCharToMultiByte->Call($codepage, 0, $ustring, -1,
$string, $result, 0, 0,);
# $string =~ s/\0.*$//;
return undef unless $result;
return $string;
},
);
sub import {
my $self = shift;
@apis = @_;
@apis = keys %APIs unless @apis;
foreach $api (@apis) {
import_API($api);
}
}
sub import_API {
my ($function) = @_;
my $params;
if (exists($APIs{$function})) {
$params = $APIs{$function};
}
else {
$params = [[], V];
warn "Unknown API: $function";
}
$$function = new Win32::API("kernel32", $function, @$params);
warn "Win32::kernel32 failed to import API $function from KERNEL32.DLL"
unless $$function;
*{'Win32::' . $function} = $SUBs{$function};
}
1;
__END__
=head1 NAME
Win32::kernel32 - Experimental interface to some of the KERNEL32.DLL functions
=head1 SYNOPSIS
use Win32::kernel32;
# or
use Win32::kernel32 qw( Sleep CopyFile GetVolumeInformation );
=head1 FUNCTIONS
=head4 Beep
Syntax:
Win32::Beep ( [FREQUENCY, DURATION] )
Plays a simple tone on the speaker; C<FREQUENCY> is expressed
in hertz and ranges from 37 to 32767, C<DURATION> is expressed
in milliseconds.
Note that parameters are relevant only on Windows NT; on
Windows 95, parameters are ignored and the system plays the
default sound event (or a standard system beep on the speaker
if you have no sound card).
Example:
Win32::Beep(440, 1000);
=head4 CopyFile
Syntax:
Win32::CopyFile ( SOURCE, TARGET, [SAFE] )
Copies the C<SOURCE> file to C<TARGET>. By default, it fails
if C<TARGET> already exists; to overwrite the already
existing file, the C<SAFE> flag must be set to 0.
Returns a true value if the operation was successfull,
a false one if it failed.
Example:
if(Win32::CopyFile($from, $to)) {
print "Copy OK.\n";
} else {
# overwrite the already existing file
if(Win32::CopyFile($from, $to, 0)) {
print "Copy OK, file replaced.\n";
} else {
print "Copy failed.\n";
}
}
=head4 GetBinaryType
Syntax:
Win32::GetBinaryType ( FILENAME )
Returns the type ot the executable file C<FILENAME>.
Possible values are:
0 A Win32 based application
1 An MS-DOS based application
2 A 16-bit Windows based application
3 A PIF file that executes an MS-DOS based application
4 A POSIX based application
5 A 16-bit OS/2 based application
If the function fails, C<undef> is returned.
B<Note>: this function is available on Windows NT only.
Example:
print "Notepad is a type ", Win32::GetBinaryType("c:\\winnt\\notepad.exe"), "\n";
=head4 GetCompressedFileSize
Syntax:
Win32::GetCompressedFileSize ( FILENAME )
Returns the compressed size of the specified C<FILENAME>,
if the file is compressed; if it's not compressed, it
returns the normal file size (eg. same as C<-s>).
B<Note>: this function is available on Windows NT only.
Example:
print Win32::GetCompressedFileSize("c:\\documents\\longlog.txt");
=head4 GetCommandLine
Syntax:
Win32::GetCommandLine ( )
Returns the complete command line string, including the
full path to the program name and its arguments.
Example:
print Win32::GetCommandLine();
=head4 GetCurrencyFormat
Syntax:
Win32::GetCurrencyFormat ( NUMBER, [LOCALE] )
Returns C<NUMBER> formatted to your locale's currency settings.
You can optionally supply a different C<LOCALE> for foreign currencies.
Example:
print "You owe me ", Win32::GetCurrencyFormat(rand()*10000), "\n";
# ten millions italian lires...
$LotOfMoney = Win32::GetCurrencyFormat(10000000, 1040);
# 1040 is "Italian (Standard)" (see also VerLanguageName)
# and it returns: L. 10.000.000
=head4 GetDiskFreeSpace
Syntax:
Win32::GetDiskFreeSpace ( [ROOT] )
Returns the amount of free disk space on the drive indicated by C<ROOT>;
if this is omitted, uses the current drive.
To specify a drive, you must provide the exact root directory
(eg. for drive C: it must be: "C:\").
In a scalar context, it returns the number of free bytes;
in a list context, it returns the number of free bytes and
the total number of bytes on the disk.
Example:
$free = Win32::GetDiskFreeSpace("c:\\");
($free, $total) = Win32::GetDiskFreeSpace();
=head4 GetDriveType
Syntax:
Win32::GetDriveType ( [ROOT] )
Returns the type ot the drive indicated by C<ROOT>.
If this is omitted, uses the current drive.
To specify a drive, you must provide the exact root directory
(eg. for drive C: it must be: "C:\").
Possible return values are:
0 The drive type cannot be determined
1 The root directory does not exist
2 The disk can be removed from the drive
3 The disk cannot be removed from the drive
4 The drive is a remote (network) drive
5 The drive is a CD-ROM drive
6 The drive is a RAM disk
Example:
print "C: is a type ", Win32::GetDriveType("c:\\"), "\n";
=head4 GetTempPath
Syntax:
Win32::GetTempPath ( )
Returns the path of the directory designated for temporary
files, or C<undef> on errors.
Example:
print "Please put your temp files in ", Win32::GetTempPath(), "\n";
=head4 GetVolumeInformation
Syntax:
Win32::GetVolumeInformation ( [ROOT] )
Returns a 5-elements array with some information about the
drive indicated by C<ROOT>.
If this is omitted, uses the current drive.
Typically used as follows:
($label, $serial, $maxlen, $flags, $fstype) = Win32::GetVolumeInformation();
Here are the meaning of the fields:
label the volume label
serial the volume serial number
maxlen the maximum filename length, in chars, supported by the volume
flags a set of flags associated with the file system
fstype the type of the file system (such as FAT or NTFS)
For more information about the C<flags> field, please refer
to the GetVolumeInformation() documentation in the Microsoft
Win32 SDK Reference.
If called in a scalar context, the function returns only the
first element (the volume label).
Example:
$volume = Win32::GetVolumeInformation();
print "Working on $volume...";
=head4 MultiByteToWideChar
Syntax:
Win32::MultiByteToWideChar ( STRING, [CODEPAGE] )
Converts a C<STRING> in Unicode format. The additional
C<CODEPAGE> parameter can have one of this values:
0 ANSI codepage
1 OEM codepage
2 MAC codepage
Or the number of a codepage installed on your system (eg. 850
for "MS-DOS Multilingual (Latin I)"). The default, if none
specified, is the ANSI codepage. Returns the converted string
or C<undef> on errors.
Example:
$UnicodeString = Win32::MultiByteToWideChar($string);
=head4 QueryPerformanceCounter
Syntax:
Win32::QueryPerformanceCounter ( )
Retrieves the current value of the high-resolution performance
counter, if it exists. Returns zero if it doesn't.
To see how many times per second the counter is incremented,
use QueryPerformanceFrequency().
Example:
$freq = Win32::QueryPerformanceFrequency();
$count1 = Win32::QueryPerformanceCounter();
# do something
$count2 = Win32::QueryPerformanceCounter();
print ($count2-$count1)/$freq , " seconds elapsed.\n";
=head4 QueryPerformanceFrequency
Syntax:
Win32::QueryPerformanceFrequency ( )
Returns the frequency of the high-resolution performance
counter, if it exists. Returns zero if it doesn't.
See also C<QueryPerformanceCounter>.
=head4 SearchPath
Syntax:
Win32::SearchPath ( FILENAME )
Search for the specified C<FILENAME> in the path.
The following directories are searched:
1. the directory from which the application loaded.
2. the current directory
3. the Windows system directory
4. the Windows directory
5. the directories in the PATH environment variable
Returns the full path to the found file or C<undef>
if the file was not found.
Example:
print "Notepad exists" if -f Win32::SearchPath("notepad.exe");
=head4 SetLastError
Syntax:
Win32::SetLastError ( VALUE )
Sets the Win32 last error to the specified C<VALUE>.
Example:
# reset pending errors
Win32::SetLastError(0);
=head4 Sleep
Syntax:
Win32::Sleep ( MILLISECONDS )
Sleeps for the number of C<MILLISECONDS> specified.
Example:
# sleep for 1/2 second
Win32::Sleep(500);
=head4 VerLanguageName
Syntax:
Win32::VerLanguageName ( LOCALE )
Returns a descriptive string for the language associated with the
specified C<LOCALE>.
Example:
$ITA = Win32::VerLanguageName(1040);
$JAP = Win32::VerLanguageName(1041);
=head4 WideCharToMultiByte
Syntax:
Win32::WideCharToMultiByte ( STRING, [CODEPAGE] )
Converts an Unicode C<STRING> to a non-Unicode one. The additional
C<CODEPAGE> parameter can have one of this values:
0 ANSI codepage
1 OEM codepage
2 MAC codepage
Or the number of a codepage installed on your system (eg. 850
for "MS-DOS Multilingual (Latin I)"). The default, if none
specified, is the ANSI codepage. Returns the converted string
or C<undef> on errors.
Example:
$string = Win32::WideCharToMultiByte($UnicodeString);
=head4 Yet to be documented
GetSystemTime => [[P], V],
QueryDosDevice => [[P, P, N], N],
=head1 AUTHOR
Aldo Calpini ( I<dada@perl.it> ).
=head1 MAINTAINER
Cosimo Streppone, <cosimo@cpan.org>
=cut