I have working code in Java Jini and C++ that creates a keyboard hook. Basically, the programm listen to the key pressed and react when some selected keys are used.

I would like to implement the same with perl. I tried to use Win32::API.

The script below is a try but it hangs in the MsgLoop sub: If $msg is Win32::API::Struct object, the call $GetMsg->Call($msg, undef, 0,0) does not return and produces a bunch of warnings Use of uninitialized value in pack in Win32/API/Struct.pm.

I have tried to parse the MSG struct code using Convert::Binary::C, but I'm not sure what to do next. My code is mixt with using Convert::Binary::C->pack with an empty Win32::API::Struct. Passing the result of this to the imported GetMessage function gives Win32::API::Call: parameter 1 must be a Win32::API::Struct object!

Thanks for any advice.

F.

use strict;
use warnings;
use Data::Dumper;
use Win32::API;
use Win32::API::Callback;
use Convert::Binary::C;

#use experimental 'bitwise';

=for comment

https://www.reddit.com/r/perl/comments/1i13h7/win32api_and_user32setwi
+neventhook_help/
https://msdn.microsoft.com/en-us/library/windows/desktop/ms681382(v=vs
+.85).aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/ms644990(v=vs
+.85).aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/aa383751(v=vs
+.85).aspx
http://code.activestate.com/lists/perl-win32-users/22434/


=cut

BEGIN {
    $Win32::API::DEBUG = 1;
}
my $WH_KEYBOARD_LL = 13;

Win32::API::Struct->typedef(
    POINT => qw(
        LONG  x;
        LONG  y;
        )
);
use constant {
    KEYEVENTF_EXTENDEDKEY => 0x0001,
    KEYEVENTF_KEYUP       => 0x0002,
    KEYEVENTF_SCANCODE    => 0x0008,
    KEYEVENTF_UNICODE     => 0x0004,
    INPUT_KEYBOARD        => 1
};

Win32::API::Struct->typedef(
    MSG => qw(
        HWND      hwnd;
        UINT      message;
        WPARAM    wParam;
        LPARAM    lParam;
        DWORD     time;
        POINT     pt;
        )
);

Win32::API::Struct->typedef(
    KEYBDINPUT => qw(
        WORD      wVk;
        WORD      wScan;
        DWORD     dwFlags;
        DWORD     time;
        UINT_PTR dwExtraInfo;
        DWORD junk1;
        DWORD junk2;
        )
);

Win32::API::Struct->typedef(
    INPUT => qw(
        DWORD type;
        KEYBDINPUT    ki;
        )
);

my $code = <<CCODE;
typedef unsigned long DWORD;
typedef unsigned short WORD;
typedef unsigned int UINT_PTR;
struct INPUT {
        DWORD type;
        struct {
        WORD      wVk;
        WORD      wScan;
        DWORD     dwFlags;
        DWORD     time;
        UINT_PTR dwExtraInfo;
        DWORD junk1;
        DWORD junk2;
               } ki;
    } ;
typedef void *PVOID;
typedef PVOID HWND;
typedef unsigned int UINT;
typedef unsigned int UINT_PTR;
typedef UINT_PTR WPARAM;
typedef long LONG_PTR;
typedef LONG_PTR LPARAM;
struct MSG  {
        HWND      hwnd;
        UINT      message;
        WPARAM    wParam;
        LPARAM    lParam;
        DWORD     time;
        struct {
            long  x;
            long  y;
        } pt;
    };

CCODE
my $cparser = Convert::Binary::C->new->parse($code);
my $GetCurrentThreadId =
    new Win32::API( 'kernel32', 'GetCurrentThreadId', '', 'N' );
print Win32::GetLastError(), "\n";    #0

#  my $SetWindowsHookEx = new Win32::API('user32', 'SetWindowsHookEx',
+ 'NKPP', 'P');
# my $SetWindowsHookEx =  Win32::API->Import('user32', 'HHOOK SetWindo
+wsHookEx(int idHook, HOOKPROC lpfn, HINSTANCE hMod, int dwThreadId)')
+;
# #my $CallNextHookEx =   Win32::API->Import('user32', 'CallNextHookEx
+', 'PNNN', 'N');
#my $GetMsg = Win32::API->Import('user32', 'GetMessage', 'NNII', 'i' )
+;

my $SetWindowsHookEx =
    Win32::API->Import( 'user32', 'SetWindowsHookEx', 'IKNI', 'N' )
    ;    #, "idHook, HOOKPROC lpfn, HINSTANCE hMod, int dwThreadId");
die( "Failed to import" . $^E ) if !$SetWindowsHookEx;
my $CallNextHookEx = Win32::API->Import( 'user32',
    'LRESULT WINAPI CallNextHookEx(HHOOK  hhk, int nCode, WPARAM wPara
+m, LPARAM lParam)'
);
my $GetMsg = Win32::API->Import( 'user32',
    'BOOL WINAPI GetMessage(LPMSG lpMsg, HWND hWnd, UINT wMsgFilterMin
+, UINT wMsgFilterMax)'
);
die "Error: $^E" if !$GetMsg;
my $TranslateMsg =
    Win32::API->Import( 'user32', 'TranslateMessage', 'N', 'i' );
die "Error: $^E" if !$TranslateMsg;
my $DispatchMsg = Win32::API->Import( 'user32', 'DispatchMessage', 'N'
+, 'N' );
die "Error: $^E" if !$DispatchMsg;

my $GetModuleHandle = Win32::API->Import( 'kernel32',
    'HMODULE WINAPI GetModuleHandle(LPCTSTR lpModuleName)' );

my $UnhookWindowsHookEx = Win32::API->Import( 'user32',
    'BOOL WINAPI UnhookWindowsHookEx(HHOOK hhk)' );

my $SendInput = Win32::API->Import( 'user32',
    'UINT WINAPI SendInput(UINT nInputs, LPINPUT pInputs, int cbSize)'
+ );
die "Error: $^E" if !$SendInput;

print Win32::GetLastError(), "\n";    #127

sub MsgLoop {
    my $msg = Win32::API::Struct->new("MSG");
    print "msgloop\n";
    my $lp = $cparser->pack( "MSG", $msg );

    # print "getmsg:" , Dumper ($GetMsg->Call($msg, undef, 0,0));
    # die;
    my $res;
    while ( $res = $GetMsg->Call( $lp, undef, 0, 0 ) ) {
        die "Error in GetMsf" if ( $res == -1 );

        # while (GetMsg($msg, undef, 0,0)) {
        die unless $msg;
        $TranslateMsg->Call($lp);
        $DispatchMsg->Call($lp);

    }
}

sub KeyboardHook {
    my ( $nCode, $wParam, $lParam ) = @_;
    print "kbhook\n";
    print join( ", ", @_ ) . "\n";

    #print "nCode=$nCode, wParam=$wParam, lParam=$lParam\n";
    $CallNextHookEx->Call( 0, $nCode, $wParam, $lParam );
}

sub registerHook {
    my $ThreadId = $GetCurrentThreadId->Call();
    print "ThreadID : $ThreadId\n";
    my $hMod = $GetModuleHandle->Call(undef);
    my $KeyboardHookCallback =
        Win32::API::Callback->new( \&KeyboardHook, "NNNN", "V" );
    my $Hook =
        $SetWindowsHookEx->Call( $WH_KEYBOARD_LL, $KeyboardHookCallbac
+k,
        $hMod, $ThreadId );

    MsgLoop();
    $UnhookWindowsHookEx->Call($Hook);
    return $Hook;
}

sub unregisterHook {
    $UnhookWindowsHookEx->Call(shift);

}

sub sendString {
    my $val       = shift;
    my @val       = split( //, $val );
    my $input_str = Win32::API::Struct->new("INPUT");
    my @input     = ( $input_str, $input_str );
    $input[0]->{type}          = INPUT_KEYBOARD;
    $input[0]->{ki}->{dwFlags} = KEYEVENTF_UNICODE;
    $input[1]                  = $input[0];
    $input[1]->{ki}->{dwFlags} |= KEYEVENTF_KEYUP;

    for my $v (@val) {
        ( $input[0]->{ki}->{wVk}, $input[1]->{ki}->{wVk} ) = ( 0, 0 );
        ( $input[0]->{ki}->{wScan}, $input[1]->{ki}->{wScan} ) = ( $v,
+ $v );

        for my $i ( 0 .. 1 ) {
            my $lp = $cparser->pack( "INPUT", $input[$i] );
            $SendInput->Call( 1, $lp, $cparser->('INPUT')->sizeof );

#print 'Error: ', Win32::FormatMessage( Win32::GetLastError() ) unless
+ ( $SendInput->Call( 2, \@input, 2 * $input_str->sizeof ) );
        }
    }

}

my $hook = registerHook();
print "hook:", Dumper($hook), "\n";
sendString("abc");
unregisterHook($hook);
[download]