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;