http://qs321.pair.com?node_id=503197

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;