Perl Win32::API和指针

Question

我正在尝试使用Perl的Win32 :: API模块利用Win32 API函数DsGetSiteName()。根据Windows SDK，DsGetSiteName的函数原型为：

DWORD DsGetSiteName(LPCTSTR ComputerName, LPTSTR *SiteName)

我成功地使用这个API编写了一个小的C++函数，以更好地理解它实际上是如何工作的（我自学C++，但我离题了）。

无论如何，从我对API文档的理解来看，第二个参数应该是指向一个变量的指针，该变量接收一个指向字符串的指针。在我的C++代码中，我将其写成：

LPSTR site;
LPTSTR *psite = &site;

我已经使用psite指针成功调用了API。现在我的问题是，是否可以使用Perl的Win32::API来做同样的事情？我尝试了以下Perl代码：

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;

调用后，$DsResult的结果为零（表示成功），但$site中的数据不是我想要的，看起来是ASCII和非可打印字符的混合。

$site变量可能保存了分配字符串的指针地址吗？如果是这样，是否有一种使用Win32::API解除引用该地址以获取字符串的方法？

提前致谢。

- Eugene C.

Answer 1

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;
}

除了decode_LPCWSTR外，其他都未经测试。

我使用了WIDE接口而不是ANSI接口。使用ANSI接口是毫无必要的限制。

PS - 我写了John Zwinck链接的代码。

- ikegami

---

非常感谢ikegami提供的解决方案！pack/unpack函数正是我特别需要的。 - Eugene C.

@Eugene C.，缺少了 ."\0"。 - ikegami

Answer 2

我认为你对于$site保存字符串地址的理解是正确的。以下是一段代码，演示了在Perl的Win32模块中使用输出参数： http://www.perlmonks.org/?displaytype=displaycode;node_id=890698

- John Zwinck

---

谢谢。你的链接引导我了解了Perl的pack/unpack函数，这正是我所需要的，直到ikegami发布了一个解决方案。 :) - Eugene C.