Perl Win32::API and Pointers - c++

Question

I'm trying to utilize the Win32 API function DsGetSiteName() using Perl's Win32::API module. According to the Windows SDK, the function prototype for DsGetSiteName is:
DWORD DsGetSiteName(LPCTSTR ComputerName, LPTSTR *SiteName)
I successfully wrote a small C++ function using this API to get a better understanding of how it would actually work (I'm learning C++ on my own, but I digress).
Anyhow, from my understanding of the API documentation, the second parameter is supposed to be a pointer to a variable that receives a pointer to a string. In my C++ code, I wrote that as:
LPSTR site;
LPTSTR *psite = &site;
and have successfully called the API using the psite pointer.
Now my question is, is there a way to do the same using Perl's Win32::API? I've tried the following Perl code:
my $site = " " x 256;
my $computer = "devwin7";
my $DsFunc = Win32::API->new("netapi32","DWORD DsGetSiteNameA(LPCTSTR computer, LPTSTR site)");
my $DsResult = $DsFunc->Call($computer, $site);
print $site;
and the result of the call in $DsResult is zero (meaning success), but the data in $site is not what I want, it looks to be a mixture of ASCII and non-printable characters.
Could the $site variable be holding the pointer address of the allocated string? And if so, is there a way using Win32::API to dereference that address to get at the string?
Thanks in advance.

Answer 1

Win32::API can't handle char**. You'll need to extract the string yourself.
use strict;
use warnings;
use feature qw( say state );
use Encode qw( encode decode );
use Win32::API qw( );
use constant {
NO_ERROR => 0,
ERROR_NO_SITENAME => 1919,
ERROR_NOT_ENOUGH_MEMORY => 8,
};
use constant PTR_SIZE => $Config{ptrsize};
use constant PTR_FORMAT =>
PTR_SIZE == 8 ? 'Q'
: PTR_SIZE == 4 ? 'L'
: die("Unrecognized ptrsize\n");
use constant PTR_WIN32API_TYPE =>
PTR_SIZE == 8 ? 'Q'
: PTR_SIZE == 4 ? 'N'
: die("Unrecognized ptrsize\n");
# Inefficient. Needs a C implementation.
sub decode_LPCWSTR {
my ($ptr) = #_;
return undef if !$ptr;
my $sW = '';
for (;;) {
my $chW = unpack('P2', pack(PTR_FORMAT, $ptr));
last if $chW eq "\0\0";
$sW .= $chW;
$ptr += 2;
}
return decode('UTF-16le', $sW);
}
sub NetApiBufferFree {
my ($Buffer) = #_;
state $NetApiBufferFree = Win32::API->new('netapi32.dll', 'NetApiBufferFree', PTR_WIN32API_TYPE, 'N')
or die($^E);
$NetApiBufferFree->Call($Buffer);
}
sub DsGetSiteName {
my ($ComputerName) = #_;
state $DsGetSiteName = Win32::API->new('netapi32.dll', 'DsGetSiteNameW', 'PP', 'N')
or die($^E);
my $packed_ComputerName = encode('UTF-16le', $ComputerName."\0");
my $packed_SiteName_buf_ptr = pack(PTR_FORMAT, 0);
$^E = $DsGetSiteName->Call($packed_ComputerName, $packed_SiteName_buf_ptr)
and return undef;
my $SiteName_buf_ptr = unpack(PTR_FORMAT, $packed_SiteName_buf_ptr);
my $SiteName = decode_LPCWSTR($SiteName_buf_ptr);
NetApiBufferFree($SiteName_buf_ptr);
return $SiteName;
}
{
my $computer_name = 'devwin7';
my ($site_name) = DsGetSiteName($computer_name)
or die("DsGetSiteName: $^E\n");
say $site_name;
}
All but decode_LPCWSTR is untested.
I used the WIDE interface instead of the ANSI interface. Using the ANSI interface is needlessly limiting.
PS — I wrote the code to which John Zwinck linked.

Answer 2

I think you're right about $site holding the address of a string. Here's some code that demonstrates the use of an output parameter with Perl's Win32 module:
http://www.perlmonks.org/?displaytype=displaycode;node_id=890698