Hi All,
My latest three modules. two more in the works that use these:
WinReg.pm6
WinMessageBox
NativeConstants.pm6
WinReg.pm6 about killed me!
-T
<WinReg.pm6>
# unit module WinReg;
# WinReg.pm6
#`{
Utilities to operate on the Windows registry
perl6 -I. -c WinReg.pm6
Test one liner:
perl6 -I. -e "use WinMount :GetLUA; say GetLUA();"
perl6 -I. -e "use NativeConstants; use WinReg :WinReadRegKey;
say WinReadRegKey( HKEY_LOCAL_MACHINE,
Q[SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\system],
Q[EnableLUA], REG_DWORD, True ).base(16);"
perl6 -I. -e "use NativeConstants; use WinReg :WinReadRegKey;
say WinReadRegKey( HKEY_LOCAL_MACHINE, Q[SOFTWARE\Microsoft\Windows
NT\CurrentVersion], Q[ProductName], REG_SZ,True );"
References:
https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
https://docs.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regopenkeyexw
https://docs.microsoft.com/en-us/windows/win32/sysinfo/registry-key-security-and-access-rights
https://docs.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regqueryvalueexw
https://docs.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regclosekey
https://docs.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regclosekey
}
use NativeCall;
use NativeConstants;
use WinMessageBox :WinMsg;
sub to-c-str( Str $str ) returns CArray[WCHAR] {
my @str := CArray[WCHAR].new;
for ( $str.comb ).kv -> $i, $char { @str[$i] = $char.ord; }
@str[ $str.chars ] = 0;
@str;
}
sub OpenKey( WinRegHives $Hive, Str $SubKey, $Debug ) {
#`{
Open the key:
https://docs.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regopenkeyexw
https://docs.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
);
}
my Str $SubName = &?ROUTINE.name;
my int32 $Handle;
my int32 $RtnCode = 0;
my $lpSubKey = to-c-str( $SubKey );
my int32 $ulOptions = 0;
my int32 $lpData = 0;
my int32 $lpcbData = 1024; # In: the maximum amount of bytes
allowed in the return variable
# Out: the value of the key
my int32 $lpReserved = 0;
if $Debug { say "$SubName"; }
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 );
if not $RtnCode == 0 || $Debug == True {
my $ErrStr ="ERROR: $SubName\n Handle $Handle\n RtnCode
$RtnCode\n" ~
"Unable to open $Hive" ~ Q[\] ~ $SubKey ~ "\n";
say $ErrStr;
WinMsg( "Open Error", $ErrStr );
}
return $Handle;
}
sub CloseKey( int32 $Handle, $Debug ) {
#`{
Close the key
https://docs.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
);
}
my Str $SubName = &?ROUTINE.name;
my int32 $RtnCode = 0;
if $Debug { say "$SubName"; }
sub RegCloseKey( DWORD ) is native("Kernel32.dll") returns DWORD {
* };
$RtnCode = RegCloseKey( $Handle );
if not $RtnCode == 0 || $Debug == True {
say "ERROR: $SubName\n Handle $Handle\n RtnCode $RtnCode\n";
}
}
sub WinReadRegKey( WinRegHives $Hive, Str $SubKey, Str $KeyName,
ValueNames $ValueName, Bool $Debug = False ) is export( :WinReadRegKey
) {
#`{
Return "Any" value of $Hive\$SubKey\$KeyName
For Example:
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System]
"EnableLUA"=dword:00000000
$Hive = HKEY_LOCAL_MACHINE\SOFTWARE
$SubKey = Microsoft\Windows\CurrentVersion\Policies # no
leading or trailing slashes
$KeyName = EnableLUA
References:
Raku's NativeCall
https://docs.perl6.org/language/nativecall
Win32 return codes:
https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
Read the key:
use RegQueryValueExW if you know key and value name
https://docs.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regqueryvalueexw
C++
LSTATUS RegQueryValueExW(
HKEY hKey, # Hive handle from OpenKey
LPCWSTR lpValueName, # key name (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
);
}
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" {
say "Sorry, $SubName only work in Windows.";
exit; }
my int32 $Handle;
my $RtnCode;
my Any $KeyValue;
my $lpSubKey = to-c-str( $SubKey ); #
SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System
my $lpValueName = to-c-str( $KeyName ); # EnableLUA
my int32 $ulOptions = 0;
# my int32 $lpData; # = 1024;
my BYTES $lpData = CArray[BYTE].new( 0 xx 1024 );
my int32 $lpcbData = 1024; # max size of returned data
$Handle = OpenKey( HKEY_LOCAL_MACHINE, $SubKey, $Debug );
if $Debug { say "$SubName"; }
sub RegQueryValueExW( DWORD, WCHARS, DWORD, DWORD, CArray[BYTE] is
rw, DWORD is rw ) is native( "Kernel32.dll" ) is symbol(
"RegQueryValueExW" ) returns DWORD { * };
$RtnCode = RegQueryValueExW( $Handle, $lpValueName, 0, 0, $lpData,
$lpcbData );
if $Debug { say "$SubName: data received, byte count $lpcbData"; }
if not $RtnCode == 0 {
say "ERROR: $SubName\n Handle $Handle\n RtnCode $RtnCode,
0x$RtnCode.base(16) " ~
"\(2 KeyNotFound; 6 handle; 87 Invalid Parameter; 234 More
data\)\n" ~
" lpcbData data length $lpcbData\n";
}
CloseKey( $Handle, $Debug );
if $RtnCode == 0 {
if $ValueName eq REG_SZ ||
$ValueName eq REG_EXPAND_SZ ||
$ValueName eq REG_LINK ||
$ValueName eq REG_LINK ||
$ValueName eq REG_MULTI_SZ ||
$ValueName eq REG_RESOURCE_LIST ||
$ValueName eq REG_FULL_RESOURCE_DESCRIPTOR ||
$ValueName eq REG_RESOURCE_REQUIREMENTS_LIST {
loop (my $Index=0; $Index < $lpcbData - 2 ; $Index += 2) {
$KeyValue ~= chr( $lpData[ $Index ] );
}
} else {
# say "lpData = $lpData";
loop (my $Index = 0; $Index < $lpcbData; $Index += 1 ) {
my BYTE $x = $lpData[ $Index ]; # say $x.base(16);
my int32 $y = $x +| 0x0000; # say $y.base(16);
$KeyValue += ( $y +< ( $Index * 8 ) );
# say "KeyValue = $KeyValue $KeyValue.base(16)\n";;
}
}
} else {
$KeyValue = "ERROR";
my $ErrStr ="ERROR: $SubName\n Handle $Handle\n RtnCode
$RtnCode\n" ~
"Unable to open $Hive" ~ Q[\] ~ $SubKey ~ Q[\] ~ $KeyName ~
Q[::] ~ $ValueName ~ "\n";
say $ErrStr;
WinMsg( "Open Error", $ErrStr );
}
return $KeyValue;
}
</WinReg.pm6>
<WinMessageBox>
# unit module WinMessageBox;
# MessageBox.pm6
#`{
This Module provides access to Windows "user32" MessageBox
function and
give a WinMsg to substitute for Windows Professional's msg.exe
program, without
the networking.
This module is not able to retrieve information from the user
other than the buttons
Test one liners:
perl6 -e "use lib '.'; use WinMessageBox :MessageBox; say
MessageBox( 'Some Title', 'Something Cleaver', MB_ICONINFORMATION,
MB_OK );"
perl6 -e "use lib '.'; use WinMessageBox :MessageBox; say
MessageBox( 'Some Title', 'Something Cleaver', MB_ICONQUESTION,
MB_YESNOCANCEL );
perl6 -e "use lib '.'; use WinMessageBox :MessageBox; say
MessageBox( 'Some Title', 'Something Cleaver', MB_ICONERROR,
MB_CANCELTRYCONTINUE );"
perl6 -e "use lib '.'; use WinMessageBox :WinMsg; say
WinMsg( 'Some Title', 'Something Cleaver' );"
References:
https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-messagebox
https://stackoverflow.com/questions/59105696/how-can-i-create-pop-up-windows-for-perl6-in-windows
https://docs.perl6.org/language/nativecall
}
use NativeCall;
use NativeConstants;
enum Icons (
MB_ICONEXCLAMATION => 0x00000030,
MB_ICONWARNING => 0x00000030,
MB_ICONINFORMATION => 0x00000040,
MB_ICONASTERISK => 0x00000040,
MB_ICONQUESTION => 0x00000020,
MB_ICONSTOP => 0x00000010,
MB_ICONERROR => 0x00000010,
MB_ICONHAND => 0x00000010
);
enum Buttons (
MB_ABORTRETRYIGNORE => 0x00000002,
MB_CANCELTRYCONTINUE => 0x00000006,
MB_HELP => 0x00004000,
MB_OK => 0x00000000,
MB_OKCANCEL => 0x00000001,
MB_RETRYCANCEL => 0x00000005,
MB_YESNO => 0x00000004,
MB_YESNOCANCEL => 0x00000003
);
enum MessageBoxReturn (
ABORT => 3,
CANCEL => 2,
CONTINUE => 11,
IGNORE => 5,
NO => 7,
OK => 1,
RETRY => 4,
TRYAGAIN => 10,
YES => 6
);
sub MessageBoxW(
HANDLE,
LPWCTSTR,
LPWCTSTR,
UINT
)
is native("user32")
is symbol("MessageBoxW")
returns INT
{ * };
sub MessageBox(
Str $Title,
Str $Message,
Icons $Icon = Icons::MB_ICONINFORMATION,
Buttons $Button = Buttons::MB_OK
)
returns MessageBoxReturn is export( :MessageBox )
{
#`{
Pop up a message box to the user.
Windows only.
Return what button was pressed
See top for test one liners
}
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" {
say "Sorry, $SubName only work in Windows.";
exit;
}
my $lpText = CArray[uint16].new( $Message.encode.list );
$lpText[$lpText.elems] = 0;
my $lpCaption = CArray[uint16].new( $Title.encode.list );
$lpCaption[$lpCaption.elems] = 0;
my $uType = $Icon +| $Button; # bitwise OR them together
return MessageBoxReturn( MessageBoxW( my $Handle, $lpText,
$lpCaption, $uType ));
}
sub WinMsg( Str $TitleStr, Str $MessageStr ) is export( :WinMsg ) {
#`{
Simple "Ok" pop up with no return value. Thjis as a subsitute for
Windows `msg.exe` program
that only runs in the Professinal version and without the netowrking.
See top for test one liners
}
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" {
say "Sorry, $SubName only work in Windows.";
exit;
}
return MessageBox( $TitleStr, $MessageStr, MB_ICONINFORMATION,
MB_OK );
}
</WinMessageBox>
<NativeConstants.pm6>
# unit module NativeConstants;
# NativeConstants.pm6
#`{
Constants used across Windows libraries that use Native Call
Reference to types and values:
http://dsource.org/projects/tango/ticket/820
https://docs.microsoft.com/en-us/windows/win32/sysinfo/registry-key-security-and-access-rights
https://docs.microsoft.com/en-us/windows/win32/intl/language-identifiers
https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
https://stackoverflow.com/questions/321413/lpcstr-lpctstr-and-lptstr
https://docs.microsoft.com/en-us/windows/win32/winprog/windows-data-types
https://docs.microsoft.com/en-us/windows/win32/sysinfo/structure-of-the-registry
perl6 -I. -c NativeConstants.pm6
Test one liner:
perl6 -I. -e "use NativeConstants; say
FORMAT_MESSAGE_ALLOCATE_BUFFER.base(16);"
}
use NativeCall;
constant BYTE := uint8;
constant WCHAR := uint16;
constant DWORD := int32;
constant REGSAM := int32;
constant WCHARS := CArray[WCHAR];
constant BYTES := CArray[BYTE];
constant CPOINTER := int32;
constant INT = int32;
constant UINT = uint32;
constant HANDLE = Pointer[void];
constant LPWCTSTR = CArray[WCHAR];
constant FORMAT_MESSAGE_ALLOCATE_BUFFER = 0x00000100;
constant FORMAT_MESSAGE_FROM_SYSTEM = 0x00001000;
constant FORMAT_MESSAGE_IGNORE_INSERTS = 0x00000200;
constant KEY_QUERY_VALUE = 1;
constant ERROR_SUCCESS = 0; # Win-Api 0 = success
constant KEY_READ = 0x20019;
constant KEY_SET_VALUE = 0x0002;
enum WinRegHives (
HKEY_CLASSES_ROOT => 0x80000000;
HKEY_CURRENT_USER => 0x80000001;
HKEY_LOCAL_MACHINE => 0x80000002;
HKEY_USERS => 0x80000003;
HKEY_PERFORMANCE_DATA => 0x80000004;
HKEY_CURRENT_CONFIG => 0x80000005;
HKEY_DYN_DATA => 0x80000006;
);
enum ValueNames (
REG_NONE => 0; # No value type
REG_SZ => 1; # Unicode nul terminated string
REG_EXPAND_SZ => 2; # Unicode nul terminated
string = (with environment variable references)
REG_BINARY => 3; # Free form binary
REG_DWORD => 4; # 32-bit number
REG_DWORD_LITTLE_ENDIAN => 4; # 32-bit number = (same as
REG_DWORD)
REG_DWORD_BIG_ENDIAN => 5; # 32-bit number
REG_LINK => 6; # Symbolic Link = (unicode)
REG_MULTI_SZ => 7; # Multiple Unicode strings
REG_RESOURCE_LIST => 8; # Resource list in the
resource map
REG_FULL_RESOURCE_DESCRIPTOR => 9; # Resource list in the
hardware description
REG_RESOURCE_REQUIREMENTS_LIST => 10;
REG_QWORD => 11; # 64-bit number
REG_QWORD_LITTLE_ENDIAN => 11; # same as REG_QWORD
);
</NativeConstants.pm6>
