NativeCall to Windows API function RegEnumKeyExW resulting in inconsistent and incomplete output - winapi

I have some Raku code using the NativeCall module to make calls to the Windows API:
#! /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;
Weirdly, the code only partially works. The last for loop in the code, which repeatedly calls RegEnumKeyExW does not iterate over the entire number of subkeys and crashes, resulting in output that looks like this:
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
The call to RegEnumKeyExW just suddenly craps out with no warning. Sometimes the call makes it through 10 iterations, sometimes fewer and sometimes less, but it never makes it through the whole loop.
Anyone have any ideas what the problem might be?
UPDATE: Very weirdly, if I tighten up the last loop and remove all extraneous print statements and the inner loop that builds the $subkyename, all the subkeys are iterated over successfully (the looping finishes).
If I modify the last loop to include an inner loop to print characters to the screen, the number of iterations that succeed is dependent upon the number of characters printed as set by the $printx variable. So with a large number of characters printed, say 1000, the loop only completes once before failing. If I print out a only 5 characters, the loop will make it through about 15 iterations. If I remove the inner loop that prints characters, the loop finishes every time. See:
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;
UPDATE #2: If I get rid of the loop and replace it with 19 (the number of subkeys) manually typed out calls to RegEnumKeyExW, everything works perfectly.

A knowledgeable person on raku-irc had me set MVM_SPESH_DISABLE=1 in the powershell environment. Once set, the problem was resolved. So there is some kind of bug with the Moar VM.
I found a workaround, which is to move the RegEnumKeyExW function into the loop:
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;
}

Related

From Raku/Perl6, how to read this registry key?

Windows
With Raku/Perl6, how do I use NativeCall to read the value of
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\ "EnableLUA"]
with RegQueryValueExW?
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regqueryvalueexw
Many thanks,
-T
edit 12-27-2019 #1: removing bad code and inserting new code
This is how far I have gotten.
Test run string:
K:\Windows\NtUtil>perl6 -I. -e "use WinMount :GetLUA; say GetLUA();"
RegOpenKeyExW
RegOpenKeyExW RtnCode 0
RegQueryValueExW
1
2
RegQueryValueExW RtnCode 87 (87 = ERROR_INVALID_PARAMETER)
lpData pointer 0
lpcbData data length 0
RegCloseKey
RegCloseKey RtnCode 0
True
WinMount.pm6
# unit module WinMount;
# WinMount.pm6#`{
Utilities to mount and dismound drive partitions
Note: LUA must be unset (0x00000000) for mount to function prpoperly
raku -I. -c WinMount.pm6
}
use NativeCall;
use WinPopUps :WinMsg;
# Reference to types and values: http://dsource.org/projects/tango/ticket/820
constant BYTE := uint8;
constant WCHAR := uint16;
constant DWORD := int32;
constant REGSAM := int32;
constant WCHARS := CArray[WCHAR];
constant BYTES := CArray[BYTE];
constant HKEY_CURRENT_USER = 0x80000001;
constant HKEY_LOCAL_MACHINE = 0x80000002;
constant KEY_QUERY_VALUE = 1;
constant ERROR_SUCCESS = 0; # Yeah, I know. The Win-Api uses 0 for success and other values to indicate errors
constant REG_SZ = 1;
constant KEY_READ = 0x20019;
constant KEY_SET_VALUE = 0x0002;
constant REG_DWORD = 0x00000004;
sub to-c-str( Str $str ) returns CArray[WCHAR] is export( :to-c-str ) {
my #str := CArray[WCHAR].new;
for ( $str.comb ).kv -> $i, $char { #str[$i] = $char.ord; }
#str[ $str.chars ] = 0;
#str;
}
sub wstr( Str $str ) returns WCHARS is export( :wstr ) {
CArray[WCHAR].new( $str.comb.map: *.ord )
}
sub GetLUA() is export( :GetLUA ) {
#`{
Returns the LUA value in the registry to True (0x00000001) or False (0x00000000)
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System]
"EnableLUA"=dword:00000000
https://docs.perl6.org/language/nativecall
Win32 return codes:
https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
}
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" { say "Sorry, $SubName only work in Windows."; exit; }
my Bool $LUA = True;
my $RtnCode;
my Str $SubKey = Q[SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\];
my Str $Key = Q[EnableLUA];
my $lpSubKey = wstr( $SubKey );
my $lpValueName = wstr( $Key );
# my $lpSubKey = CArray[uint8].new($Key.encode.list);
# my $lpValueName = CArray[uint8].new($SubKey.encode.list);
my int32 $Handle;
my int32 $ulOptions = 0;
my int32 $lpData;
my int32 $lpcbData;
my int32 $lpReserved = 1;
#`{
Open the key:
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regopenkeyexw
https://learn.microsoft.com/en-us/windows/win32/sysinfo/registry-key-security-and-access-rights
C++
LSTATUS RegOpenKeyExW(
HKEY hKey, # Hive name (HKEY_LOCAL_MACHINE)
LPCWSTR lpSubKey, # path to the key(/SOFTWARE/Microsoft/Windows/CurrentVersion/Policies/System/EnableLUA)
DWORD ulOptions, # 0
REGSAM samDesired, # KEY_READ (0x20019), KEY_SET_VALUE (0x0002)
PHKEY phkResult # A pointer to a variable that receives a handle to the opened key
);
}
say "RegOpenKeyExW";
sub RegOpenKeyExW( DWORD, WCHARS, DWORD, DWORD, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
$RtnCode = RegOpenKeyExW( HKEY_LOCAL_MACHINE, $lpSubKey, $ulOptions, KEY_READ, $Handle );
say "RegOpenKeyExW RtnCode $RtnCode\n";
#`{
Read the key:
use RegQueryValueExW if you know key and value name
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regqueryvalueexw
C++
LSTATUS RegQueryValueExW(
HKEY hKey, # Hive name (HKEY_LOCAL_MACHINE)
LPCWSTR lpValueName, # path to the key(\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA)
LPDWORD lpReserved, # give it "int32" without the quotes to give it a NULL
LPDWORD lpType, # Registry Value Type (REG_DWORD which is 32 bit)
LPBYTE lpData, # Pointer to the return value
LPDWORD lpcbData # number of bytes in the return value
);
}
say "RegQueryValueExW";
sub RegQueryValueExW( DWORD, WCHARS, DWORD, DWORD, DWORD is rw, DWORD is rw ) is native("Kernel32.dll") returns DWORD { * };
say "1";
$RtnCode = RegQueryValueExW( $Handle, $lpValueName, $lpReserved, REG_DWORD, $lpData, $lpcbData );
say "2";
say "RegQueryValueExW RtnCode $RtnCode (87 = ERROR_INVALID_PARAMETER)\nlpData pointer $lpData\nlpcbData data length $lpcbData\n";
#`{
Close the key
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regclosekey
C++
LSTATUS RegCloseKey(
HKEY hKey # handle to the open key to be closed. See RegOpenKeyExW phkResult
);
}
say "RegCloseKey";
sub RegCloseKey( DWORD ) is native("Kernel32.dll") returns DWORD { * };
$RtnCode = RegCloseKey( $Handle );
say "RegCloseKey RtnCode $RtnCode\n";
return $LUA;
}
Here's what I have so far. I am able to successfully retrieve the handle for the registry key, but when I try to read the key it throws "Native call expected argument that references a native integer, but got P6int". And I don't know why yet. But I figured I post this already, maybe someone else can shed some light.
use NativeCall;
constant BYTE := uint8;
constant WCHAR := uint16;
constant DWORD := int32;
constant REGSAM := int32;
constant WCHARS := CArray[WCHAR];
constant BYTES := CArray[BYTE];
constant HKEY_CURRENT_USER = 0x80000001;
constant HKEY_LOCAL_MACHINE = 0x80000002;
constant KEY_QUERY_VALUE = 1;
constant ERROR_SUCCESS = 0; # Yeah, I know. The Win-Api uses 0 for success and other values to indicate errors
constant REG_SZ = 1;
sub RegOpenKeyExW( DWORD, WCHARS, DWORD, REGSAM, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
#DWORD RegOpenKeyExW(
# HKEY hKey,
# LPCWSTR lpSubKey,
# DWORD ulOptions,
# REGSAM samDesired,
# PHKEY phkResult
#);
sub RegQueryValueExW( DWORD, WCHARS, DWORD is rw, DWORD is rw, BYTE is rw, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
#DWORD RegQueryValueExW(
# HKEY hKey,
# LPCWSTR lpValueName,
# LPDWORD lpReserved,
# LPDWORD lpType,
# LPBYTE lpData,
# LPDWORD lpcbData
#);
my $key = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System';
my DWORD $hkey;
my $length = 1024;
if RegOpenKeyExW(HKEY_LOCAL_MACHINE, wstr($key), 0, KEY_QUERY_VALUE, $hkey) == ERROR_SUCCESS
{
say "Got handle: $hkey";
my BYTES $buffer = CArray[BYTE].new( 0 xx 1024 );
# throws "Native call expected argument that references a native integer, but got P6int"
if RegQueryValueExW( $hkey, WCHARS, DWORD, REG_SZ, $buffer, $length ) == ERROR_SUCCESS
{
say "Got data of length $length";
say gather for 0 .. $length { take $buffer[$_] };
}
}
sub wstr( Str $str ) returns WCHARS {
CArray[WCHAR].new( $str.comb.map: *.ord )
}

Calling the GetUserName WinAPI function with a mutable string doesn't populate the string

This appears to partially work but I cannot get the string value to print
pub fn test() {
let mut buf: Vec<u16> = vec![0; 64];
let mut sz: DWORD = 0;
unsafe {
advapi32::GetUserNameW(buf.as_mut_ptr(), &mut sz);
}
let str1 = OsString::from_wide(&buf).into_string().unwrap();
println!("Here: {} {}", sz, str1);
}
Prints:
Here: 10
When I expect it to also print
Here: 10 <username>
As a test, the C version
TCHAR buf[100];
DWORD sz;
GetUserName(buf, &sz);
seems to populate buf fine.
GetUserName
You should re-read the API documentation for GetUserName to recall how the arguments work:
lpnSize [in, out]
On input, this variable specifies the size of the
lpBuffer buffer, in TCHARs. On output, the variable receives the
number of TCHARs copied to the buffer, including the terminating null
character. If lpBuffer is too small, the function fails and
GetLastError returns ERROR_INSUFFICIENT_BUFFER. This parameter
receives the required buffer size, including the terminating null
character.
TL;DR:
On input: caller tells the API how many spaces the buffer has.
On success: API tells the caller how many spaces were used.
On failure: API tells the caller how many spaces were needed.
C version
This has a fixed-size stack-allocated array of 100 TCHARs.
This code is broken and unsafe because sz is uninitialized. This allows the API to write an undefined number of characters to a buffer that's only 100 long. If the username is over 100 characters, you've just introduced a security hole into your program.
Rust version
The Rust code is broken in a much better way. sz is set to zero, which means "you may write zero entries of data", so it writes zero entries. Thus, the Vec buffer is full of zeros and the resulting string is empty. The buffer is reported too small to receive the username, so GetUserNameW sets sz to the number of characters that the buffer needs to have allocated.
What to do
One "fix" would be to set sz to the length of your array. However, this is likely to have over- or under-allocated the buffer.
If you are ok with a truncated string (and I'm not sure if TCHAR strings can be split arbitrarily, I know UTF-8 cannot), then it would be better to use a fixed-size array like the C code.
If you want to more appropriately allocate memory to call this type of WinAPI function, see What is the right way to allocate data to pass to an FFI call?.
extern crate advapi32;
extern crate winapi;
use std::ptr;
fn get_user_name() -> String {
unsafe {
let mut size = 0;
let retval = advapi32::GetUserNameW(ptr::null_mut(), &mut size);
assert_eq!(retval, 0, "Should have failed");
let mut username = Vec::with_capacity(size as usize);
let retval = advapi32::GetUserNameW(username.as_mut_ptr(), &mut size);
assert_ne!(retval, 0, "Perform better error handling");
assert!((size as usize) <= username.capacity());
username.set_len(size as usize);
// Beware: This leaves the trailing NUL character in the final string,
// you may want to remove it!
String::from_utf16(&username).unwrap()
}
}
fn main() {
println!("{:?}", get_user_name()); // "IEUser\u{0}"
}

Using Perl, how can obtain information about the icons in Windows' taskbar notification area?

I am trying to write a script in Perl to read all the icons in the system tray, grab their co-ordinates & find out who owns them. I am pretty much trying to translate this code here.
Here is my code so far:
use strict;
use warnings;
use Win32::API;
use Win32::OLE qw(in);
use Data::Dumper;
use constant wbemFlagReturnImmediately => 0x10;
use constant wbemFlagForwardOnly => 0x20;
use constant SYNCHRONIZE => 0x00100000;
use constant STANDARD_RIGHTS_REQUIRED => 0x000F0000;
use constant PROCESS_ALL_ACCESS => (STANDARD_RIGHTS_REQUIRED | SYNCHRONIZE | 0xFFF);
my $TB_BUTTONCOUNT = 0x0418;
my $TB_GETBUTTONTEXT = 0x041B;
my $TB_GETBUTTONINFO = 0x0441;
my $TB_GETITEMRECT = 0x041D;
my $TB_GETBUTTON = 0x0417;
sub get_windows_details {
my ($self) = #_;
my $ret;
my $objWMIService =
Win32::OLE->GetObject("winmgmts:\\\\localhost\\root\\CIMV2")
or die "WMI connection failed.\n";
my $colItems =
$objWMIService->ExecQuery("SELECT * FROM Win32_OperatingSystem",
"WQL",
wbemFlagReturnImmediately | wbemFlagForwardOnly);
my $objItem;
foreach $objItem (in $colItems) {
$ret->{'osname'} = $objItem->{Caption};
}
$colItems =
$objWMIService->ExecQuery("SELECT * FROM Win32_Processor",
"WQL",
wbemFlagReturnImmediately | wbemFlagForwardOnly);
foreach $objItem (in $colItems) {
$ret->{'osbit'} = $objItem->{AddressWidth};
}
return $ret;
}
sub get_autoit_tray_handle {
my $autoit = Win32::OLE->new("AutoItX3.Control")
or return 0;
my $tray_hwnd = $autoit->ControlGetHandle("[Class:Shell_TrayWnd]", "", "[Class:ToolbarWindow32;Instance:1]");
return hex $tray_hwnd;
}
sub get_tray_icon_count {
#my $hWnd = get_tray_handle();
my $hWnd = get_autoit_tray_handle();
my $send_message = Win32::API->new("user32", "SendMessage", "NNII", "I");
return $send_message->Call($hWnd, $TB_BUTTONCOUNT, 0, 0);
}
# Randomly chosen icon index.
my $iIndex = 6;
my $os = get_windows_details();
if ($os->{'osbit'} == 64) {
Win32::API::Struct->typedef('TBBUTTON', qw { int iBitmap;
int idCommand;
BYTE fsState;
BYTE fsStyle;
BYTE bReserved[6];
DWORD_PTR dwData;
INT_PTR iString;
}
) or die "Typedef error $!\n";
} else {
Win32::API::Struct->typedef('TBBUTTON', qw { int iBitmap;
int idCommand;
BYTE fsState;
BYTE fsStyle;
BYTE bReserved[2];
DWORD_PTR dwData;
INT_PTR iString;
}
) or die "Typedef error $!\n";
}
# Get tray handle & it's proc id
my $tb_button = Win32::API::Struct->new('TBBUTTON');
my $tray_hwnd = get_autoit_tray_handle();
print "tray hwnd: $tray_hwnd\n";
my $window_thread_proc_id = Win32::API->new('user32', "GetWindowThreadProcessId", 'LP', 'N');
my $lpdwPID = pack 'L', 0;
my $pid = $window_thread_proc_id->Call($tray_hwnd, $lpdwPID);
my $dwPID = unpack 'L', $lpdwPID;
print "proc id: $dwPID\n";
# read the tray process memory to get the tray button info
my $open_process = Win32::API->new('kernel32', 'OpenProcess', 'NIN', 'N') || die $!;
my $proc_hwnd = $open_process->Call(PROCESS_ALL_ACCESS, 0, $dwPID);
print "proc hwnd: $proc_hwnd\n";
my $virtual_alloc = Win32::API->new('kernel32', 'VirtualAllocEx', 'NNLNN', 'N');
my $lp_data = $virtual_alloc->Call($proc_hwnd, 0, $tb_button->sizeof(), 0x1000, 0x04);
print "Error allocating memory: $!\n" if $!;
print "Allocated addresss: $lp_data\n";
my $send_message = Win32::API->new('user32', 'SendMessage', 'NNIN','I');
my $get_button_status = $send_message->Call($tray_hwnd, $TB_GETBUTTON, $iIndex, $lp_data);
print "TB_GETBUTTON Status: $get_button_status\n";
my $read_process = Win32::API->new('kernel32', 'ReadProcessMemory', 'NNSNP','I');
my $bytes_read = pack 'L', 0;
$read_process->Call($proc_hwnd, $lp_data, $tb_button, $tb_button->sizeof(), $bytes_read);
print "dwData: $tb_button->{'dwData'} \n";
I am using autoit COM DLL to get the system tray handle. Once I have the have the tray handle, I try to get it's process id & then read the process memory to get the TBBUTTON structure, which is defined as follows:
if ($os->{'osbit'} == 64) {
Win32::API::Struct->typedef('TBBUTTON', qw { int iBitmap;
int idCommand;
BYTE fsState;
BYTE fsStyle;
BYTE bReserved[6];
DWORD_PTR dwData;
INT_PTR iString;
}
) or die "Typedef error $!\n";
} else {
Win32::API::Struct->typedef('TBBUTTON', qw { int iBitmap;
int idCommand;
BYTE fsState;
BYTE fsStyle;
BYTE bReserved[2];
DWORD_PTR dwData;
INT_PTR iString;
}
) or die "Typedef error $!\n";
}
When you execute the above code, at least on my system, here is the output I see:
tray hwnd: 401922
proc id: 11040
proc hwnd: 704
Allocated addresss: 32702464
TB_GETBUTTON Status: 1
dwData: 10293610267052867588
As you can see - the "dwData" seems to be wrong. Looks like I'm doing something wrong here:
my $read_process = Win32::API->new('kernel32', 'ReadProcessMemory', 'NNSNP','I');
my $bytes_read = pack 'L', 0;
$read_process->Call($proc_hwnd, $lp_data, $tb_button, $tb_button->sizeof(), $bytes_read);
print "dwData: $tb_button->{'dwData'} \n";
Any suggestions on what I'm doing wrong there? Thanks.
I decided to try to minimize the amount of uncertainty introduced by the various things you are pulling in, and just use the functionality provided by Win32::GuiTest. I also cheated with regard to bitness and structs so as to get something running on my 32-bit WinXP SP3 laptop. Here's something that runs and produces some output.
I am not sure if this is the right output, but it should at least point you in a simpler direction:
#!/usr/bin/env perl
use feature 'say';
use strict; use warnings;
use Const::Fast;
use Devel::CheckOS;
use Win32::GuiTest qw(
AllocateVirtualBuffer
FreeVirtualBuffer
ReadFromVirtualBuffer
FindWindowLike
SendMessage
);
use YAML;
const my %TB => (
BUTTONCOUNT => 0x0418,
GETBUTTONTEXT => 0x041B,
GETBUTTONINFO => 0x0441,
GETITEMRECT => 0x041D,
GETBUTTON => 0x0417,
);
const my %TBUTTON => (
32 => 'iiCCCCLL',
64 => 'iiCCCCCCCCLL',
);
my ($tray_handle) = FindWindowLike(undef, undef, 'TrayNotifyWnd');
my ($toolbar_handle) = FindWindowLike($tray_handle, undef, 'ToolbarWindow');
say for ($tray_handle, $toolbar_handle);
my $button_count = SendMessage($toolbar_handle, $TB{BUTTONCOUNT}, 0, 0);
unless (defined($button_count) and $button_count > 0) {
die "Can't find buttons\n"
}
my $buf = AllocateVirtualBuffer($toolbar_handle, 0x20);
print Dump $buf;
my $index = int(rand $button_count);
say "Trying button = $index\n";
my $status = SendMessage(
$toolbar_handle,
$TB{GETBUTTON},
$index,
$buf->{ptr}
);
say "TB_GETBUTTON status = $status";
my $result = ReadFromVirtualBuffer($buf, 0x20);
FreeVirtualBuffer($buf);
print Dump [ map sprintf('%X', $_), unpack $TBUTTON{32}, $result ];
Also, not that you shoud define things like Win32::API functions and structs in one place and only once.
Sample output:
655544
393294
---
process: 1920
ptr: 28835840
Trying button = 19
TB_GETBUTTON status = 1
---
- 7
- 9
- C
- 0
- 0
- 0
- 1DA23C8
- 2B70590

Using CryptHashData On Very Large Input

I am trying to MD5 hash user-supplied data (a file) using The Crypto functions in AdvApi32. All is well and good unless the file is very large (hundreds of MB. or larger) in which case I eventually get an OutOfMemory exception.
I figured that the solution would be to make repeated calls to CryptHashData using the same HashObject and processing only (for example) 4096 bytes at a time.
This appears to work, but the returned hash is incorrect.
Function HashFile(File As FolderItem) As String
Declare Function CryptAcquireContextW Lib "AdvApi32" (ByRef provider as Integer, container as Integer, providerName as WString, _
providerType as Integer, flags as Integer) as Boolean
Declare Sub CryptDestroyHash Lib "AdvApi32" (hashHandle as Integer )
Declare Function CryptCreateHash Lib "AdvApi32" (provider as Integer, algorithm as Integer, key as Integer, flags as Integer, _
ByRef hashHandle as Integer) as Boolean
Declare Function CryptHashData Lib "AdvApi32" (hashHandle as Integer, data as Ptr, length as Integer, flags as Integer) as Boolean
Declare Function CryptGetHashParam Lib "AdvApi32" (hashHandle as Integer, type as Integer, value as Ptr, ByRef length as Integer, _
flags as Integer) as Boolean
Const HP_HASHVAL = &h0002
Const HP_HASHSIZE = &h0004
Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Const PROV_RSA_FULL = 1
Const CRYPT_NEWKEYSET = &h00000008
Const CALG_MD5 = &h00008003
Dim provider As Integer
Dim hashHandle As Integer
If Not CryptAcquireContextW(provider, 0, MS_DEF_PROV, PROV_RSA_FULL, 0) Then
If Not CryptAcquireContextW(provider, 0, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET) Then
Raise New RuntimeException
End If
End If
If Not CryptCreateHash(provider, CALG_MD5, 0, 0, hashHandle) Then
Raise New RuntimeException
End If
Dim dataPtr As New MemoryBlock(4096)
Dim bs As BinaryStream
bs = bs.Open(File)
dataPtr.StringValue(0, 4096) = bs.Read(4096)
Do
If CryptHashData(hashHandle, dataPtr, dataPtr.Size, 0) Then
dataPtr = New MemoryBlock(4096)
dataPtr.StringValue(0, 4095) = bs.Read(4096)
End If
Loop Until bs.EOF
Dim size as Integer = 4
Dim toss As New MemoryBlock(4)
If Not CryptGetHashParam(hashHandle, HP_HASHSIZE, toss, size, 0) Then
Raise New RuntimeException
End If
size = toss.UInt32Value(0)
Dim hashValue As New MemoryBlock(size)
If Not CryptGetHashParam(hashHandle, HP_HASHVAL, hashValue, size, 0) Then
Raise New RuntimeException
End If
CryptDestroyHash(hashHandle)
//Convert binary to hex
Dim hexvalue As Integer
Dim hexedInt As String
Dim src As String = hashValue.StringValue(0, hashValue.Size)
For i As Integer = 1 To LenB(src)
hexvalue = AscB(MidB(src, i, 1))
hexedInt = hexedInt + RightB("00" + Hex(hexvalue), 2)
next
Return LeftB(hexedInt, LenB(hexedInt))
End Function
What am I doing wrong here? The output I get is consistent, but wrong.
Did you check that msdn example on C++ ?
Very similar answer to your question.
I think the problem is that since you read the data in blocks of 4096 bytes - when the data is not a multiple of 4096 you endup including unwanted trailing 0's or possibly garbage values. Try bs.Read(1) instead of bs.Read(4096) in the loop: Loop Until bs.EOF in-order to test if correct hash is being calculated now. If successful adjust your loop to tackle the remainder (%4096) bytes separately.

ruby win32api & structs (VerQueryValue)

I am trying to call the standard Win32 API functions to get file version info, using the win32-api library.
The 3 version.dll functions are GetFileVersionInfoSize, GetFileVersionInfo, and VerQueryValue. Then I call RtlMoveMemory in kernel32.dll to get a copy of the VS_FIXEDFILEINFO struct (see Microsoft documentation: http://msdn.microsoft.com/en-us/library/ms646997%28VS.85%29.aspx).
I drew from an example I saw using VB: http://support.microsoft.com/kb/139491.
My problem is that the data that finally gets returned doesn't seem to match the expected struct, in fact it doesn't even return a consistent value. I suspect the data is getting mangled at some point, probably in VerQueryValue or RtlMoveMemory.
Here is the code:
GetFileVersionInfoSize = Win32::API.new('GetFileVersionInfoSize','PP','I','version.dll')
GetFileVersionInfo = Win32::API.new('GetFileVersionInfo','PIIP','I', 'version.dll')
VerQueryValue = Win32::API.new('VerQueryValue','PPPP','I', 'version.dll')
RtlMoveMemory = Win32::API.new('RtlMoveMemory', 'PPI', 'V', 'kernel32.dll')
buf = [0].pack('L')
version_size = GetFileVersionInfoSize.call(myfile + "\0", buf)
raise Exception.new if version_size == 0 #TODO
version_info = 0.chr * version_size
version_ok = GetFileVersionInfo.call(file, 0, version_size, version_info)
raise Exception.new if version_ok == 0 #TODO
addr = [0].pack('L')
size = [0].pack('L')
query_ok = VerQueryValue.call(version_info, "\\\0", addr, size)
raise Exception.new if query_ok == 0 #TODO
# note that at this point, size == 4 -- is that right?
fixed_info = Array.new(13,0).pack('L*')
RtlMoveMemory.call(fixed_info, addr, fixed_info.length)
# fixed_info.unpack('L*') #=> seemingly random data, usually only the first two dwords' worth and the rest 0.
This is the full code I got to work, in case others are looking for such a function.
Returns an array with four parts of product/file version number (i.e., what is called "File Version" in a dll file properties window):
def file_version ref, options = {}
options = {:path => LIBDIR, :extension => 'dll'}.merge(options)
begin
file = File.join(ROOT, options[:path],"#{ref}.#{options[:extension]}").gsub(/\//,"\\")
buf = [0].pack('L')
version_size = GetFileVersionInfoSize.call(file + "\0", buf)
raise Exception.new if version_size == 0 #TODO
version_info = 0.chr * version_size
version_ok = GetFileVersionInfo.call(file, 0, version_size, version_info)
raise Exception.new if version_ok == 0 #TODO
addr = [0].pack('L')
size = [0].pack('L')
query_ok = VerQueryValue.call(version_info, "\\\0", addr, size)
raise Exception.new if query_ok == 0 #TODO
fixed_info = Array.new(18,0).pack('LSSSSSSSSSSLLLLLLL')
RtlMoveMemory.call(fixed_info, addr.unpack('L')[0], fixed_info.length)
fixed_info.unpack('LSSSSSSSSSSLLLLLLL')[5..8].reverse
rescue
[]
end
end
The answer in https://stackoverflow.com/a/2224681/3730446 isn't strictly correct: the VS_FIXEDFILEINFO struct contains separate FileVersion and ProductVersion. That code returns a version number consisting of the two more-significant components of the ProductVersion and the two less-significant components of the FileVersion. Most times I've seen, that wouldn't matter because both Product- and FileVersion have the same value, but you never know what you might encounter in the wild.
We can see this by comparing the VS_FIXEDFILEINFO struct from http://msdn.microsoft.com/en-us/library/windows/desktop/ms646997(v=vs.85).aspx and the format string we're using to pack and unpack the buffer:
typedef struct tagVS_FIXEDFILEINFO {
DWORD dwSignature; // 0: L
DWORD dwStrucVersion; // 1: S
// 2: S
DWORD dwFileVersionMS; // 3: S
// 4: S
DWORD dwFileVersionLS; // 5: S
// 6: S
DWORD dwProductVersionMS; // 7: S
// 8: S
DWORD dwProductVersionLS; // 9: S
// 10: S
DWORD dwFileFlagsMask; // 11: L
DWORD dwFileFlags; // 12: L
DWORD dwFileOS; // 13: L
DWORD dwFileType; // 14: L
DWORD dwFileSubtype; // 15: L
DWORD dwFileDateMS; // 16: L
DWORD dwFileDateLS; // 17: L
} VS_FIXEDFILEINFO;
Subscripts 5 to 8, then, consists of dwFileVersionLS and dwProductVersionMS. Getting FileVersion and ProductVersion correctly would look like this:
info = fixed_info.unpack('LSSSSSSSSSSLLLLLLL')
file_version = [ info[4], info[3], info[6], info[5] ]
product_version = [ info[8], info[7], info[10], info[9] ]

Resources