Delphi笔记

四、使用挂钩：
  挂钩(hook)使程序能控制系统事件的发生和处理，它能够预演和修改系统事件和消息，并且能在系统范围内阻止系统事件和消息的发生。
调用API函数SetWindowHookEx()来设置挂钩，其声明如下：
function SetWindowHookEx(idHook:Integer;  //指定挂钩类型，其值如下表所示：
{
idHook值   意义
WH_CALLWNDPROC  窗口过程过滤器，当窗口过程收到一个消息时，会调用这个挂钩函数。
WH_CALLWNDPROCRET 建立用于监视已经由窗口过程处理的消息的挂钩过程。*
WH_CBT   在处理大多数窗口管理、鼠标和键盘消息前会调用这个挂钩函数。   
WH_DEBUG  调试过滤器，这个挂钩函数将在任何Windows挂钩函数前调用。
WH_GETMESSAGE  消息过滤器，当从应用程序的消息队列中检索到一个消息时会调用这个挂钩函数。
WH_HARDWARE  硬件消息过滤器，当从应用程序的消息队列中检索到一个硬件消息时会调用这个挂钩函数。
WH_JOURNALPLAYBACK 当从系统的消息队列中检索到一个消息时会调用这个挂钩函数，这主要用来在消息队列中插入一个系统事件
WH_JOURNALRECORD 当一个事件从系统队列中被请求时会调用这个挂钩函数，这主要用来记录系统事件。
WH_KEYBOARD  键盘过滤器，当从应用程序的消息队列中检索到WM_KeyDown和WM_KeyUp消息时会调用这个挂钩函数。
WH_MOUSE  鼠标过滤器，当从应用程序的消息队列中检索到一个鼠标消息时会调用这个挂钩函数。
WH_KEYBOARD_LL  低层的键盘过滤器。*
WH_MOUSE_LL  低层的鼠标过滤器。*
WH_MSGFILTER  特殊消息过滤器，当应用程序的对话框、菜单或信息框要处理一个消息时会调用这个挂钩函数。
WH_SHELL  外壳应用过滤器，当一个窗口被创建和释放或一个外壳过程需要激活时会调用这个挂钩函数。
注意：打上*表示只在WindowsNT/2000中才有效。
}
                         lpfn:TFNHookProc; //挂钩函数的地址，TFNHookProc类型声明如下：
{
type
  TFNHookProc=function(code:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
}
                         hmod:HInst;  //包含挂钩函数的EXE或DLL的hInstance变量
                         dwThreadID:DWORD  //与挂钩关联的线程。为0时表示可以在所有线程中调用。
                        ):HHook;stdcall;返回挂钩的句柄。

挂钩函数的Code、wParam和lParam参数值都与该挂钩函数的类型有关，这些函数的参数有一个共同点：利用Code参数的值，可以调用挂钩链中
的下一个挂钩函数。调用下一个挂钩函数，要用到API函数CallNextHookEx()。
当想释放挂钩时，需要调用API函数UnhookWindowsHookEx()，并将挂钩句柄作为参数传递。
======================================
SendKey函数：
  模拟用户向具有焦点的窗口输入字符内容。
-----------------------
unit Keydefs;

interface

uses Windows;
//一些特殊键的定义：Ctrl键以^表示，Alt键以@表示，Shift键以~表示，其它功能键以{开始以}结束，例如：回车以{ENTER}表示。
const
  MaxKeys = 24;
  ControlKey = '^';
  AltKey = '@';
  ShiftKey = '~';
  KeyGroupOpen = '{';
  KeyGroupClose = '}';

type
  TKeyString = String[7];

  TKeyDef = record
    Key: TKeyString;
    vkCode: Byte;
  end;

const
  KeyDefArray : array[1..MaxKeys] of TKeyDef = (
    (Key: 'F1';     vkCode: vk_F1),
    (Key: 'F2';     vkCode: vk_F2),
    (Key: 'F3';     vkCode: vk_F3),
    (Key: 'F4';     vkCode: vk_F4),
    (Key: 'F5';     vkCode: vk_F5),
    (Key: 'F6';     vkCode: vk_F6),
    (Key: 'F7';     vkCode: vk_F7),
    (Key: 'F8';     vkCode: vk_F8),
    (Key: 'F9';     vkCode: vk_F9),
    (Key: 'F10';    vkCode: vk_F10),
    (Key: 'F11';    vkCode: vk_F11),
    (Key: 'F12';    vkCode: vk_F12),
    (Key: 'INSERT'; vkCode: vk_Insert),
    (Key: 'DELETE'; vkCode: vk_Delete),
    (Key: 'HOME';   vkCode: vk_Home),
    (Key: 'END';    vkCode: vk_End),
    (Key: 'PGUP';   vkCode: vk_Prior),
    (Key: 'PGDN';   vkCode: vk_Next),
    (Key: 'TAB';    vkCode: vk_Tab),
    (Key: 'ENTER';  vkCode: vk_Return),
    (Key: 'BKSP';   vkCode: vk_Back),
    (Key: 'PRTSC';  vkCode: vk_SnapShot),
    (Key: 'SHIFT';  vkCode: vk_Shift),
    (Key: 'ESCAPE'; vkCode: vk_Escape));
//这个常量数组用来快速查询指定功能键的虚拟键码

function FindKeyInArray(Key: TKeyString; var Code: Byte): Boolean;

implementation

uses SysUtils;

function FindKeyInArray(Key: TKeyString; var Code: Byte): Boolean;
{ function searches array for token passed in Key, and returns the }
{ virtual key code in Code. }
var
  i: word;
begin
  Result := False;
  for i := Low(KeyDefArray) to High(KeyDefArray) do
    if UpperCase(Key) = KeyDefArray[i].Key then begin
      Code := KeyDefArray[i].vkCode;
      Result := True;
      Break;
    end;
end;

end.
--------------------------
unit SendKey;

interface

uses
 SysUtils, Windows, Messages, Classes, KeyDefs;

type
  { Error codes }
  TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken,
    sk_UnknownError, sk_AlreadyPlaying);
  { first vk code to last vk code }
  TvkKeySet = set of vk_LButton..vk_Scroll;

  { exceptions }
  ESendKeyError = class(Exception);
  ESKSetHookError = class(ESendKeyError);
  ESKInvalidToken = class(ESendKeyError);
  ESKAlreadyPlaying = class(ESendKeyError);

function SendKeys(S: String): TSendKeyError;
procedure WaitForHook;
procedure StopPlayback;

var
  Playing: Boolean;

implementation

uses Forms;

type
  { a TList descendant that know how to dispose of its contents }
  TMessageList = class(TList)
  public
    destructor Destroy; override;
  end;

const
  { valid "sys" keys }
  vkKeySet: TvkKeySet = [Ord('A')..Ord('Z'), vk_Menu, vk_F1..vk_F12];

destructor TMessageList.Destroy;
var
  i: longint;
begin
  { deallocate all the message records before discarding the list }
  for i := 0 to Count - 1 do
    Dispose(PEventMsg(Items[i]));
  inherited Destroy;
end;

var
  { variables global to the DLL }
  MsgCount: word = 0;
  MessageBuffer: TEventMsg;
  HookHandle: hHook = 0;
  MessageList: TMessageList = Nil;
  AltPressed, ControlPressed, ShiftPressed: Boolean;

procedure StopPlayback;
{ Unhook the hook, and clean up }
begin
  { if Hook is currently active, then unplug it }
  if Playing then
    UnhookWindowsHookEx(HookHandle);
  MessageList.Free;
  Playing := False;
end;

function Play(Code: integer; wParam, lParam: Longint): Longint; stdcall;
{ This is the JournalPlayback callback function.  It is called by }
{ Windows when Windows polls for hardware events.  The code parameter }
{ indicates what to do. }
begin
  case Code of
    HC_SKIP:
      { HC_SKIP means to pull the next message out of our list. If we }
      { are at the end of the list, it's okay to unhook the }
      { JournalPlayback hook from here. }
      begin
        { increment message counter }
        inc(MsgCount);
        { check to see if all messages have been played }
        if MsgCount >= MessageList.Count then StopPlayback
        { otherwise copy next message from list into buffer }
        else MessageBuffer := TEventMsg(MessageList.Items[MsgCount]^);
        Result := 0;
      end;
    HC_GETNEXT:
      { HC_GETNEXT means to fill the wParam and lParam with the proper }
      { values so that the message can be played back.  DO NOT unhook }
      { hook from within here.  Return value indicates how much time }
      { until Windows should playback message.  We'll return 0 so that }
      { it is processed right away. }
      begin
        { move message in buffer to message queue }
        PEventMsg(lParam)^ := MessageBuffer;
        Result := 0  { process immediately }
      end
    else
      { if Code isn't HC_SKIP or HC_GETNEXT, call next hook in chain }
      Result := CallNextHookEx(HookHandle, Code, wParam, lParam);
  end;
end;

procedure StartPlayback;
{ Initializes globals and sets the hook }
begin
  { grab first message from list and place in buffer in case we }
  { get a hc_GetNext before and hc_Skip }
  MessageBuffer := TEventMsg(MessageList.Items[0]^);
  { initialize message count and play indicator }
  MsgCount := 0;
  { initialize Alt, Control, and Shift key flags }
  AltPressed := False;
  ControlPressed := False;
  ShiftPressed := False;
  { set the hook! }
  HookHandle := SetWindowsHookEx(wh_JournalPlayback, Play, hInstance, 0);
  if HookHandle = 0 then
    raise ESKSetHookError.Create('Failed to set hook');
  Playing := True;
end;

procedure MakeMessage(vKey: byte; M: Cardinal);
{ procedure builds a TEventMsg record that emulates a keystroke and }
{ adds it to message list }
var
  E: PEventMsg;
begin
  New(E);                                 // allocate a message record
  with E^ do
  begin
    message := M;                         // set message field
    paramL := vKey;                       // vk code in ParamL
    paramH := MapVirtualKey(vKey, 0);     // scan code in ParamH
    time := GetTickCount;                 // set time
    hwnd := 0;                            // ignored
  end;
  MessageList.Add(E);
end;

procedure KeyDown(vKey: byte);
{ Generates KeyDownMessage }
begin
  { don't generate a "sys" key if the control key is pressed }
  { (This is a Windows quirk) }
  if AltPressed and (not ControlPressed) and  (vKey in vkKeySet) then
    MakeMessage(vKey, wm_SysKeyDown)
  else
    MakeMessage(vKey, wm_KeyDown);
end;

procedure KeyUp(vKey: byte);
{ Generates KeyUp message }
begin
  { don't generate a "sys" key if the control key is pressed }
  { (This is a Windows quirk) }
  if AltPressed and (not ControlPressed) and (vKey in vkKeySet) then
    MakeMessage(vKey, wm_SysKeyUp)
  else
    MakeMessage(vKey, wm_KeyUp);
end;

procedure SimKeyPresses(VKeyCode: Word);
{ This function simulates keypresses for the given key, taking into }
{ account the current state of Alt, Control, and Shift keys }
begin
  { press Alt key if flag has been set }
  if AltPressed then
    KeyDown(vk_Menu);
  { press Control key if flag has been set }
  if ControlPressed then
    KeyDown(vk_Control);
  { if shift is pressed, or shifted key and control is not pressed... }
  if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or
    ShiftPressed then
    KeyDown(vk_Shift);    { ...press shift }
  KeyDown(Lo(VKeyCode));  { press key down }
  KeyUp(Lo(VKeyCode));    { release key }
  { if shift is pressed, or shifted key and control is not pressed... }
  if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or
    ShiftPressed then
    KeyUp(vk_Shift);      { ...release shift }
  { if shift flag is set, reset flag }
  if ShiftPressed then begin
    ShiftPressed := False;
  end;
  { Release Control key if flag has been set, reset flag }
  if ControlPressed then begin
    KeyUp(vk_Control);
    ControlPressed := False;
  end;
  { Release Alt key if flag has been set, reset flag }
  if AltPressed then begin
    KeyUp(vk_Menu);
    AltPressed := False;
  end;
end;

procedure ProcessKey(S: String);
{ This function parses each character in the string to create the }
{ message list }
var
  KeyCode: word;
  Key: byte;
  index: integer;
  Token: TKeyString;
begin
  index := 1;
  repeat
    case S[index] of
      KeyGroupOpen:
        { It's the beginning of a special token! }
        begin
          Token := '';
          inc(index);
          while S[index] <> KeyGroupClose do begin
            { add to Token until the end token symbol is encountered }
            Token := Token + S[index];
            inc(index);
            { check to make sure the token's not too long }
            if (Length(Token) = 7) and (S[index] <> KeyGroupClose) then
              raise ESKInvalidToken.Create('No closing brace');
          end;
          { look for token in array, Key parameter will }
          { contain vk code if successful }
          if not FindKeyInArray(Token, Key) then
            raise ESKInvalidToken.Create('Invalid token');
          { simulate keypress sequence }
          SimKeyPresses(MakeWord(Key, 0));
        end;
      AltKey: AltPressed := True;           // set Alt flag
      ControlKey: ControlPressed := True;   // set Control flag
      ShiftKey: ShiftPressed := True;       // set Shift flag
      else begin
      { A normal character was pressed }
        { convert character into a word where the high byte contains }
        { the shift state and the low byte contains the vk code }
        KeyCode := vkKeyScan(S[index]);
        { simulate keypress sequence }
        SimKeyPresses(KeyCode);
      end;
    end;
    Inc(index);
  until index > Length(S);
end;

procedure WaitForHook;
begin
  repeat Application.ProcessMessages until not Playing;
end;

function SendKeys(S: String): TSendKeyError;
{ This is the one entry point.  Based on the string passed in the S  }
{ parameter, this function creates a list of keyup/keydown messages, }
{ sets a JournalPlayback hook, and replays the keystroke messages.   }
begin
  Result := sk_None;                     // assume success
  try
    if Playing then raise ESKAlreadyPlaying.Create('');
    MessageList := TMessageList.Create;  // create list of messages
    ProcessKey(S);                       // create messages from string
    StartPlayback;                     // set hook and play back messages
  except
    { if an exception occurs, return an error code, and clean up }
    on E:ESendKeyError do
    begin
      MessageList.Free;
      if E is ESKSetHookError then
        Result := sk_FailSetHook
      else if E is ESKInvalidToken then
        Result := sk_InvalidToken
      else if E is ESKAlreadyPlaying then
        Result := sk_AlreadyPlaying;
    end
    else
      Result := sk_UnknownError;  // Catch-all exception handler
  end;
end;

end.
-----------------
unit Main;
...
uses SendKey, KeyDefs;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.SetFocus;                                // focus Edit1
  SendKeys('^{DELETE}I love...');                // send keys to Edit1
  WaitForHook;                                   // let keys playback
  Perform(WM_NEXTDLGCTL, 0, 0);                  // move to Edit2
  SendKeys('~delphi ~developer''s ~guide!');     // send keys to Edit2
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  H: hWnd;
  PI: TProcessInformation;
  SI: TStartupInfo;
begin
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);
  { Invoke notepad }
  if CreateProcess(nil, 'notepad', nil, nil, False, 0, nil, nil, SI,
    PI) then
  begin
    { wait until notepad is ready to receive keystrokes }
    WaitForInputIdle(PI.hProcess, INFINITE);
    { find new notepad window }
    H := FindWindow('Notepad', '无标题 - 记事本');
    if SetForegroundWindow(H) then            // bring it to front
      SendKeys('Hello from the Delphi Developer''s Guide SendKeys ' +
        'example!{ENTER}');  // send keys!
  end
  else
    MessageDlg(Format('Failed to invoke Notepad.  Error code %d',
      [GetLastError]), mtError, [mbOk], 0);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  WaitForInputIdle(GetCurrentProcess, INFINITE);
  SendKeys('@fx'); //先按Alt+F，再按X键
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  WaitForHook;
end;

end.