Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

To remap keyboard (Windows)

by pg (Canon)
on Oct 27, 2005 at 00:30 UTC ( #503197=CUFP: print w/replies, xml ) Need Help??

This package provides the basic functionality to remap Windows keyboard. For example if you want to use F10, F11, F12 to toggle caps lock, just do this: (on Windows XP, you just need to log out and log in to make this work; on Windows 2000, it seems like you need to restart your PC.)

use strict; use warnings; use KeySwapper; my $swapper = KeySwapper->new(); $swapper->clear(); $swapper->map(KeySwapper::F10, KeySwapper::CAPS_LOCK); $swapper->map(KeySwapper::F11, KeySwapper::CAPS_LOCK); $swapper->map(KeySwapper::F12, KeySwapper::CAPS_LOCK); $swapper->save();

Here is the package:

package KeySwapper; use Win32::TieRegistry(Delimiter=>"/"); use Data::Dumper; use strict; use warnings; #keys are sorted by key location as listed in the specification. use constant TAB => 0x0F; use constant CAPS_LOCK => 0x3A; use constant ENTER => 0x1C; use constant L_SHIFT => 0x2A; use constant R_SHIFT => 0x36; use constant L_CTRL => 0x1D; use constant L_ALT => 0x38; use constant R_ALT => 0xE038; use constant R_CTRL => 0xE01D; use constant NUM_LOCK => 0x45; use constant NUMERIC_7 => 0x47; use constant NUMERIC_4 => 0x4B; use constant NUMERIC_1 => 0x4F; use constant NUMERIC_8 => 0x48; use constant NUMERIC_5 => 0x4C; use constant NUMERIC_2 => 0x50; use constant NUMERIC_0 => 0x52; use constant NUMERIC_MUL => 0x37; use constant NUMERIC_9 => 0x49; use constant NUMERIC_6 => 0x4D; use constant NUMERIC_3 => 0x51; use constant NUMERIC_DOT => 0x53; use constant NUMERIC_MIN => 0x4A; use constant NUMERIC_PLUS => 0x4E; use constant NUMERIC_ENTER => 0xE01C; use constant ESC => 0x01; use constant F1 => 0x3B; use constant F2 => 0x3C; use constant F3 => 0x3D; use constant F4 => 0x3E; use constant F5 => 0x3F; use constant F6 => 0x40; use constant F7 => 0x41; use constant F8 => 0x42; use constant F9 => 0x43; use constant F10 => 0x44; use constant F11 => 0x57; use constant F12 => 0x58; use constant SCROLL_LOCK => 0x46; use constant LEFT_WIN => 0xE05B; use constant RIGHT_WIN => 0xE05C; use constant APPLICATION => 0xE05D; sub new { my $self = {}; $self->{"registry"} = $Registry->{"HKEY_LOCAL_MACHINE/SYSTEM/Curre +ntControlSet/Control/Keyboard Layout"}; if (my $current_value = $self->{"registry"}{"/Scancode Map"}) { my @current_keys = unpack("S*", $current_value); for my $i (0 .. $current_keys[4] - 2) { $self->{"map"}{$current_keys[7 + $i * 2]} = $current_keys[ +6 + $i * 2]; } } bless($self); return $self; } sub clear { my $self = shift; if (@_) { for my $key (@_) { delete @{$self->{"map"}}{@_}; } } else { $self->{"map"} = {}; } } sub map { my ($self, $from, $to) = @_; $self->{"map"}->{$from} = $to; } #write back to the registry sub save { my $self = shift; print Dumper($self->{"map"}); my @keys = keys(%{$self->{"map"}}); if (@keys) { my $pack = pack("LLSS", 0, 0, $#keys + 2, 0); for my $key (@keys) { $pack .= pack("SS", $self->{"map"}{$key}, $key); } $pack .= pack("L", 0); $self->{"registry"}{"/Scancode Map"} = [$pack, "REG_BINARY"] } else { delete $self->{"registry"}{"/Scancode Map"}; } } 1;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://503197]
Approved by Tanktalus
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (5)
As of 2020-11-30 21:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?