Perl Win32 :: API et pointeurs

Question

J'essaie d'utiliser la fonction DsGetSiteName() de l'API Win32 en utilisant le module Win32 :: API de Perl. Selon le SDK Windows, le prototype de fonction pour DsGetSiteName est:

DWORD DsGetSiteName(LPCTSTR ComputerName, LPTSTR *SiteName) 

j'ai écrit avec succès une petite fonction C++ en utilisant cette API pour obtenir une meilleure compréhension de la façon dont il fait travailler (j'apprends C++ sur mon propre , mais je m'égare).

De toute façon, d'après ma compréhension de la documentation de l'API, le deuxième paramètre est censé être un pointeur vers une variable qui reçoit un pointeur vers une chaîne. Dans mon code C++, je l'ai écrit que:

et ont réussi appelé l'API à l'aide du pointeur de la psite. Maintenant, ma question est, est-il un moyen de faire la même chose en utilisant Win32 :: API de Perl? J'ai essayé le code Perl suivant:

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; 

et le résultat de l'appel en $ DsResult est égal à zéro (ce qui signifie le succès), mais les données dans le site $ est pas ce que je veux, il semble être un mélange de caractères ASCII et non imprimables.

La variable $ site peut-elle contenir l'adresse du pointeur de la chaîne allouée? Et si oui, est-il possible d'utiliser Win32 :: API pour déréférencer cette adresse pour obtenir la chaîne?

Merci d'avance.

Answer 1

Win32 :: API ne peut pas gérer char**. Vous devrez extraire la chaîne vous-même.

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

Tout sauf decode_LPCWSTR n'a pas été testé. J'ai utilisé l'interface WIDE à la place de l'interface ANSI. L'utilisation de l'interface ANSI limite inutilement.

PS — J'ai écrit le code auquel John Zwinck a lié.

Answer 2

Je pense que vous avez raison à propos de $ site contenant l'adresse d'une chaîne. Voici un code qui illustre l'utilisation d'un paramètre de sortie avec le module Perl Win32: http://www.perlmonks.org/?displaytype=displaycode;node_id=890698