NativeCall到Windows API函数RegEnumKeyExW导致输出不一致和不完整

Question

我有一些使用 NativeCall 模块来调用 Windows API 的 Raku 代码：

#! /usr/bin/env raku
use v6;

use NativeCall;

constant BYTE    = uint8;
constant WCHAR   = uint16;   
constant DWORD   = int32;    
constant REGSAM  = int32;
constant WCHARS  = CArray[WCHAR];
constant BYTES   = CArray[BYTE];

constant HKEY_LOCAL_MACHINE = 0x80000002;
constant KEY_QUERY_VALUE   = 0x1 +| 0x0008;
constant ERROR_SUCCESS     = 0; # Yeah, I know. The Win-Api uses 0 for success and other values to indicate errors

sub RegOpenKeyExW( DWORD, WCHARS, DWORD, REGSAM, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };


sub RegQueryValueExW( DWORD, WCHARS, DWORD is rw, DWORD is rw, BYTE is rw, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };

my $key = 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths';

my DWORD $hkey;
my $length = 1024;

sub wstr( Str $str ) returns WCHARS {
    my $return = CArray[WCHAR].new( $str.encode.list );
    $return[$return.elems] = 0;
    return $return;
}

my $h-key = RegOpenKeyExW(HKEY_LOCAL_MACHINE, wstr($key), 0, KEY_QUERY_VALUE, $hkey);
say "hkey: $hkey";


sub RegQueryInfoKeyW( int32, int32, int32, int32, int32 is rw, int32 is rw, int32, int32, int32, int32, int32, int32    ) returns int32 is native('kernel32') { * };
my $blah = RegQueryInfoKeyW( $hkey, 0, 0, 0, my int32 $num-subkeys, my int32 $max-sk-len, 0, 0, 0, 0, 0, 0);
say 'max subkey length: ' ~ $max-sk-len;

#arg   name
#1     hkey:        handle to an open reg. key
#2     dwIndex:     the index of the subkey to retrieve
#3     lpName:      pointer to a buffer
#4     lpccName:    pointer to a variable that specifies the size of the buffer specified by lpName param
#5     lpReserved:  unused
#6     lpClass:     pointer to a buffer, can be null
#7     lpcchClass:  pointer to a variable, can be null
#8     lpftLastWriteTime: pointer to a file structure, can be null
sub RegEnumKeyExW(
    int32,                # 1
    int32,                # 2
    CArray[uint16],       # 3
    int32 is rw,          # 4
    int32,                # 5
    CArray[int16],        # 6
    int32,                # 7
    int32                 # 8
) returns int32 is native('kernel32') { * };

my $count;
for 0..$num-subkeys - 1 {
    my $subkeyname = CArray[uint16].new;
    $subkeyname[$_] = 0 for 0..$max-sk-len;
    say 'bing';
    my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
    say 'bang';
    my $name = '';
    for 0..$max-sk-len - 1 {
        $name ~= chr($subkeyname[$_]);
    }

    say $name;
    say '';
    $count++;

}
say $count;

奇怪的是，该代码仅部分有效。代码中重复调用的最后一个 for 循环RegEnumKeyExW不会迭代所有子项并崩溃，导致输出如下所示：

PS Z:\devel> raku RegOpenKeyExW.raku
hkey: 588
max subkey length: 26
bing
bang
cmmgr32.exe

bing
bang
dfshim.dll

bing
bang
fsquirt.exe

<snip>

bing
bang
wab.exe

bing
bang
wabmig.exe

bing
bang
wmplayer.exe

bing

呼叫RegEnumKeyExW突然就挂掉了，没有任何警告。有时该调用会进行 10 次迭代，有时会更少，有时会更少，但它永远不会完成整个循环。

任何人都知道问题可能是什么？

更新：非常奇怪，如果我收紧最后一个循环并删除所有无关的打印语句和构建 的内部循环$subkyename，则所有子项都会成功迭代（循环完成）。

如果我修改最后一个循环以包含一个内部循环以将字符打印到屏幕上，则成功的迭代次数取决于变量设置的打印字符数$printx。因此，当打印大量字符（例如 1000 个）时，循环仅完成一次就会失败。如果我只打印 5 个字符，则循环将进行大约 15 次迭代。如果我删除打印字符的内部循环，则循环每次都会完成。看：

my $count;
my $printx = 5; # changing this value higher or lower will change how many iterations complete before an iteration fails.  
for 0..$num-subkeys - 1 {
    my $subkeyname = CArray[uint16].new;
    $subkeyname[$_] = 0 for 0..$max-sk-len;
    say 'bing';
    my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
    for 0..$printx {
        print 'x';
    }
    $count++;

}
say $count;

更新＃2：如果我摆脱循环并将其替换为手动键入的 19 （子项的数量）调用RegEnumKeyExW，一切都会完美运行。

Answer 1

raku-irc 上一位知识渊博的人让我设置了MVM_SPESH_DISABLE=1powershell 环境。设置好后，问题就解决了。所以 Moar VM 存在某种错误。

我找到了一个解决方法，即将RegEnumKeyExW函数移动到循环中：

for 0..$num-subkeys - 1 {

    #arg   name
    #1     hkey:        handle to an open reg. key
    #2     dwIndex:     the index of the subkey to retrieve
    #3     lpName:      pointer to a buffer
    #4     lpccName:    pointer to a variable that specifies the size of the buffer specified by lpName param
    #5     lpReserved:  unused
    #6     lpClass:     pointer to a buffer, can be null
    #7     lpcchClass:  pointer to a variable, can be null
    #8     lpftLastWriteTime: pointer to a file structure, can be null
    sub RegEnumKeyExW(
        int32,                # 1
        int32,                # 2
        CArray[uint16],       # 3
        int32 is rw,          # 4
        int32,                # 5
        CArray[int16],        # 6
        int32,                # 7
        int32                 # 8
    ) returns int32 is native('kernel32') { * };

    my $subkeyname = CArray[uint16].new;
    $subkeyname[$_] = 0 for 0..$max-sk-len;
    my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
    for 1..200 {
        print 'x';
    }
    my $name = '';
    for 0..$max-sk-len - 1 {
        $name ~= chr($subkeyname[$_]);
    }

    say $name;

}