Perl的Win32 :: API和指針

我想利用Win32的API函數DsGetSiteName（）使用Perl的Win32 :: API模塊。根據Windows的SDK，函數原型爲DsGetSiteName是：Perl的Win32 :: API和指針

DWORD DsGetSiteName(LPCTSTR ComputerName, LPTSTR *SiteName)

我成功地使用這個API讓我的自己更好的理解它是如何將實際工作（我正在學習C++寫了一個小的C++函數，但我離題了）。

無論如何，從我對API文檔的理解中，第二個參數應該是一個指向變量的指針，它接收一個指向字符串的指針。在我的C++代碼中，我寫到：

並已成功使用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調用的結果是零（指成功），但在$網站上的數據是不是我想要的，它看起來是一個混合物，的ASCII和不可打印的字符。

$ site變量是否可以保存已分配字符串的指針地址？如果是這樣，是否有一種方法使用Win32 :: API解引用該地址來獲取字符串？

在此先感謝。

來源

2011-04-03 Eugene C.

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鏈接的代碼。

來源

2011-04-03 18:04:51 ikegami

非常感謝你ikegami爲您的解決方案！打包/解包功能是我特別需要的。 – 2011-04-04 13:06:30

@Eugene C.，'。「\ 0」'丟失。 – ikegami 2012-01-09 22:09:11

我認爲你是正確的$站點持有一個字符串的地址。下面的代碼演示瞭如何在Perl的Win32模塊中使用輸出參數： http://www.perlmonks.org/?displaytype=displaycode;node_id=890698

來源

2011-04-03 14:12:28

謝謝。你的鏈接引導我進入Perl的打包/解壓縮功能，這是我所需要的，直到ikegami發佈了一個解決方案。 :) – 2011-04-04 13:04:50

Perl的Win32 :: API和指針

回答

相關問題