Win32::API 无法处理char**
。您需要自己提取字符串。
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
未经测试。
我使用 WIDE 接口而不是 ANSI 接口。使用 ANSI 接口受到不必要的限制。
PS — 我编写了 John Zwinck 链接到的代码。