Re: My pop ups for windows module

[ToddAndMargo via perl6-users]

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



# 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(
   HKEYhKey,  # 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:
$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(
   HKEYhKey,  # 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 

Re: My pop ups for windows module

[ToddAndMargo via perl6-users]

On 2019-12-26 23:15, WFB wrote:

Hi Todd,
I refactored your code a bit to make it a bit more readable IMHO. 
Thinking on publish it on modules.raku.org  if 
you are not interested to do so.



Hi Bill,

I did not think I would like enum, but wound up liking
it anyway.

my win message is ready to go.  I changed the name
and added a lot of your ideas to it.

I will open a new thread call "My Win Modules" and
start posting them there.  Three more to go!

Thank you for the wonderful tips!

-T

Re: My pop ups for windows module

[ToddAndMargo via perl6-users]

On 2019-12-26 23:15, WFB wrote:

Hi Todd,
I refactored your code a bit to make it a bit more readable IMHO. 
Thinking on publish it on modules.raku.org  if 
you are not interested to do so.


Hi Tom,

I am interested, but not quite yet.  There are three dependent modules I 
need to tweak to my liking first.


This one (WinPopUps)
WinMount (gives Linux style mount and dismount
  and label and UUID searches)
WinReg   (read and set registry values)

I will post them here when I am ready for everyone to
scrutinize before putting on modules.

In your mods, what is the syntax to export the "enum" calls?

-T

Re: My pop ups for windows module

[WFB]

Hi Todd,
I refactored your code a bit to make it a bit more readable IMHO. Thinking
on publish it on modules.raku.org if you are not interested to do so.

#`{
   Reference:

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
}

use NativeCall;

enum Icons (
MB_ICONEXCLAMATION   => 0x0030,
MB_ICONWARNING   => 0x0030,
MB_ICONINFORMATION   => 0x0040,
MB_ICONASTERISK  => 0x0040,
MB_ICONQUESTION  => 0x0020,
MB_ICONSTOP  => 0x0010,
MB_ICONERROR => 0x0010,
MB_ICONHAND  => 0x0010
);

enum Buttons (
MB_ABORTRETRYIGNORE  => 0x0002,
MB_CANCELTRYCONTINUE => 0x0006,
MB_HELP  => 0x4000,
MB_OK=> 0x,
MB_OKCANCEL  => 0x0001,
MB_RETRYCANCEL   => 0x0005,
MB_YESNO => 0x0004,
MB_YESNOCANCEL   => 0x0003
);

enum MessageBoxReturn (
DABORT =>  3,
IDCANCEL   =>  2,
IDCONTINUE => 11,
IDIGNORE   =>  5,
IDNO   =>  7,
IDOK   =>  1,
IDRETRY=>  4,
IDTRYAGAIN => 10,
IDYES  =>  6
);

constant WCHAR  = uint16;
constant INT= int32;
constant UINT   = uint32;
constant HANDLE = Pointer[void];
constant LPWCTSTR   = CArray[WCHAR];

sub MessageBoxW( HANDLE, LPWCTSTR, LPWCTSTR, UINT ) is
native('user32') returns INT { * };

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 MessageBox(Str $title, Str $message, Icons $icon =
Icons::MB_ICONINFORMATION, Buttons $button = Buttons::MB_OK) returns
MessageBoxReturn is export
{
   my Str $SubName = &?ROUTINE.name;
my Str $OS  = $*KERNEL.name;

if not $OS eq "win32" { say "Sorry, $SubName only work in Windows.";
exit; }

MessageBoxReturn(MessageBoxW( my $handle, to-c-str( $message ),
to-c-str( $title ), $icon +| $button ));
}


On Sat, 7 Dec 2019 at 13:36, Tom Browder  wrote:

> On Sat, Dec 7, 2019 at 05:41 ToddAndMargo via perl6-users <
> perl6-users@perl.org> wrote:
>
>> Hi All,
>>
>> I wrote and extensive module for pop up in Windows.
>
>
> Todd, you need to publish your module to the Raku module ecosystem. Many
> people, including myself, want to see an easily-installable module with at
> least some basic tests to give strangers confidence that it will not blow
> up. Instructions are in the docs, and there are helper modules to get you
> started.
>
> I'll send you specific doc references later when I get a chance, but it's
> probably better for you to dig around the doc site a bit more on your own.
> Hint: in the search box, enter 'module'.
>
> -Tom
>
>
>>
>> It does not contain a time out option.  Maybe some day I
>> will work on the timer function.
>>
>> Thank you all for helping me with various parts of this!
>>
>> There are basically two subs to import
>>  WinMsg  and  WinPopUp
>>
>> Here are some one liners to test it with:
>>
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
>> Duper Title', 'What? You were expecting something witty?',
>> 'Information', 'Ok'  );"
>>
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
>> Duper Title', 'What? You were expecting something witty?', 'Question',
>> 'YesNoCancel' );
>>
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp, :WinMsg; WinMsg( 'Super
>> Duper Title', 'What? You were expecting something witty?' );"
>>
>> Let me know if you find any booboo's.
>>
>> -T
>>
>>
>> 
>> # unit module WinPopUps;
>> # WinMsg.pm6
>>
>> #`{
>>Reference:
>>
>>
>> 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
>> }
>>
>> use NativeCall;
>>
>> sub WinPopUp( Str $TitleStr,
>>Str $MessageStr,
>>Str $Icons where   * ~~ "Exclamation" |
>>"Warning" |
>>"Information" |
>>"Asterisk"|
>>"Question"|
>>"Stop"|
>>"Error"   |
>>"Hand",
>>Str $Buttons where * ~~ "AbortRetryIgnore"|
>>"CancelTryAgainContinue"  |
>>"Help"|
>>

Re: My pop ups for windows module

[Tom Browder]

On Sat, Dec 7, 2019 at 05:41 ToddAndMargo via perl6-users <
perl6-users@perl.org> wrote:

> Hi All,
>
> I wrote and extensive module for pop up in Windows.


Todd, you need to publish your module to the Raku module ecosystem. Many
people, including myself, want to see an easily-installable module with at
least some basic tests to give strangers confidence that it will not blow
up. Instructions are in the docs, and there are helper modules to get you
started.

I'll send you specific doc references later when I get a chance, but it's
probably better for you to dig around the doc site a bit more on your own.
Hint: in the search box, enter 'module'.

-Tom


>
> It does not contain a time out option.  Maybe some day I
> will work on the timer function.
>
> Thank you all for helping me with various parts of this!
>
> There are basically two subs to import
>  WinMsg  and  WinPopUp
>
> Here are some one liners to test it with:
>
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
> Duper Title', 'What? You were expecting something witty?',
> 'Information', 'Ok'  );"
>
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
> Duper Title', 'What? You were expecting something witty?', 'Question',
> 'YesNoCancel' );
>
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp, :WinMsg; WinMsg( 'Super
> Duper Title', 'What? You were expecting something witty?' );"
>
> Let me know if you find any booboo's.
>
> -T
>
>
> 
> # unit module WinPopUps;
> # WinMsg.pm6
>
> #`{
>Reference:
>
>
> 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
> }
>
> use NativeCall;
>
> sub WinPopUp( Str $TitleStr,
>Str $MessageStr,
>Str $Icons where   * ~~ "Exclamation" |
>"Warning" |
>"Information" |
>"Asterisk"|
>"Question"|
>"Stop"|
>"Error"   |
>"Hand",
>Str $Buttons where * ~~ "AbortRetryIgnore"|
>"CancelTryAgainContinue"  |
>"Help"|
>"Ok"  |
>"OkCancel"|
>"RetryCancel" |
>"YesNo"   |
>"YesNoCancel" )
>is export( :WinPopUp ) {
>
> #`{
>
>  Pop up a message box to the user.  Windows only.
>  Return what button was pressed
>
>  Note: you are constrainedthe the Icon and Button values shown in
> the sub declaration.
>
>  Test one liners:
>  perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp(
> 'Super Duper Title', 'What? You were expecting something witty?',
> 'Information', 'Ok'  );"
>  perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp(
> 'Super Duper Title', 'What? You were expecting something witty?',
> 'Question', 'YesNoCancel' );
>
> }
>
> 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 $RtnInt = 0;
> my Str   $RtnStr = "";
> my int32 $IconInt;
> my int32 $ButtonInt;
> my int32 $UINT;
>
> # Note: these constants are 32 bit
> constant WCHAR  = uint16;
> constant INT= int32;
> constant UINT   = uint32;
> constant HANDLE = Pointer[void];
> constant LPWCTSTR   = CArray[WCHAR];
>
>
> constant MB_ICONEXCLAMATION   = 0x0030;
> constant MB_ICONWARNING   = 0x0030;
> constant MB_ICONINFORMATION   = 0x0040;
> constant MB_ICONASTERISK  = 0x0040;
> constant MB_ICONQUESTION  = 0x0020;
> constant MB_ICONSTOP  = 0x0010;
> constant MB_ICONERROR = 0x0010;
> constant MB_ICONHAND  = 0x0010;
>
>
> constant MB_ABORTRETRYIGNORE  = 0x0002;
> constant MB_CANCELTRYCONTINUE = 0x0006;
> constant MB_HELP  = 0x4000;
> constant MB_OK= 0x;
> constant MB_OKCANCEL  = 0x0001;
> constant MB_RETRYCANCEL   = 0x0005;
> constant MB_YESNO = 0x0004;
> constant MB_YESNOCANCEL   = 0x0003;
>
> constant DABORT =  3;
> constant IDCANCEL   =  2;
> constant IDCONTINUE = 11;
> constant 

My pop ups for windows module

[ToddAndMargo via perl6-users]

Hi All,

I wrote and extensive module for pop up in Windows.

It does not contain a time out option.  Maybe some day I
will work on the timer function.

Thank you all for helping me with various parts of this!

There are basically two subs to import
WinMsg  and  WinPopUp

Here are some one liners to test it with:

perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super 
Duper Title', 'What? You were expecting something witty?', 
'Information', 'Ok'  );"


perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super 
Duper Title', 'What? You were expecting something witty?', 'Question', 
'YesNoCancel' );


perl6 -e "use lib '.'; use WinPopUps :WinPopUp, :WinMsg; WinMsg( 'Super 
Duper Title', 'What? You were expecting something witty?' );"


Let me know if you find any booboo's.

-T



# unit module WinPopUps;
# WinMsg.pm6

#`{
  Reference:

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
}

use NativeCall;

sub WinPopUp( Str $TitleStr,
  Str $MessageStr,
  Str $Icons where   * ~~ "Exclamation" |
  "Warning" |
  "Information" |
  "Asterisk"|
  "Question"|
  "Stop"|
  "Error"   |
  "Hand",
  Str $Buttons where * ~~ "AbortRetryIgnore"|
  "CancelTryAgainContinue"  |
  "Help"|
  "Ok"  |
  "OkCancel"|
  "RetryCancel" |
  "YesNo"   |
  "YesNoCancel" )
  is export( :WinPopUp ) {

#`{

Pop up a message box to the user.  Windows only.
Return what button was pressed

Note: you are constrainedthe the Icon and Button values shown in 
the sub declaration.


Test one liners:
perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 
'Super Duper Title', 'What? You were expecting something witty?', 
'Information', 'Ok'  );"
perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 
'Super Duper Title', 'What? You were expecting something witty?', 
'Question', 'YesNoCancel' );


}

   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 $RtnInt = 0;
   my Str   $RtnStr = "";
   my int32 $IconInt;
   my int32 $ButtonInt;
   my int32 $UINT;

   # Note: these constants are 32 bit
   constant WCHAR  = uint16;
   constant INT= int32;
   constant UINT   = uint32;
   constant HANDLE = Pointer[void];
   constant LPWCTSTR   = CArray[WCHAR];


   constant MB_ICONEXCLAMATION   = 0x0030;
   constant MB_ICONWARNING   = 0x0030;
   constant MB_ICONINFORMATION   = 0x0040;
   constant MB_ICONASTERISK  = 0x0040;
   constant MB_ICONQUESTION  = 0x0020;
   constant MB_ICONSTOP  = 0x0010;
   constant MB_ICONERROR = 0x0010;
   constant MB_ICONHAND  = 0x0010;


   constant MB_ABORTRETRYIGNORE  = 0x0002;
   constant MB_CANCELTRYCONTINUE = 0x0006;
   constant MB_HELP  = 0x4000;
   constant MB_OK= 0x;
   constant MB_OKCANCEL  = 0x0001;
   constant MB_RETRYCANCEL   = 0x0005;
   constant MB_YESNO = 0x0004;
   constant MB_YESNOCANCEL   = 0x0003;

   constant DABORT =  3;
   constant IDCANCEL   =  2;
   constant IDCONTINUE = 11;
   constant IDIGNORE   =  5;
   constant IDNO   =  7;
   constant IDOK   =  1;
   constant IDRETRY=  4;
   constant IDTRYAGAIN = 10;
   constant IDYES  =  6;


   # Note: the following two subs have to be embedded

   sub MessageBoxW( HANDLE, LPWCTSTR, LPWCTSTR, UINT ) is 
native('user32') returns INT { * };


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


   if $Icons eq "Exclamation"  { $IconInt = MB_ICONEXCLAMATION; }
   elsif  $Icons eq "Warning"  { $IconInt = MB_ICONWARNING; }
   elsif  $Icons eq "Information"  { $IconInt = MB_ICONINFORMATION; }
   elsif  $Icons eq "Asterisk" { $IconInt = MB_ICONASTERISK; }
   elsif  $Icons eq "Question" { $IconInt = MB_ICONQUESTION; }