Perl Win32 :: API и указатели

Question

Я пытаюсь использовать функцию Win32 API DsGetSiteName () с помощью Perl-модуля Win32 :: API. Согласно Windows SDK, прототип функции для DsGetSiteName:

DWORD DsGetSiteName(LPCTSTR ComputerName, LPTSTR *SiteName)

Я успешно написал небольшую функцию C ++, используя этот API, чтобы лучше понять, как она на самом деле работает (я изучаю C ++ самостоятельно, но отвлекся).

Во всяком случае, исходя из моего понимания документации API, второй параметр должен быть указателем на переменную, которая получает указатель на строку. В своем коде C ++ я написал это как:

LPSTR site;
LPTSTR *psite = &site;

и успешно вызвали API с помощью указателя psite.

Теперь мой вопрос: есть ли способ сделать то же самое, используя 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 для разыменования этого адреса, чтобы получить строку?

Заранее спасибо.

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 - я написал код, с которым связывался Джон Цвинк.

Answer 2

Я думаю, что вы правы насчет $ site, содержащего адрес строки.Вот некоторый код, который демонстрирует использование выходного параметра с модулем Perl Win32: http://www.perlmonks.org/?displaytype=displaycode;node_id=890698