main.pas

DELPHI中开发系统钩子大全包括使用DLL和不使用DLL的多种方式.

unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ShellAPI,ExtCtrls,Buttons;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Hook: TMemo;
    GroupBox3: TGroupBox;
    OnDown: TLabel;
    OnUp: TLabel;
    GroupBox4: TGroupBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  public
    WindowHandle: HWnd;
    StartSpy:Boolean;
    OldKey: Byte;
    LShiftUp, RShiftUp: Boolean;

     procedure WndProc(var Msg: TMessage);
     procedure KeyDownSpy;
     procedure UpdateTimer;
     procedure KeySpyDown(Sender: TObject; Key: Byte; KeyStr: String);
     procedure KeySpyUp(Sender: TObject; Key: Byte; KeyStr: String);
  end;

const
  OldRet: Boolean = False;
var
  Form1: TForm1;

implementation

{$R *.DFM}
 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');

procedure TForm1.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try
        KeyDownSpy;
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(WindowHandle, Msg, wParam, lParam);
end;

procedure TForm1.UpdateTimer;
var
  b: Byte;
begin
  KillTimer(WindowHandle, 1);
  if StartSpy then
   begin
    asm
      mov al, 60h
      mov b, al
    end;
    OldKey := b;
    if SetTimer(WindowHandle, 1, 1, nil) = 0 then
      raise EOutOfResources.Create('建立定时器出错');
   end;
end;

procedure TForm1.KeyDownSpy;
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
      begin
       if LShiftUp and RShiftUp then
        St := StrPas(LowButtonName[Key])
       else
        St := StrPas(HiButtonName[Key]);
        KeySpyDown(self,key,st);
      end
    else
     if  (Key - 128 <= 88) then
      begin
       if LShiftUp and RShiftUp then
        St := StrPas(LowButtonName[Key - 128])
       else
        St := StrPas(HiButtonName[Key - 128]);
        KeySpyUp(self,key,st);
      end;
   end;
end;

procedure TForm1.KeySpyDown(Sender: TObject; Key: Byte;
  KeyStr: String);
begin
  OnDown.Caption := 'KeySpyDown: Key = ' + IntToStr(Key) + ',  KeyStr = ' + KeyStr;
  if (KeyStr[1] = '-') and (KeyStr[2] = '-') then
   begin
    Hook.Lines.Add('');
    OldRet := True;
   end
  else
   if OldRet then
    begin
     Hook.Lines.Add('');
     OldRet := False;
    end;
  Hook.Text := Hook.Text + KeyStr;

end;

procedure TForm1.KeySpyUp(Sender: TObject; Key: Byte;
  KeyStr: String);
begin
  OnUp.Caption := 'KeySpyUp: Key = ' + IntToStr(Key) + ',  KeyStr = ' + KeyStr;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
  LShiftUp := True;
  RShiftUp := True;
  StartSpy := True;
  WindowHandle := AllocateHWnd(WndProc);
  if StartSpy then UpdateTimer;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  StartSpy:=true;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  StartSpy:=false;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  StartSpy := False;
  UpdateTimer;
  DeallocateHWnd(WindowHandle);
end;

end.