Perl Win32 :: API y punteros

Estoy intentando utilizar la función de la API de Win32 DsGetSiteName () utilizando el módulo Win32 :: API de Perl. Según el SDK de Windows, la función prototipo para DsGetSiteName es:

DWORD DsGetSiteName(LPCTSTR ComputerName, LPTSTR *SiteName) 

Escribí con éxito una pequeña función de C ++ utilizando esta API para comprender mejor cómo funcionaría realmente (estoy aprendiendo C ++ por mi cuenta, pero estoy divagando).

De todos modos, desde mi entendimiento de la documentación de la API, se supone que el segundo parámetro es un puntero a una variable que recibe un puntero a una cadena. En mi código C ++, escribí eso como:

 LPSTR site; LPTSTR *psite = &site; 

y han llamado con éxito la API utilizando el puntero psite.

Ahora mi pregunta es, ¿hay una manera de hacer lo mismo usando Win32 :: API de Perl? He probado el siguiente código 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; 

y el resultado de la llamada en $ DsResult es cero (lo que significa éxito), pero los datos en $ site no son lo que quiero, parece ser una mezcla de caracteres ASCII y no imprimibles.

¿Podría la variable $ site mantener la dirección del puntero de la cadena asignada? Y si es así, ¿hay alguna manera de usar Win32 :: API para eliminar la referencia de esa dirección para obtener la cadena?

Gracias por adelantado.

Win32 :: API no puede manejar char** . Tendrás que extraer la cuerda tú mismo.

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

Todos menos decode_LPCWSTR no están probados.

Utilicé la interfaz WIDE en lugar de la interfaz ANSI. Usar la interfaz ANSI es innecesariamente limitante.

PD: escribí el código al que John Zwinck lo vinculó.

Creo que tienes razón acerca de $ site con la dirección de una cadena. Aquí hay algunos códigos que demuestran el uso de un parámetro de salida con el módulo Win32 de Perl: http://www.perlmonks.org/?displaytype=displaycode;node_id=890698