<cafs@[...].com>  wrote on 05/20/2005 12:33:29 PM:

>  Not sure if this is a resend, I needed to subscribe to this list:
>  I am trying to use Win32::API to import by prototype only;
>  of the functions I have tried the ones with type LPTSTR fail;
>  I would like to just use the prototypes because if its packing functions
>  Win32::API::Struct and Win32::API::Type - see the example in API.pm
>  
>  example
>  
>  use Win32::API;

$Win32::API::DEBUG = 1;         # this may be useful

>  
>  #DWORD GetTempPath(
>  #  DWORD ccBuffer, 
>  #  LPTSTR lpszBuffer
>  #); 
>  
>  #Win32::API->Import("kernel32", "DWORD GetTempPath(DWORD ccBuffer, 
>  LPTSTR lpszBuffer)",);

# this allows success(1) or fail(0) to be checked
$rc = Win32::API-> Import("kernel32", "DWORD GetTempPath(DWORD ccBuffer, 
LPSTR lpszBuffer)",);

>  #this fails and causes generic a windows error when GetTempPath() is 
called
>  
>  Win32::API->Import('kernel32', 'GetTempPath', 'NP', 'N');
>  #this of course works, but I would like to use the prototype
>  #the example at the end of API.pm demonstrates using the prototype
>  
>  $lpszBuffer = " " x 80;
>  GetTempPath(80, $lpszBuffer);
>  
>  print $lpszBuffer;
 

This (with the changes above) fails for me, also. The program output is

(PM)Struct::recognize got 'ccBuffer', 'DWORD' ->  'L'
(PM)Struct::recognize got 'lpszBuffer', 'LPSTR' ->  'p'
(PM)parse_prototype: got PROC 'GetTempPath'
(PM)parse_prototype: got PARAMS 'DWORD ccBuffer, LPSTR lpszBuffer'
(PM)parse_prototype: IN='DWORD' PACKING='L' API_TYPE=1
(PM)parse_prototype: IN='LPSTR' PACKING='p' API_TYPE=2
parse_prototype: IN=[ 1 2 ]
parse_prototype: OUT='DWORD' PACKING='L' API_TYPE=1
(PM)Type::Unpack: unpacking 'p' 'C:\D'

Then I get an application error dialog box that says
"The instruction at 0x78001cf7" referenced memory at "0x445c3a43". The 
memory could not be "read".

I'm using Win32-API 0.41.1 - a 0.41 version modified by another subscriber 

to support cdecl calling convention. Is there a version newer than 0.41?

Stepping with the debugger, it appears that a bad value (coincidently, 
0x445c3a43, which is ascii 'C:\D') is getting picked up as the pointer
to the string variable data.

I don't know what's happening under the Win32::API hood (a lot of XS 
stuff).
I've included my program and a debug log below with the hope it may be 
useful to someone who has more smarts and time than I.

Let me know if anyone makes progress.

Lloyd

use Win32::API;

$Win32::API::DEBUG = 1;

# DWORD GetTempPath(
#   DWORD ccBuffer, 
#   LPSTR lpszBuffer
# ); 

$rc = Win32::API-> Import("kernel32", "DWORD GetTempPath(DWORD ccBuffer, 
LPSTR lpszBuffer)",);

#! Win32::API-> Import('kernel32', 'GetTempPath', 'NP', 'N');

$lpszBuffer = " " x 128;
GetTempPath(128, $lpszBuffer);

print $lpszBuffer;

-----------------------------------------------------------------------------
> > perl -d try.pl

Loading DB routines from perl5db.pl version 1.28
Editor support available.

Enter h or `h h' for help, or `perldoc perldebug' for more help.

Win32::API::Type::CODE(0x1cda6b0)(C:/Perl/site/lib/Win32/API/Type.pm:40):
40:         my $section = 'nothing';
  DB<1>  r
scalar context return from CODE(0x1cda6b0): ''
main::(try.pl:3):       $Win32::API::DEBUG = 1;
  DB<1>  l
3==>     $Win32::API::DEBUG = 1;
4
5       # DWORD GetTempPath(
6       #   DWORD ccBuffer,
7       #   LPSTR lpszBuffer
8       # );
9
11:     $rc = Win32::API-> Import("kernel32", "DWORD GetTempPath(DWORD 
ccBuffer,
LPSTR lpszBuffer)",);
13
14      #! Win32::API-> Import('kernel32', 'GetTempPath', 'NP', 'N');
17
18:     $lpszBuffer = " " x 128;
19:     GetTempPath(128, $lpszBuffer);
20
21:     print $lpszBuffer;
22
  DB<1>  c 11
main::(try.pl:11):      $rc = Win32::API-> Import("kernel32", "DWORD 
GetTempPath(
DWORD ccBuffer, LPSTR lpszBuffer)",);
  DB<2>  n
(PM)parse_prototype: got PROC 'GetTempPath'
(PM)parse_prototype: got PARAMS 'DWORD ccBuffer, LPSTR lpszBuffer'
(PM)parse_prototype: IN='DWORD' PACKING='L' API_TYPE=1
(PM)parse_prototype: IN='LPSTR' PACKING='p' API_TYPE=2
parse_prototype: IN=[ 1 2 ]
parse_prototype: OUT='DWORD' PACKING='L' API_TYPE=1
main::(try.pl:18):      $lpszBuffer = " " x 128;
  DB<2>  x $rc
0  1
  DB<3>  l
18==>    $lpszBuffer = " " x 128;
19:     GetTempPath(128, $lpszBuffer);
20
21:     print $lpszBuffer;
22
  DB<3>  n
main::(try.pl:19):      GetTempPath(128, $lpszBuffer);

# start stepping into Win32::API glue

  DB<3>  s
main::GetTempPath((eval 7)[C:/Perl/site/lib/Win32/API.pm:132]:2):
2:              sub main::GetTempPath { 
$Win32::API::Imported{"kernel32:DWORD Ge
tTempPath(DWORD ccBuffer, LPSTR lpszBuffer)"}-> Call(@_); }
  DB<3>  s

# Win32::API packs pointer to $lpszBuffer to pass to GetTempPath???

Win32::API::Type::Pack(C:/Perl/site/lib/Win32/API/Type.pm:189):
189:        my $type = $_[0];
  DB<3>  x @_
0  'LPSTR'
1  '
                                                    '
  DB<4>  l
189==>       my $type = $_[0];
190
191:        if(packing($type) eq 'c' and is_pointer($type)) {
192:            $_[1] = pack("Z*", $_[1]);
193:            return $_[1];
194         }
195:        $_[1] = pack( packing($type), $_[1]);
196:        return $_[1];
197     }
198
  DB<4>  n
Win32::API::Type::Pack(C:/Perl/site/lib/Win32/API/Type.pm:191):
191:        if(packing($type) eq 'c' and is_pointer($type)) {
  DB<4>  x packing($type),is_pointer($type)
0  'p'
1  1
  DB<5>  n
Win32::API::Type::Pack(C:/Perl/site/lib/Win32/API/Type.pm:195):
195:        $_[1] = pack( packing($type), $_[1]);
  DB<5>  x $_[1]
0  '
                                                    '
  DB<6>  print length($_[1])
128
  DB<7>  n
Win32::API::Type::Pack(C:/Perl/site/lib/Win32/API/Type.pm:196):
196:        return $_[1];
  DB<7>  x $_[1],length($_[1])
0  "\c\Èó\cA"
1  4
  DB<8>  printf "%08x\n",unpack('L',$_[1])
01e5e91c

# i believe that 0x01e5e91c is the true pointer to $lpszBuffer data

  DB<9>  s
Win32::API::Type::Unpack(C:/Perl/site/lib/Win32/API/Type.pm:200):
200:        my $type = $_[0];
  DB<9>  x @_
0  'LPSTR'
1  'C:\\D'
  DB<10>  printf "%08x\n",unpack('L',$_[1])
445c3a43

# how it got here with this value of $_[1] i don't understand

  DB<11>  l
200==>       my $type = $_[0];
201:        if(packing($type) eq 'c' and is_pointer($type)) {
202:            DEBUG "(PM)Type::Unpack: got packing 'c', is a pointer, 
unpackin
g 'Z*' '$_[1]'\n";
203:            $_[1] = unpack("Z*", $_[1]);
204:            DEBUG "(PM)Type::Unpack: returning '$_[1]'\n";
205:            return $_[1];
206         }
207:        DEBUG "(PM)Type::Unpack: unpacking '".packing($type)."' 
'$_[1]'\n";

208:        $_[1] = unpack( packing($type), $_[1]);
209:        DEBUG "(PM)Type::Unpack: returning '$_[1]'\n";
  DB<11>  s
Win32::API::Type::Unpack(C:/Perl/site/lib/Win32/API/Type.pm:201):
201:        if(packing($type) eq 'c' and is_pointer($type)) {
  DB<11>  x packing($type),is_pointer($type)
0  'p'
1  1
  DB<12>  n
Win32::API::Type::Unpack(C:/Perl/site/lib/Win32/API/Type.pm:207):
207:        DEBUG "(PM)Type::Unpack: unpacking '".packing($type)."' 
'$_[1]'\n";

  DB<12>  n
(PM)Type::Unpack: unpacking 'p' 'C:\D'
Win32::API::Type::Unpack(C:/Perl/site/lib/Win32/API/Type.pm:208):
208:        $_[1] = unpack( packing($type), $_[1]);

  DB<13>  s
Win32::API::Type::packing(C:/Perl/site/lib/Win32/API/Type.pm:126):
126:        my $self = shift;
  DB<13>  l
126==>       my $self = shift;
127:        my $is_pointer = 0;
128:        if(ref($self) =~ /Win32::API::Type/) {
129             # DEBUG "(PM)Type::packing: got an object\n";
130:            return $self-> {packing};
131         }
132:        my $type = ($self eq 'Win32::API::Type') ? shift : $self;
133:        my $name = shift;
134
135         # DEBUG "(PM)Type::packing: got '$type', '$name'\n";
  DB<13>  l
136:        my($modifier, $size, $packing);
137:        if(exists $Pointer{$type}) {
138             # DEBUG "(PM)Type::packing: got '$type', is really 
'$Pointer{$ty
pe}'\n";
139:            $type = $Pointer{$type};
140:            $is_pointer = 1;
141         } elsif($type =~ /(\w+)\s+(\w+)/) {
142:            $modifier = $1;
143:            $type = $2;
144             # DEBUG "(PM)packing: got modifier '$modifier', type 
'$type'\n";

145         }
  DB<13>  l
146
147:        $type =~ s/\*$//;
148
149:        if(exists $Known{$type}) {
150:            if(defined $name and $name =~ s/\[(.*)\]$//) {
151:                $size = $1;
152:                $packing = $Known{$type}[0]."*".$size;
153                 # DEBUG "(PM)Type::packing: composite packing: 
'$packing' '$
size'\n";
154             } else {
155:                $packing = $Known{$type};
  DB<13>  l
156:                if($is_pointer and $packing eq 'c') {
157:                   $packing = "p";
158                 }
159                 # DEBUG "(PM)Type::packing: simple packing: 
'$packing'\n";
160             }
161:            if(defined $modifier and exists 
$Modifier{$modifier}-> {$type}) {

162                 # DEBUG "(PM)Type::packing: applying modifier 
'$modifier' -> 
 '$Modifier{$modifier}-> {$type}'\n";
163:                $packing = $Modifier{$modifier}-> {$type};
164             }
165:            return $packing;
166         } else {
167             # DEBUG "(PM)Type::packing: NOT FOUND\n";
168:            return undef;
169         }
170     }
  DB<13>  c 165

# blows up here

Win32::API::Type::packing(C:/Perl/site/lib/Win32/API/Type.pm:165):
165:            return $packing;
  DB<14>  r
scalar context return from Win32::API::Type::packing: 'p'

> > # returned to command prompt with Win32 error dialog box


_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@[...].com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs