summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Win32/API.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2014-04-23 21:46:20 +0000
committerKarl Berry <karl@freefriends.org>2014-04-23 21:46:20 +0000
commit300c1eb6d37d46078d448d6d58938d5a80cd68ff (patch)
tree23a0a8b9f8f5460b405119c4d3c163d2d488ca5e /Master/tlpkg/tlperl/lib/Win32/API.pm
parented55d86b7c5e18f6eccce80a1fb1423ca40a23b5 (diff)
(tl)perl 5.18.2 for windows from siep
git-svn-id: svn://tug.org/texlive/trunk@33648 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/API.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Win32/API.pm1075
1 files changed, 869 insertions, 206 deletions
diff --git a/Master/tlpkg/tlperl/lib/Win32/API.pm b/Master/tlpkg/tlperl/lib/Win32/API.pm
index 8a08b01033a..6accc691db8 100644
--- a/Master/tlpkg/tlperl/lib/Win32/API.pm
+++ b/Master/tlpkg/tlperl/lib/Win32/API.pm
@@ -14,13 +14,41 @@
#######################################################################
package Win32::API;
+ use strict;
+ use warnings;
+ use Config;
+BEGIN {
+ require Exporter; # to export the constants to the main:: space
+ require DynaLoader; # to dynuhlode the module.
-require Exporter; # to export the constants to the main:: space
-require DynaLoader; # to dynuhlode the module.
-@ISA = qw( Exporter DynaLoader );
+ sub ISCYG ();
+ eval "sub ISCYG () { ".($^O eq 'cygwin' ? 1 : 0)."}";
+ no warnings 'uninitialized';
+ die "Win32::API on Cygwin requires the cygpath tool on PATH"
+ if ISCYG && index(`cygpath --help`,'Usage: cygpath') == -1;
-use vars qw( $DEBUG );
-$DEBUG = 0;
+ use vars qw( $DEBUG $sentinal @ISA @EXPORT_OK $VERSION );
+
+ @ISA = qw( Exporter DynaLoader );
+ @EXPORT_OK = qw( ReadMemory IsBadReadPtr MoveMemory
+ WriteMemory SafeReadWideCString ); # symbols to export on request
+
+ use Scalar::Util qw( looks_like_number weaken);
+
+ $DEBUG = 0;
+
+ sub ERROR_NOACCESS () { 998 }
+ sub ERROR_NOT_ENOUGH_MEMORY () { 8 }
+ sub ERROR_INVALID_PARAMETER () { 87 }
+ sub APICONTROL_CC_STD () { 0 }
+ sub APICONTROL_CC_C () { 1 }
+ sub APICONTROL_CC_mask () { 0x7 }
+ sub APICONTROL_UseMI64 () { 0x8 }
+ sub APICONTROL_is_more () { 0x10 }
+ sub APICONTROL_has_proto() { 0x20 }
+ eval " *Win32::API::Type::PTRSIZE = *Win32::API::More::PTRSIZE = *PTRSIZE = sub () { ".$Config{ptrsize}." }";
+ eval " *Win32::API::Type::IVSIZE = *Win32::API::More::IVSIZE = *IVSIZE = sub () { ".$Config{ivsize}." }";
+}
sub DEBUG {
if ($Win32::API::DEBUG) {
@@ -38,8 +66,6 @@ use File::Basename ();
#######################################################################
# STATIC OBJECT PROPERTIES
#
-$VERSION = '0.68';
-
#### some package-global hash to
#### keep track of the imported
#### libraries and procedures
@@ -49,125 +75,211 @@ my %Procedures = ();
#######################################################################
# dynamically load in the API extension module.
-#
-bootstrap Win32::API;
+# BEGIN required for constant subs in BOOT:
+BEGIN {
+ $VERSION = '0.77';
+ bootstrap Win32::API;
+}
#######################################################################
# PUBLIC METHODS
#
sub new {
- my ($class, $dll, $proc, $in, $out, $callconvention) = @_;
- my $hdll;
- my $self = {};
-
- if ($^O eq 'cygwin' and $dll ne File::Basename::basename($dll)) {
-
- # need to convert $dll to win32 path
- # isn't there an API for this?
- my $newdll = `cygpath -w "$dll"`;
- chomp $newdll;
- DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n";
- $dll = $newdll;
- }
-
- #### avoid loading a library more than once
- if (exists($Libraries{$dll})) {
- DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
- $hdll = $Libraries{$dll};
+ die "Win32::API/More::new/Import is a class method that takes 2 to 6 parameters, see POD"
+ if @_ < 3 || @_ > 7;
+ my ($class, $dll, $hproc, $ccnum, $outnum) = (shift, shift);
+ if(! defined $dll){
+ $hproc = shift;
}
- else {
- DEBUG "Win32::API::new: Loading library '$dll'\n";
- $hdll = Win32::API::LoadLibrary($dll);
-
-# $Libraries{$dll} = $hdll;
+ my ($proc, $in, $out, $callconvention) = @_;
+ my ($hdll, $freedll, $proto, $stackunwind) = (0, 0, 0, 0);
+ my $self = {};
+ if(! defined $hproc){
+ if (ISCYG() and $dll ne File::Basename::basename($dll)) {
+
+ # need to convert $dll to win32 path
+ # isn't there an API for this?
+ my $newdll = `cygpath -w "$dll"`;
+ chomp $newdll;
+ DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n";
+ $dll = $newdll;
+ }
+
+ #### avoid loading a library more than once
+ if (exists($Libraries{$dll})) {
+ DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
+ $hdll = $Libraries{$dll};
+ }
+ else {
+ DEBUG "Win32::API::new: Loading library '$dll'\n";
+ $hdll = Win32::API::LoadLibrary($dll);
+ $freedll = 1;
+ # $Libraries{$dll} = $hdll;
+ }
+
+ #### if the dll can't be loaded, set $! to Win32's GetLastError()
+ if (!$hdll) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED Loading library '$dll': $^E\n";
+ return undef;
+ }
}
-
- #### if the dll can't be loaded, set $! to Win32's GetLastError()
- if (!$hdll) {
- $! = Win32::GetLastError();
- DEBUG "FAILED Loading library '$dll': $!\n";
- delete $Libraries{$dll};
- return undef;
+ else{
+ if(!looks_like_number($hproc) || IsBadReadPtr($hproc, 4)){
+ Win32::SetLastError(ERROR_NOACCESS);
+ DEBUG "FAILED Function pointer '$hproc' is not a valid memory location\n";
+ return undef;
+ }
}
-
- #### determine if we have a prototype or not
+ #### determine if we have a prototype or not, outtype is for future use in XS
if ((not defined $in) and (not defined $out)) {
- ($proc, $self->{in}, $self->{intypes}, $self->{out}, $self->{cdecl}) =
- parse_prototype($proc);
- return undef unless $proc;
- $self->{proto} = 1;
+ ($proc, $self->{in}, $self->{intypes}, $outnum, $self->{outtype},
+ $ccnum) = parse_prototype($class, $proc);
+ if( ! $proc ){
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ Win32::SetLastError(ERROR_INVALID_PARAMETER);
+ return undef;
+ }
+ $proto = 1;
}
else {
$self->{in} = [];
+ my $self_in = $self->{in}; #avoid hash derefing
if (ref($in) eq 'ARRAY') {
foreach (@$in) {
- push(@{$self->{in}}, type_to_num($_));
+ push(@{$self_in}, $class->type_to_num($_));
}
}
else {
my @in = split '', $in;
foreach (@in) {
- push(@{$self->{in}}, type_to_num($_));
+ push(@{$self_in}, $class->type_to_num($_));
+ }
+ }#'V' must be one and ONLY letter for "in"
+ foreach(@{$self_in}){
+ if($_ == 0){
+ if(@{$self_in} != 1){
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ die "Win32::API 'V' for in prototype must be the only parameter";
+ } else {undef(@{$self_in});} #empty arr, as if in param was ""
}
}
- $self->{out} = type_to_num($out);
- $self->{cdecl} = calltype_to_num($callconvention);
+ $outnum = $class->type_to_num($out, 1);
+ $ccnum = calltype_to_num($callconvention);
}
- #### first try to import the function of given name...
- my $hproc = Win32::API::GetProcAddress($hdll, $proc);
-
- #### ...then try appending either A or W (for ASCII or Unicode)
- if (!$hproc) {
- my $tproc = $proc;
- $tproc .= (IsUnicode() ? "W" : "A");
-
- # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
- $hproc = Win32::API::GetProcAddress($hdll, $tproc);
+ if(!$hproc){ #if not non DLL func
+ #### first try to import the function of given name...
+ $hproc = Win32::API::GetProcAddress($hdll, $proc);
+
+ #### ...then try appending either A or W (for ASCII or Unicode)
+ if (!$hproc) {
+ my $tproc = $proc;
+ $tproc .= (IsUnicode() ? "W" : "A");
+
+ # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
+ $hproc = Win32::API::GetProcAddress($hdll, $tproc);
+ }
+
+ #### ...if all that fails, give up, $! setting is back compat, $! is deprecated
+ if (!$hproc) {
+ my $err = $! = Win32::GetLastError();
+ DEBUG "FAILED GetProcAddress for Proc '$proc': $^E\n";
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ Win32::SetLastError($err);
+ return undef;
+ }
+ DEBUG "GetProcAddress('$proc') = '$hproc'\n";
}
-
- #### ...if all that fails, set $! accordingly
- if (!$hproc) {
- $! = Win32::GetLastError();
- DEBUG "FAILED GetProcAddress for Proc '$proc': $!\n";
+ else {
+ DEBUG "Using non-DLL function pointer '$hproc' for '$proc'\n";
+ }
+ if(PTRSIZE == 4 && $ccnum == APICONTROL_CC_C) {#fold out on WIN64
+ #calculate add to ESP amount, in units of 4, will be *4ed later
+ $stackunwind += $_ == T_QUAD || $_ == T_DOUBLE ? 2 : 1 for(@{$self->{in}});
+ if($stackunwind > 0xFFFF) {
+ goto too_many_in_params;
+ }
+ }
+ # if a prototype has 8 byte types on 32bit, $stackunwind will be higher than
+ # length of {in} letter array, so 2 different checks need to be done
+ if($#{$self->{in}} > 0xFFFF) {
+ too_many_in_params:
+ DEBUG "FAILED This function has too many parameters (> ~65535) \n";
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ Win32::SetLastError(ERROR_NOT_ENOUGH_MEMORY);
return undef;
}
- DEBUG "GetProcAddress('$proc') = '$hproc'\n";
-
#### ok, let's stuff the object
$self->{procname} = $proc;
$self->{dll} = $hdll;
$self->{dllname} = $dll;
- $self->{proc} = $hproc;
- #### keep track of the imported function
- $Libraries{$dll} = $hdll;
- $Procedures{$dll}++;
+ $outnum &= ~T_FLAG_NUMERIC;
+ my $control;
+ $self->{weakapi} = \$control;
+ weaken($self->{weakapi});
+ $control = pack( 'L'
+ .'L'
+ .(PTRSIZE == 8 ? 'Q' : 'L')
+ .(PTRSIZE == 8 ? 'Q' : 'L')
+ .(PTRSIZE == 8 ? 'Q' : 'L')
+ .(PTRSIZE == 8 ? '' : 'L')
+ ,($class eq "Win32::API::More" ? APICONTROL_is_more : 0)
+ | ($proto ? APICONTROL_has_proto : 0)
+ | $ccnum
+ | (PTRSIZE == 8 ? 0 : $stackunwind << 8)
+ | $outnum << 24
+ , scalar(@{$self->{in}}) * PTRSIZE #in param count, in SV * units
+ , $hproc
+ , \($self->{weakapi})+0 #weak api obj ref
+ , (exists $self->{intypes} ? ($self->{intypes})+0 : 0)
+ , 0); #padding to align to 8 bytes on 32 bit only
+ #align to 16 bytes
+ $control .= "\x00" x ((((length($control)+ 15) >> 4) << 4)-length($control));
+ #make a APIPARAM template array
+ my ($i, $arr_end) = (0, scalar(@{$self->{in}}));
+ for(; $i< $arr_end; $i++) {
+ my $tin = $self->{in}[$i];
+ #unsigned meaningless no sign vs zero extends are done bc uv/iv is
+ #the biggest native integer on the cpu, big to small is truncation
+ #numeric is implemented as T_NUMCHAR for in, keeps asm jumptable clean
+ $tin &= ~(T_FLAG_UNSIGNED|T_FLAG_NUMERIC);
+ $tin--; #T_VOID doesn't exist as in param in XS
+ #put index of param array slice in unused space for croaks, why not?
+ $control .= "\x00" x 8 . pack('CCSSS', $tin, 0, 0, $i, $i+1);
+ }
+ _Align($control, 16); #align the whole PVX to 16 bytes for SSE moves
+ #### keep track of the imported function
+ if(defined $dll){
+ $Libraries{$dll} = $hdll;
+ $Procedures{$dll}++;
+ }
DEBUG "Object blessed!\n";
- #### cast the spell
- bless($self, $class);
- return $self;
+ my $ref = bless(\$control, $class);
+ SetMagicSV($ref, $self);
+ return $ref;
}
sub Import {
- my ($class, $dll, $proc, $in, $out, $callconvention) = @_;
- $Imported{"$dll:$proc"} = Win32::API->new($dll, $proc, $in, $out, $callconvention)
- or return 0;
- my $P = (caller)[0];
- eval qq(
- sub ${P}::$Imported{"$dll:$proc"}->{procname} { \$Win32::API::Imported{"$dll:$proc"}->Call(\@_); }
- );
- return $@ ? 0 : 1;
+ my $closure = shift->new(@_)
+ or return undef;
+ my $procname = ${Win32::API::GetMagicSV($closure)}{procname};
+ #dont allow "sub main:: {0;}"
+ Win32::SetLastError(ERROR_INVALID_PARAMETER), return undef if $procname eq '';
+ _ImportXS($closure, (caller)[0].'::'.$procname);
+ return $closure;
}
#######################################################################
# PRIVATE METHODS
#
sub DESTROY {
- my ($self) = @_;
+ my ($self) = GetMagicSV($_[0]);
+ return if ! defined $self->{dllname};
#### decrease this library's procedures reference count
$Procedures{$self->{dllname}}--;
@@ -180,131 +292,277 @@ sub DESTROY {
}
# Convert calling convention string (_cdecl|__stdcall)
-# to an integer (1|0). Unknown counts as __stdcall
+# to a C const. Unknown counts as __stdcall
#
sub calltype_to_num {
my $type = shift;
- if (!$type || $type eq "__stdcall") {
- return 0;
+ if (!$type || $type eq "__stdcall" || $type eq "WINAPI" || $type eq "NTAPI"
+ || $type eq "CALLBACK" ) {
+ return APICONTROL_CC_STD;
}
- elsif ($type eq "_cdecl") {
- return 1;
+ elsif ($type eq "_cdecl" || $type eq "__cdecl" || $type eq "WINAPIV") {
+ return APICONTROL_CC_C;
}
else {
warn "unknown calling convention: '$type'";
- return 0;
+ return APICONTROL_CC_STD;
}
}
+
sub type_to_num {
+ die "wrong class" if shift ne "Win32::API";
my $type = shift;
my $out = shift;
- my $num;
+ my ($num, $numeric);
+ if(index($type, 'num', 0) == 0){
+ substr($type, 0, length('num'), '');
+ $numeric = 1;
+ }
+ else{
+ $numeric = 0;
+ }
if ( $type eq 'N'
or $type eq 'n'
or $type eq 'l'
- or $type eq 'L')
+ or $type eq 'L'
+ or ( PTRSIZE == 8 and $type eq 'Q' || $type eq 'q'))
{
- $num = 1;
+ $num = T_NUMBER;
}
elsif ($type eq 'P'
or $type eq 'p')
{
- $num = 2;
+ $num = T_POINTER;
}
elsif ($type eq 'I'
or $type eq 'i')
{
- $num = 3;
+ $num = T_INTEGER;
}
elsif ($type eq 'f'
or $type eq 'F')
{
- $num = 4;
+ $num = T_FLOAT;
}
elsif ($type eq 'D'
or $type eq 'd')
{
- $num = 5;
+ $num = T_DOUBLE;
}
elsif ($type eq 'c'
or $type eq 'C')
{
- $num = 6;
+ $num = $numeric ? T_NUMCHAR : T_CHAR;
+ }
+ elsif (PTRSIZE == 4 and $type eq 'q' || $type eq 'Q')
+ {
+ $num = T_QUAD;
+ }
+ elsif($type eq '>'){
+ die "Win32::API does not support pass by copy structs as function arguments";
}
else {
- $num = 0;
+ $num = T_VOID; #'V' takes this branch, which is T_VOID in C
+ }#not valid return types of the C func
+ if(defined $out) {#b/B remains private/undocumented
+ die "Win32::API invalid return type, structs and ".
+ "callbacks as return types not supported"
+ if($type =~ m/^s|S|t|T|b|B|k|K$/);
}
- unless (defined $out) {
- if ( $type eq 's'
- or $type eq 'S')
+ else {#in type
+ if ($type eq 's' or $type eq 'S' or $type eq 't' or $type eq 'T')
{
- $num = 51;
+ $num = T_STRUCTURE;
}
elsif ($type eq 'b'
or $type eq 'B')
{
- $num = 22;
+ $num = T_POINTERPOINTER;
}
elsif ($type eq 'k'
or $type eq 'K')
{
- $num = 101;
+ $num = T_CODE;
}
}
+ $num |= T_FLAG_NUMERIC if $numeric;
return $num;
}
+package Win32::API::More;
+
+use vars qw( @ISA );
+@ISA = qw ( Win32::API );
+sub type_to_num {
+ die "wrong class" if shift ne "Win32::API::More";
+ my $type = shift;
+ my $out = shift;
+ my ($num, $numeric);
+ if(index($type, 'num', 0) == 0){
+ substr($type, 0, length('num'), '');
+ $numeric = 1;
+ }
+ else{
+ $numeric = 0;
+ }
+
+ if ( $type eq 'N'
+ or $type eq 'n'
+ or $type eq 'l'
+ or $type eq 'L'
+ or ( PTRSIZE == 8 and $type eq 'Q' || $type eq 'q')
+ or (! $out and # in XS short 'in's are interger/numbers code
+ $type eq 'S'
+ || $type eq 's'))
+ {
+ $num = Win32::API::T_NUMBER;
+ if(defined $out && ($type eq 'N' || $type eq 'L'
+ || $type eq 'S' || $type eq 'Q')){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif ($type eq 'P'
+ or $type eq 'p')
+ {
+ $num = Win32::API::T_POINTER;
+ }
+ elsif ($type eq 'I'
+ or $type eq 'i')
+ {
+ $num = Win32::API::T_INTEGER;
+ if(defined $out && $type eq 'I'){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif ($type eq 'f'
+ or $type eq 'F')
+ {
+ $num = Win32::API::T_FLOAT;
+ }
+ elsif ($type eq 'D'
+ or $type eq 'd')
+ {
+ $num = Win32::API::T_DOUBLE;
+ }
+ elsif ($type eq 'c'
+ or $type eq 'C')
+ {
+ $num = $numeric ? Win32::API::T_NUMCHAR : Win32::API::T_CHAR;
+ if(defined $out && $type eq 'C'){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif (PTRSIZE == 4 and $type eq 'q' || $type eq 'Q')
+ {
+ $num = Win32::API::T_QUAD;
+ if(defined $out && $type eq 'Q'){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif ($type eq 's') #4 is only used for out params
+ {
+ $num = Win32::API::T_SHORT;
+ }
+ elsif ($type eq 'S')
+ {
+ $num = Win32::API::T_SHORT | Win32::API::T_FLAG_UNSIGNED;
+ }
+ elsif($type eq '>'){
+ die "Win32::API does not support pass by copy structs as function arguments";
+ }
+ else {
+ $num = Win32::API::T_VOID; #'V' takes this branch, which is T_VOID in C
+ } #not valid return types of the C func
+ if(defined $out) {#b/B remains private/undocumented
+ die "Win32::API invalid return type, structs and ".
+ "callbacks as return types not supported"
+ if($type =~ m/^t|T|b|B|k|K$/);
+ }
+ else {#in type
+ if ( $type eq 't'
+ or $type eq 'T')
+ {
+ $num = Win32::API::T_STRUCTURE;
+ }
+ elsif ($type eq 'b'
+ or $type eq 'B')
+ {
+ $num = Win32::API::T_POINTERPOINTER;
+ }
+ elsif ($type eq 'k'
+ or $type eq 'K')
+ {
+ $num = Win32::API::T_CODE;
+ }
+ }
+ $num |= Win32::API::T_FLAG_NUMERIC if $numeric;
+ return $num;
+}
+package Win32::API;
+
sub parse_prototype {
- my ($proto) = @_;
+ my ($class, $proto) = @_;
my @in_params = ();
- my @in_types = ();
- if ($proto =~ /^\s*(\S+)(?:\s+(\w+))?\s+(\S+)\s*\(([^\)]*)\)/) {
- my $ret = $1;
- my $callconvention = $2;
- my $proc = $3;
- my $params = $4;
+ my @in_types = (); #one day create a BNF-ish formal grammer parser here
+ if ($proto =~ /^\s*((?:(?:un|)signed\s+|) #optional signedness
+ \S+)(?:\s*(\*)\s*|\s+) #type and maybe a *
+ (?:(\w+)\s+)? # maybe a calling convention
+ (\S+)\s* #func name
+ \(([^\)]*)\) #param list
+ /x) {
+ my $ret = $1.(defined($2)?$2:'');
+ my $callconvention = $3;
+ my $proc = $4;
+ my $params = $5;
$params =~ s/^\s+//;
$params =~ s/\s+$//;
DEBUG "(PM)parse_prototype: got PROC '%s'\n", $proc;
DEBUG "(PM)parse_prototype: got PARAMS '%s'\n", $params;
-
+
foreach my $param (split(/\s*,\s*/, $params)) {
my ($type, $name);
- if ($param =~ /(\S+)\s+(\S+)/) {
- ($type, $name) = ($1, $2);
+ #match "in_t* _var" "in_t * _var" "in_t *_var" "in_t _var" "in_t*_var" supported
+ #unsigned or signed or nothing as prefix supported
+ # "in_t ** _var" and "const in_t* var" not supported
+ if ($param =~ /((?:(?:un|)signed\s+|)\w+)(?:\s*(\*)\s*|\s+)(\w+)/) {
+ ($type, $name) = ($1.(defined($2)? $2:''), $3);
}
-
- if (Win32::API::Type::is_known($type)) {
+ {
+ no warnings 'uninitialized';
+ if($type eq '') {goto BADPROTO;} #something very wrong, bail out
+ }
+ my $packing = Win32::API::Type::packing($type);
+ if (defined $packing && $packing ne '>') {
if (Win32::API::Type::is_pointer($type)) {
DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
$type,
- Win32::API::Type->packing($type),
- type_to_num('P');
- push(@in_params, type_to_num('P'));
+ $packing,
+ $class->type_to_num('P');
+ push(@in_params, $class->type_to_num('P'));
}
else {
DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
$type,
- Win32::API::Type->packing($type),
- type_to_num(Win32::API::Type->packing($type));
- push(@in_params, type_to_num(Win32::API::Type->packing($type)));
+ $packing,
+ $class->type_to_num(Win32::API::Type->packing($type, undef, 1));
+ push(@in_params, $class->type_to_num(Win32::API::Type->packing($type, undef, 1)));
}
}
elsif (Win32::API::Struct::is_known($type)) {
DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
- $type, 'S', type_to_num('S');
- push(@in_params, type_to_num('S'));
+ $type, 'T', Win32::API::More->type_to_num('T');
+ push(@in_params, Win32::API::More->type_to_num('T'));
}
else {
warn
"Win32::API::parse_prototype: WARNING unknown parameter type '$type'";
- push(@in_params, type_to_num('I'));
+ push(@in_params, $class->type_to_num('I'));
}
push(@in_types, $type);
@@ -317,36 +575,59 @@ sub parse_prototype {
DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
$ret,
Win32::API::Type->packing($ret),
- type_to_num('P');
- return ($proc, \@in_params, \@in_types, type_to_num('P'),
- calltype_to_num($callconvention));
+ $class->type_to_num('P');
+ return ($proc, \@in_params, \@in_types, $class->type_to_num('P', 1),
+ $ret, calltype_to_num($callconvention));
}
else {
DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
$ret,
Win32::API::Type->packing($ret),
- type_to_num(Win32::API::Type->packing($ret));
+ $class->type_to_num(Win32::API::Type->packing($ret, undef, 1), 1);
return (
$proc, \@in_params, \@in_types,
- type_to_num(Win32::API::Type->packing($ret)),
- calltype_to_num($callconvention)
+ $class->type_to_num(Win32::API::Type->packing($ret, undef, 1), 1),
+ $ret, calltype_to_num($callconvention)
);
}
}
else {
warn
"Win32::API::parse_prototype: WARNING unknown output parameter type '$ret'";
- return ($proc, \@in_params, \@in_types, type_to_num('I'),
- calltype_to_num($callconvention));
+ return ($proc, \@in_params, \@in_types, $class->type_to_num('I', 1),
+ $ret, calltype_to_num($callconvention));
}
}
else {
+ BADPROTO:
warn "Win32::API::parse_prototype: bad prototype '$proto'";
return undef;
}
}
+#
+# XXX hack, see the proper implementation in TODO
+# The point here is don't let fork children free the parent's DLLs.
+# CLONE runs on ::API and ::More, that's bad and causes a DLL leak, make sure
+# CLONE dups the DLL handles only once per CLONE
+# GetModuleHandleEx was not used since that is a WinXP and newer function, not Win2K.
+# GetModuleFileName was used to get full DLL pathname incase SxS/multiple DLLs
+# with same file name exist in the process. Even if the dll was loaded as a
+# relative path initially, later SxS can load a DLL with a different full path
+# yet same file name, and then LoadLibrary'ing the original relative path
+# might increase the refcount on the wrong DLL or return a different HMODULE
+sub CLONE {
+ return if $_[0] ne "Win32::API";
+
+ _my_cxt_clone();
+ foreach( keys %Libraries){
+ if($Libraries{$_} != Win32::API::LoadLibrary(Win32::API::GetModuleFileName($Libraries{$_}))){
+ die "Win32::API::CLONE unable to clone DLL \"$Libraries{$_}\" Unicode Problem??";
+ }
+ }
+}
+
1;
__END__
@@ -364,25 +645,50 @@ Win32::API - Perl Win32 API Import Facility
#### Method 1: with prototype
use Win32::API;
- $function = Win32::API->new(
- 'mydll, 'int sum_integers(int a, int b)',
+ $function = Win32::API::More->new(
+ 'mydll', 'int sum_integers(int a, int b)'
+ );
+ #### $^E is non-Cygwin only
+ die "Error: $^E" if ! $function;
+ #### or on Cygwin and non-Cygwin
+ die "Error: ".(Win32::FormatMessage(Win32::GetLastError())) if ! $function;
+ ####
+ $return = $function->Call(3, 2);
+
+ #### Method 2: with prototype and your function pointer
+
+ use Win32::API;
+ $function = Win32::API::More->new(
+ undef, 38123456, 'int name_ignored(int a, int b)'
);
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
$return = $function->Call(3, 2);
+
+ #### Method 3: with parameter list
- #### Method 2: with parameter list
+ use Win32::API;
+ $function = Win32::API::More->new(
+ 'mydll', 'sum_integers', 'II', 'I'
+ );
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
+ $return = $function->Call(3, 2);
+
+ #### Method 4: with parameter list and your function pointer
use Win32::API;
- $function = Win32::API->new(
- 'mydll', 'sum_integers', 'II', 'I',
+ $function = Win32::API::More->new(
+ undef, 38123456, 'name_ignored', 'II', 'I'
);
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
$return = $function->Call(3, 2);
- #### Method 3: with Import
+ #### Method 5: with Import (slightly faster than ->Call)
use Win32::API;
- Win32::API->Import(
- 'mydll', 'int sum_integers(int a, int b)',
- );
+ $function = Win32::API::More->Import(
+ 'mydll', 'int sum_integers(int a, int b)'
+ );
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
$return = sum_integers(3, 2);
@@ -395,7 +701,8 @@ Win32::API - Perl Win32 API Import Facility
=head1 ABSTRACT
With this module you can import and call arbitrary functions
-from Win32's Dynamic Link Libraries (DLL), without having
+from Win32's Dynamic Link Libraries (DLL) or arbitrary functions for
+which you have a pointer (MS COM, etc), without having
to write an XS extension. Note, however, that this module
can't do everything. In fact, parameters input and output is
limited to simpler cases.
@@ -411,9 +718,13 @@ A short example of how you can use this module (it just gets the PID of
the current process, eg. same as Perl's internal C<$$>):
use Win32::API;
- Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ Win32::API::More->Import("kernel32", "int GetCurrentProcessId()");
$PID = GetCurrentProcessId();
+Starting with 0.69. Win32::API initiated objects are deprecated due to numerous
+bugs and improvements, use Win32::API::More now. The use statement remains
+as C<use Win32::API;>.
+
The possibilities are nearly infinite (but not all are good :-).
Enjoy it.
@@ -424,33 +735,44 @@ To use this module put the following line at the beginning of your script:
use Win32::API;
You can now use the C<new()> function of the Win32::API module to create a
-new Win32::API object (see L<IMPORTING A FUNCTION>) and then invoke the
+new Win32::API::More object (see L<IMPORTING A FUNCTION>) and then invoke the
C<Call()> method on this object to perform a call to the imported API
(see L<CALLING AN IMPORTED FUNCTION>).
-Starting from version 0.40, you can also avoid creating a Win32::API object
+Starting from version 0.40, you can also avoid creating a Win32::API::More object
and instead automatically define a Perl sub with the same name of the API
-function you're importing. The details of the API definitions are the same,
-just the call is different:
+function you're importing. This 2nd way using C<Import> to create a sub instead
+of an object is slightly faster than doing C<-E<gt>Call()>. The details of the
+API definitions are the same, just the method name is different:
- my $GetCurrentProcessId = Win32::API->new(
+ my $GetCurrentProcessId = Win32::API::More->new(
"kernel32", "int GetCurrentProcessId()"
);
+ die "Failed to import GetCurrentProcessId" if !$GetCurrentProcessId;
+ $GetCurrentProcessId->UseMI64(1);
my $PID = $GetCurrentProcessId->Call();
#### vs.
- Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ my $UnusedGCPI = Win32::API::More->Import("kernel32", "int GetCurrentProcessId()");
+ die "Failed to import GetCurrentProcessId" if !$UnusedGCPI;
+ $UnusedGCPI->UseMI64(1);
$PID = GetCurrentProcessId();
-Note that C<Import> returns 1 on success and 0 on failure (in which case you
-can check the content of C<$^E>).
+Note that C<Import> returns the Win32::API obj on success and false on failure
+(in which case you can check the content of C<$^E>). This allows some settings
+to be set through method calls that can't be specified as a parameter to Import,
+yet still have the convience of not writing C<-E<gt>Call()>. The Win32::API obj
+does not need to be assigned to a scalar. C<unless(Win32::API::More-E<gt>Import>
+is fine. Prior to v0.76_02, C<Import> returned returned 1 on success and 0 on
+failure.
=head2 IMPORTING A FUNCTION
-You can import a function from a 32 bit Dynamic Link Library (DLL) file
-with the C<new()> function. This will create a Perl object that contains the
-reference to that function, which you can later C<Call()>.
+You can import a function from a 32 bit Dynamic Link Library (DLL) file with
+the C<new()> function or, starting in 0.69, supply your own function pointer.
+This will create a Perl object that contains the reference to that function,
+which you can later C<Call()>.
What you need to know is the prototype of the function you're going to import
(eg. the definition of the function expressed in C syntax).
@@ -461,17 +783,30 @@ one uses Win32::API's internal representation for parameters.
=head2 IMPORTING A FUNCTION BY PROTOTYPE
-You need to pass 2 parameters:
+You need to pass 2 or 3 parameters:
=over 4
=item 1.
-The name of the library from which you want to import the function.
+The name of the library from which you want to import the function. If the
+name is undef, you are requesting a object created from a function pointer,
+and must supply item 2.
=item 2.
-The C prototype of the function.
+This parameter is optional, most people should skip it, skip does not mean
+supplying undef. Supply a function pointer in the format of number 1234, not
+string "\x01\x02\x03\x04". Undef will be returned if the pointer is not
+readable, L<Win32::GetLastError|Win32/Win32::GetLastError()>/L<perlvar/"$^E">
+will be C<ERROR_NOACCESS>.
+
+=item 3.
+
+The C prototype of the function. If you are using a function pointer, the name
+of the function should be something "friendly" to you and no attempt is made
+to retrieve such a name from any DLL's export table. This name for a function
+pointer is also used for Import().
=back
@@ -482,9 +817,15 @@ automatically turned into a C C<NULL> value.
See L<Win32::API::Type> for a list of the known parameter types and
L<Win32::API::Struct> for information on how to define a structure.
+If a prototype type is exactly C<signed char> or C<unsigned char> for an
+"in" parameter or the return parameter, and for "in" parameters only
+C<signed char *> or C<unsigned char *> the parameters will be treated as a
+number, C<0x01>, not C<"\x01">. "UCHAR" is not "unsigned char". Change the
+C prototype if you want numeric handling for your chars.
+
=head2 IMPORTING A FUNCTION WITH A PARAMETER LIST
-You need to pass 4 parameters:
+You need to pass at minimum 4 parameters.
=over 4
@@ -492,17 +833,32 @@ You need to pass 4 parameters:
The name of the library from which you want to import the function.
=item 2.
-The name of the function (as exported by the library).
+This parameter is optional, most people should skip it, skip does not mean
+supplying undef. Supply a function pointer in the format of number C<1234>,
+not string C<"\x01\x02\x03\x04">. Undef will be returned if the pointer is not
+readable, L<Win32::GetLastError|Win32/Win32::GetLastError()>/L<perlvar/"$^E">
+will be C<ERROR_NOACCESS>.
=item 3.
-The number and types of the arguments the function expects as input.
+The name of the function (as exported by the library) or for function pointers
+a name that is "friendly" to you. This name for a function pointer is also used
+for Import(). No attempt is made to retrieve such a name from any DLL's export
+table in the 2nd case.
=item 4.
-The type of the value returned by the function.
+The number and types of the arguments the function expects as input.
=item 5.
+The type of the value returned by the function.
+
+=item 6.
And optionally you can specify the calling convention, this defaults to
-'__stdcall', alternatively you can specify '_cdecl'.
+'__stdcall', alternatively you can specify '_cdecl' or '__cdecl' (API > v0.68)
+or (API > v0.70_02) 'WINAPI', 'NTAPI', 'CALLBACK' (__stdcall), 'WINAPIV' (__cdecl) .
+False is __stdcall. Vararg functions are always cdecl. MS DLLs are typically
+stdcall. Non-MS DLLs are typically cdecl. If API > v0.75, mixing up the calling
+convention on 32 bits is detected and Perl will C<croak> an error message and
+C<die>.
=back
@@ -542,25 +898,36 @@ a couple of directories, including:
=back
-So, you don't have to write F<C:\windows\system\kernel32.dll>;
-only F<kernel32> is enough:
+You may, but don't have to write F<C:\windows\system\kernel32.dll>; or
+F<kernel32.dll>, only F<kernel32> is enough:
- $GetTempPath = new Win32::API('kernel32', ...
+ $GetTempPath = new Win32::API::More('kernel32', ...
=item B<2.>
-Now for the second parameter: the name of the function.
+Since this function is from a DLL, skip the 2nd parameter. Skip does not
+mean supplying undef.
+
+=item B<3.>
+
+Now for the real second parameter: the name of the function.
It must be written exactly as it is exported
-by the library (case is significant here).
+by the library (case is significant here).
If you are using Windows 95 or NT 4.0, you can use the B<Quick View>
command on the DLL file to see the function it exports.
-Remember that you can only import functions from 32 bit DLLs:
+Remember that you can only import functions from 32 or 64 bit DLLs:
in Quick View, the file's characteristics should report
somewhere "32 bit word machine"; as a rule of thumb,
when you see that all the exported functions are in upper case,
-the DLL is a 16 bit one and you can't use it.
+the DLL is a 16 bit one and you can't use it. You also can not load a 32 bit
+DLL into a 64 bit Perl, or vice versa. If you try, C<new>/C<Import> will fail
+and C<$^E> will be C<ERROR_BAD_EXE_FORMAT>.
If their capitalization looks correct, then it's probably a 32 bit
-DLL.
+DLL. If you have Platform SDK or Visual Studio, you can use the Dumpbin
+tool. Call it as C<dumpbin /exports name_of_dll.dll> on the command line.
+If you have Mingw GCC, use objdump as
+C<objdump -x name_of_dll.dll E<gt> dlldump.txt> and search for the word exports
+in the very long output.
Also note that many Win32 APIs are exported twice, with the addition of
a final B<A> or B<W> to their name, for - respectively - the ASCII
@@ -570,11 +937,11 @@ an B<A> to the name and try again; if the extension is built on a
Unicode system, then it will try with the B<W> instead.
So our function name will be:
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', ...
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', ...
In our case C<GetTempPath> is really loaded as C<GetTempPathA>.
-=item B<3.>
+=item B<4.>
The third parameter, the input parameter list, specifies how many
arguments the function wants, and their types. It can be passed as
@@ -597,31 +964,98 @@ argument; allowed types are:
=over 4
=item C<I>:
-value is an integer (int)
+value is an unsigned integer (unsigned int)
+
+=item C<i>:
+value is an signed integer (signed int or int)
=item C<N>:
-value is a number (long)
+value is a unsigned pointer sized number (unsigned long)
+
+=item C<n>:
+value is a signed pointer sized number (signed long or long)
+
+=item C<Q>:
+value is a unsigned 64 bit integer number (unsigned long long, unsigned __int64)
+See next item for details.
+
+=item C<q>:
+value is a signed 64 bit integer number (long long, __int64)
+If your perl has 'Q'/'q' quads support for L<perlfunc/pack> then Win32::API's 'q'
+is a normal perl numeric scalar. All 64 bit Perls have quad support. Almost no
+32 bit Perls have quad support. On 32 bit Perls, without quad support,
+Win32::API's 'q'/'Q' letter is a packed 8 byte string. So C<0x8000000050000000>
+from a perl with native Quad support would be written as
+C<"\x00\x00\x00\x50\x00\x00\x00\x80"> on a 32 bit Perl without Quad support.
+To improve the use of 64 bit integers with Win32::API on a 32 bit Perl without
+Quad support, there is a per Win32::API::* object setting called L</UseMI64>
+that causes all quads to be accepted as, and returned as L<Math::Int64> objects.
+For "in" params in Win32::API and Win32::API::More and "out" in
+Win32::API::Callback only, if the argument is a reference, it will automatically
+be treated as a Math::Int64 object without having to previously call
+L</UseMI64>.
=item C<F>:
-value is a floating point number (float)
+value is a single precision (4 bytes) floating point number (float)
=item C<D>:
-value is a double precision number (double)
+value is a double precision (8 bytes) floating point number (double)
+
+=item C<S>:
+value is a unsigned short (unsigned short)
+
+=item C<s>:
+value is a signed short (signed short or short)
=item C<C>:
-value is a char (char)
+value is a char (char), pass as C<"a">, not C<97>, C<"abc"> will truncate to C<"a">
=item C<P>:
value is a pointer (to a string, structure, etc...)
-
-=item C<S>:
-value is a Win32::API::Struct object (see below)
+padding out the buffer string is required, buffer overflow detection is
+performed. Pack and unpack the data yourself. If P is a return type, only
+null terminated strings or NULL pointer are supported. If P is an in type, NULL
+is integer C<0>. C<undef>, C<"0">, and C<""+0> are not integer C<0>, C<"0"+0> is
+integer C<0>.
+
+It is suggested to
+not use P as a return type and instead use N and read the memory yourself, and
+free the pointer if applicable. This pointer is effectively undefined after the
+C function returns control to Perl. The C function may not hold onto it after
+the C function returns control. There are exceptions where the pointer will
+remain valid after the C function returns control, but tread at your own risk,
+and at your knowledge of Perl interpreter's C internals.
+
+=item C<T>:
+value is a Win32::API::Struct object, in parameter only, pass by reference
+(pointer) only, pass by copy not implemented, see other sections for more
=item C<K>:
-value is a Win32::API::Callback object (see L<Win32::API::Callback>)
+value is a Win32::API::Callback object, in parameter only, (see L<Win32::API::Callback>)
+
+=item C<V>:
+no value, no parameters, stands for C<void>, may not be combined with any other
+letters, equivalent to a ""
=back
+For beginners, just skip this paragraph.
+Note, all parameter types are little endian. This is probably what you want
+unless the documentation for the C function you are calling explicitly says
+the parameters must be big endian. If there is no documentation for your C
+function or no mention of endianess in the documentation, this doesn't apply
+to you and skip the rest of this paragraph. There is no inherent support
+for big endian parameters. Perl's scalar numbers model is that numeric
+scalars are effectively opaque and their machine representation is
+irrelevant. On Windows Perl, scalar numbers are little endian
+internally. So C<$number = 5; print "$number";> will put 5 on the screen.
+C<$number> given to Win32::API will pass little endian integer 5 to the C
+function call. This is almost surly what you want. If you really must pass
+a big endian integer, do C<$number = unpack('L', pack('N', 5));>, then
+C<print "$number";> will put 83886080 on the screen, but this is big endian 5,
+and passing 83886080 to C<-E<gt>Call()> will make sure that
+the C function is getting big endian 5. See L<perlpacktut> for more.
+
Our function needs two parameters: a number (C<DWORD>) and a pointer to a
string (C<LPSTR>):
@@ -629,24 +1063,32 @@ string (C<LPSTR>):
=item B<4.>
-The fourth and final parameter is the type of the value returned by the
+The fourth is the type of the value returned by the
function. It can be one of the types seen above, plus another type named B<V>
(for C<void>), used for functions that do not return a value.
-In our example the value returned by GetTempPath() is a C<DWORD>, so
-our return type will be B<N>:
+In our example the value returned by GetTempPath() is a C<DWORD>, which is a
+typedef for unsigned long, so our return type will be B<N>:
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', 'NP', 'N');
Now the line is complete, and the GetTempPath() API is ready to be used
in Perl. Before calling it, you should test that $GetTempPath is
-C<defined>, otherwise either the function or the library could not be
-loaded; in this case, C<$!> will be set to the error message reported
-by Windows.
+L<perlfunc/defined>, otherwise errors such as the function or the library could
+not be loaded or the C prototype was unparsable happened, and no object was
+created. If the return value is undefined, to get detailed error status, use
+L<perlvar/"$^E"> or L<Win32::GetLastError|Win32/Win32::GetLastError()>. C<$^E>
+is slower than C<Win32::GetLastError> and useless on Cygwin, but C<$^E> in
+string context provides a readable description of the error. In numeric context,
+C<$^E> is equivelent to C<Win32::GetLastError>. C<Win32::GetLastError> always
+returns an integer error code. You may use
+L<Win32::FormatMessage|Win32/Win32::FormatMessage()> to convert an integer error
+code to a readable description on Cygwin and Native builds of Perl.
+
Our definition, with error checking added, should then look like this:
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', 'NP', 'N');
if(not defined $GetTempPath) {
- die "Can't import API GetTempPath: $!\n";
+ die "Can't import API GetTempPath: $^E\n";
}
=back
@@ -668,10 +1110,9 @@ Perl will C<croak> an error message and C<die>.
The two parameters needed here are the length of the buffer
that will hold the returned temporary path, and a pointer to the
buffer itself.
-For numerical parameters, you can use either a constant expression
-or a variable, while B<for pointers you must use a variable name> (no
-Perl references, just a plain variable name).
-Also note that B<memory must be allocated before calling the function>,
+For numerical parameters except for char, you can use either a constant expression
+or a variable, it will be numified similar to the expression C<($var+0)>.
+For pointers, also note that B<memory must be allocated before calling the function>,
just like in C.
For example, to pass a buffer of 80 characters to GetTempPath(),
it must be initialized before with:
@@ -679,14 +1120,14 @@ it must be initialized before with:
$lpBuffer = " " x 80;
This allocates a string of 80 characters. If you don't do so, you'll
-probably get C<Runtime exception> errors, and generally nothing will
-work. The call should therefore include:
+probably get a fatal buffer overflow error starting in 0.69.
+The call should therefore include:
$lpBuffer = " " x 80;
$GetTempPath->Call(80, $lpBuffer);
And the result will be stored in the $lpBuffer variable.
-Note that you don't need to pass a reference to the variable
+Note that you never need to pass a reference to the variable
(eg. you B<don't need> C<\$lpBuffer>), even if its value will be set
by the function.
@@ -746,10 +1187,17 @@ them as parameters to Win32::API functions. A short example follows:
print "The cursor is at: $pt->{x}, $pt->{y}\n";
Note that this works only when the function wants a
-B<pointer to a structure>: as you can see, our structure is named
-'POINT', but the API used 'LPPOINT'. 'LP' is automatically added at
-the beginning of the structure name when feeding it to a Win32::API
-call.
+B<pointer to a structure>, not a "pass by copy" structure. As you can see, our
+structure is named 'POINT', but the API used 'LPPOINT'. Some heuristics are
+done to validate the argument's type vs the parameter's type if the function
+has a C prototype definition (not letter definition). First, if the parameter
+type starts with the LP prefix, the LP prefix is stripped, then compared to
+the argument's type. If that fails, the Win32::API::Type database
+(see L<Win32::API::Type/typedef>)
+will be used to convert the parameter type to the base type. If that fails,
+the parameter type will be stripped of a trailing whitespace then a '*', and
+then checked against the base type. L<Dies|perlfunc/die> if the parameter and
+argument types do not match after 3 attempts.
For more information, see also L<Win32::API::Struct>.
@@ -760,20 +1208,231 @@ you can still use the low-level approach to use structures:
=item 1.
-you have to pack() the required elements in a variable:
+you have to L<pack()|perlfunc/pack> the required elements in a variable:
- $lpPoint = pack('LL', 0, 0); # store two LONGs
+ $lpPoint = pack('ll', 0, 0); # store two LONGs
=item 2.
-to access the values stored in a structure, unpack() it as required:
+to access the values stored in a structure, L<unpack()|perlfunc/unpack> it as required:
- ($x, $y) = unpack('LL', $lpPoint); # get the actual values
+ ($x, $y) = unpack(';;', $lpPoint); # get the actual values
=back
The rest is left as an exercise to the reader...
+=head2 EXPORTED FUNCTIONS
+
+=head3 ReadMemory
+
+ $copy_of_memblock = ReadMemory($SourcePtr, $length);
+
+Reads the source pointer for C<$length> number of bytes. Returns a copy of
+the memory block in a scalar. No readability checking is done on C<$SourcePtr>.
+C<$SourcePtr>'s format is 123456, not C<"\x01\x02\x03\x04">.
+
+=head3 WriteMemory
+
+ WriteMemory($DestPtr, $sourceScalar, $length);
+
+Copies the string contents of the C<$sourceScalar> scalar to C<$DestPtr> for
+C<$length> bytes. $length must be less than or equal to the length of
+C<$sourceScalar>, otherwise the function croaks. No readability checking is
+done on C<$DestPtr>. C<$DestPtr>'s format is 123456, not
+C<"\x01\x02\x03\x04">. Returns nothing.
+
+=head3 MoveMemory
+
+ MoveMemory($destPtr, $sourcePtr, $length);
+
+Copies a block of memory from one location to another. The source and
+destination blocks may overlap. All pointers are in the format of 123456,
+not C<"\x01\x02\x03\x04">. No readability checking is done. Returns nothing.
+
+=head3 IsBadReadPtr
+
+ if(IsBadReadPtr($ptr, $length)) {die "bad ptr";}
+
+Probes a memory block for C<$length> bytes for readability. Returns true if
+access violation occurs, otherwise false is returned. This function is useful
+to avoid dereferencing pointers which will crash the perl process. This function
+has many limitations, including not detecting uninitialized memory, not
+detecting freed memory, and not detecting gibberish. It can not tell whether a
+function pointer is valid x86 machine code. Ideally, you should never use it,
+or remove it once your code is stable. C<$ptr> is in the format of 123456,
+not C<"\x01\x02\x03\x04">. See MS's documentation for a lot more
+on this function of the same name.
+
+=head3 SafeReadWideCString
+
+ $source = Encode::encode("UTF-16LE","Just another perl h\x{00E2}cker\x00");
+ $string = SafeReadWideCString(unpack('J',pack('p', $source)));
+ die "impossible" if $source ne "Just another perl h\x{00E2}cker";
+
+Safely (SEH aware) reads a utf-16 wide null terminated string (the first and
+only parameter), into a scalar. Returns undef, if an access violation happens
+or null pointer (same thing). The string pointer is in the format of 123456,
+not C<"\x01\x02\x03\x04">. The returned scalar will be UTF8 marked if the string
+can not be represented in the system's ANSI codepage. Conversion is done with
+WideCharToMultiByte. Returns a 0 length scalar string if WideCharToMultiByte fails.
+This function was created because L<pack's|perlfunc/pack> p letter won't read UTF16
+and L</ReadMemory> and L</IsBadReadPtr> require an explicit length.
+
+=head2 CONSTRUCTORS
+
+=head3 new
+
+ $obj = Win32::API::More->new([$dllname | (undef , $funcptr)], [$c_proto | ($in, $out [, $calling_convention])]);
+
+See L</DESCRIPTION>.
+
+=head3 Import
+ $obj = Win32::API::More->Import([$dllname | (undef , $funcptr)], [$c_proto | ($in, $out [, $calling_convention])]);
+
+See L</DESCRIPTION>.
+
+=head2 METHODS
+
+=head3 Call
+
+The main method of a Win32::API object. Documented elsewhere in this document.
+
+=head3 UseMI64
+
+ $bool = $APIObj->UseMI64();
+ $oldbool = $APIObj->UseMI64($newbool);
+
+Turns on Quads as L<Math::Int64> objects support for a particular object
+instance. You must call L<perlfunc/use>/L<perlfunc/require> on Math::Int64
+before calling UseMI64. Win32::API does not C<use> Math::Int64 for you.
+Works on Win32::API and Win32::API::Callback objects. This method
+does not exist if your Perl natively supports Quads (64 bit Perl for example).
+Takes 1 optional parameter, which is a true or false value to use or don't use
+Math::Int64, returns the old setting, which is a true or false value. If called
+without any parameters, returns current setting, which is a true or false value,
+without setting the option. As discussed in L</q>, if you are not using
+Math::Int64 you must supply/will receive 8 byte scalar strings for quads.
+For "in" params in Win32::API and Win32::API::More and "out" in
+Win32::API::Callback only, if the argument is a reference, it will automatically
+be treated as a Math::Int64 object without having to previously call this
+function.
+
+=head2 VERBOSE DEBUGGING
+
+If using C<Win32::GetLastError> and C<$^E> does not reveal the problem with your
+use of Win32::API, you may turn on Win32::API's very verbose debugging mode as
+follows
+
+ BEGIN {
+ $Win32::API::DEBUG = 1;
+ }
+ use Win32::API;
+ $function = Win32::API::More->new(
+ 'mydll', 'int sum_integers(int a, int b)'
+ );
+
+=head1 HISTORY
+
+=over 4
+
+=item UseMI64 API change
+
+Starting in 0.71, UseMI64 on a set returns old value, not previously
+new value.
+
+=item fork safe
+
+Starting in 0.71, a Win32::API object can go through a fork and work
+correctly in the child and parent psuedo-processes. Previously when either
+psuedo-processes exited, the DLL would be unloaded and the other
+psuedo-processes would crash if a Call() was done on the object.
+
+=item return value signedness
+
+Prior to 0.69, for numeric integer types, the return scalar was always signed.
+Unsigned-ness was ignored.
+
+=item shorts
+
+Prior to 0.69, shorts were not supported. 'S' meant a sturct. To fix this
+Win32::API::More class was created for 0.69. 'S'/'s' now means short, per pack's
+letters. Struct has been moved to letter 'T'. Win32::API will continue to exist
+for legacy code.
+
+=item float return types
+
+Prior to 0.69, if a function had a return type of float, it was silently
+not called.
+
+=item buffer overflow protection
+
+Introduced in 0.69. If disabling is required, which is highly
+B<not recommended>, set an environmental variable called
+WIN32_API_SORRY_I_WAS_AN_IDIOT to 1.
+
+=item automatic un/pack
+
+Starting with 0.69, when using Win32::API::More, there is automatic un/packing
+of pointers to numbers-ish things for in parameters when using the C
+prototype interface.
+
+=item Quads on 32 bit
+
+Added in 0.70.
+
+=item __stdcall vs __cdecl checking on 32 bits
+
+Added in 0.76_01
+
+=item Import returns an api obj on success, undef on failure, instead of 1 or 0
+
+Added in 0.76_02
+
+=item checking C<$!> for C<new>/C<Import> failure is broken and deprecated
+
+Starting in 0.76_06, due to many bugs with C<new> and C<Import> not setting
+L<perlvar/$!> or Win32 and C error codes overlapping and Win32 error codes being
+stringified as different C error codes, checking C<$!> is deprecated and the
+existing, partial setting of C<$!>, maybe removed in the future. Only check
+C<Win32::GetLastError()> or C<$^E> to find out why the call failed.
+
+=back
+
+See the C<Changes> file for more details, many of which not mentioned here.
+
+=head1 BUGS AND LIMITATIONS
+
+=over 4
+
+=item E<nbsp> Unicode DLL paths
+
+Untested.
+
+=item E<nbsp> ithreads
+
+Minimally tested.
+
+=item E<nbsp> C functions getting utf8 scalars vs byte scalars
+
+Untested and undefined.
+
+=back
+
+=head1 SEE ALSO
+
+L<Math::Int64>
+
+L<Win32::API::Struct>
+
+L<Win32::API::Type>
+
+L<Win32::API::Callback>
+
+L<Win32::API::Callback::IATPatch>
+
+L<http://homepage.ntlworld.com/jonathan.deboynepollard/FGA/function-calling-conventions.html>
+
=head1 AUTHOR
Aldo Calpini ( I<dada@perl.it> ).
@@ -782,6 +1441,10 @@ Aldo Calpini ( I<dada@perl.it> ).
Cosimo Streppone ( I<cosimo@cpan.org> )
+=head1 MAJOR CONTRIBUTOR
+
+Daniel Dragan ( I<bulkdd@cpan.org> )
+
=head1 LICENSE
To finally clarify this, C<Win32::API> is OSI-approved free software;
@@ -795,7 +1458,7 @@ See L<http://dev.perl.org/licenses/artistic.html>
All the credits go to Andrea Frosini for the neat assembler trick
that makes this thing work. I've also used some work by Dave Roth
for the prototyping stuff. A big thank you also to Gurusamy Sarathy
-for his unvaluable help in XS development, and to all the Perl
+for his invaluable help in XS development, and to all the Perl
community for being what it is.
Cosimo also wants to personally thank everyone that contributed