Перехват (Hook) клавиатуры (программа Sendkeys)
Я уже видел несколько сообщений в новостных группах, касающиеся данного вопроса. Вот код, который, по моему мнению, наиболее полно раскрывает данную тему. Совет имеет один существенный недостаток. В том виде, в каком я нашел его, отсутствует программа, осуществляющая управление данной DLL, то есть приводится реализации самого перехвата, а часть, позволяющая управлять им, к сожалению, отсутствует. Если у читателей имеется реализация программы или другой аналогичный код, поделитесь со мной, а я в свою очередь попытаюсь найти полную реализацию данного проекта. Тем не менее данный материал раскрывает технологию осуществления перехвата и может использоваться в качестве отправной точки для дальнейшего экспериментирования.
|
library Sendkey; {Данный код написан по мотивам книги "Delphi Developer's Guide" авторов Xavier Pacheco и Steve Teixeira.} uses SysUtils, WinTypes, WinProcs, Messages, Classes, KeyDefs; type { Коды ошибок } TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken, sk_UnknownError); { исключения } ESendKeyError = class(Exception); ESetHookError = class(ESendKeyError); EInvalidToken = class(ESendKeyError); { потомок TList, который знает как избавляться от своего содержания } TMessageList = class(TList) public destructor Destroy; override; end; destructor TMessageList.Destroy; var i: longint; begin { освобождаем все записи сообщений перед тем как разрушить список } for i := 0 to Count - 1 do Dispose(PEventMsg(Items[i])); inherited Destroy; end; var { глобальные переменные для DLL } MsgCount: word; MessageBuffer: TEventMsg; HookHandle: hHook; Playing: Boolean; MessageList: TMessageList; AltPressed, ControlPressed, ShiftPressed: Boolean; NextSpecialKey: TKeyString; function MakeWord(L, H: Byte): Word; { макрос создает число из самого большого и самого маленького байтов } inline( $5A/ { pop dx } $58/ { pop ax } $8A/$E2); { mov ah, dl } procedure StopPlayback; { Снимаем перехват и наводим порядок } begin { если перехват к настоящему времени активен, отключаем его } if Playing then UnhookWindowsHookEx(HookHandle); MessageList.Free; Playing := False; end; function Play(Code: integer; wParam: word; lParam: Longint): Longint; export; { Это функция-оболочка возвращает JournalPlayback. Вызывается системой во время } { опроса аппаратных событий. Параметр Code указывает что нужно делать. } begin case Code of hc_Skip: begin { hc_Skip пропускает очередное сообщение из нашего списка. Если мы } { в конце списка, это хорошо, снимаем захват JournalPlayback } { в данном месте кода. } { увеличиваем счетчик сообщений } inc(MsgCount); { проверка воспроизведения всех сообщений } if MsgCount >= MessageList.Count then StopPlayback else { копируем очередное сообщение из списка в буфер } MessageBuffer := TEventMsg(MessageList.Items[MsgCount]^); Result := 0; end; hc_GetNext: begin { hc_GetNext нужен для заполнения wParam и lParam соответствующими } { значениями, необходимыми для воспроизведения сообщения. НЕ СНИМАЙТЕ } { захват в этом участке кода. Возвращаемая величина указывает время, } { в течение которого Windows должна воспроизвести сообщение. Мы } { возвращаем 0 для того, чтобы это было обработано немедленно. } { перемещаем сообщение в буфер для очереди сообщений } PEventMsg(lParam)^ := MessageBuffer; Result := 0 { немедленная обработка } end else { если Code не hc_Skip или hc_GetNext, то вызываем следующий hook в цепочке } Result := CallNextHookEx(HookHandle, Code, wParam, lParam); end; end; procedure StartPlayback; { Инициализируем глобальные и вешаем hook } begin { захватываем из списка первое сообщение и помещаем } { в буфер, если hc_GetNext получено перед hc_Skip } MessageBuffer := TEventMsg(MessageList.Items[0]^); { инициализируем счетчик сообщений } MsgCount := 0; { инициализируем флаги клавиш Alt, Control и Shift } AltPressed := False; ControlPressed := False; ShiftPressed := False; { вешаем hook! } HookHandle := SetWindowsHookEx(wh_JournalPlayback, Play, hInstance, 0); if HookHandle = 0 then raise ESetHookError.Create('Не могу повесить hook') else Playing := True; end; procedure MakeMessage(vKey: byte; M: word); { процедура создает запись TEventMsg, эмулирующую нажатие клавиши и } { добавляет это к списку сообщений } var E: PEventMsg; begin New(E); { выделяем память под запись сообщения } with E^ do begin Message := M; { устанавливаем поле сообщения } { больший байт ParamL является кодом vk, меньший - кодом сканирования } ParamL := MakeWord(vKey, MapVirtualKey(vKey, 0)); ParamH := 1; { счетчик повторов равен 1 } Time := GetTickCount; { устанавливаем время } end; MessageList.Add(E); end; procedure KeyDown(vKey: byte); { Генерируем KeyDownMessage } begin { не генерим клавишу "sys" (F10), если нажата клавиша Ctrl (одна из причуд Windows) } if (AltPressed and (not ControlPressed) and (vKey in [Ord('A')..Ord('Z')])) or (vKey = vk_Menu) then MakeMessage(vKey, wm_SysKeyDown) else MakeMessage(vKey, wm_KeyDown); end; procedure KeyUp(vKey: byte); { Генерируем сообщение KeyUp } begin { не генерим клавишу "sys" (F10), если нажата клавиша Ctrl (одна из причуд Windows) } if AltPressed and (not ControlPressed) and (vKey in [Ord('A')..Ord('Z')]) then MakeMessage(vKey, wm_SysKeyUp) else MakeMessage(vKey, wm_KeyUp); end; procedure SimKeyPresses(VKeyCode: Word); { Данная функция имитирует нажатие клавиши, передаваемой ей в качестве параметра, } { учитывая текущий статус клавиш Alt, Control и Shift } begin { нажимаем клавишу Alt, если выставлен соответствующий флаг } if AltPressed then KeyDown(vk_Menu); { нажимаем клавишу Control, если выставлен соответствующий флаг } if ControlPressed then KeyDown(vk_Control); { если shift не нажат, или не нажаты клавиши shif и control... } if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then KeyDown(vk_Shift); { ...нажимаем shift } KeyDown(Lo(VKeyCode)); { нажимаем клавишу down } KeyUp(Lo(VKeyCode)); { отпускаем клавишу } { если shift нажат, или не нажаты клавиши shif и control... } if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then KeyUp(vk_Shift); { ...отпускаем shift } { если флаг shift установлен, сбрасываем его } if ShiftPressed then begin ShiftPressed := False; end; { Отпускаем клавишу Control, и если флаг клавиши был установлен, сбрасываем его } if ControlPressed then begin KeyUp(vk_Control); ControlPressed := False; end; { Отпускаем клавишу Alt, и если флаг клавиши был установлен, сбрасываем его } if AltPressed then begin KeyUp(vk_Menu); AltPressed := False; end; end; procedure ProcessKey(S: String); { Данная функция выполняет разбор каждого символа в строке для создания списка сообщений } var KeyCode: word; Key: byte; index: integer; Token: TKeyString; begin index := 1; repeat case S[index] of KeyGroupOpen : begin { Это начало специального признака! } Token := ''; inc(index); while S[index] <> KeyGroupClose do begin { добавляем к признаку до тех пор, пока не столкнемся с символом окончания признака } Token := Token + S[index]; inc(index); { убеждаемся, что признак не слишком длинный } if (Length(Token) = 7) and (S[index] <> KeyGroupClose) then raise EInvalidToken.Create('Незакрытая скобка'); end; { ищем признак в массиве, в случае удачи } { параметр Key будет содержать код vk } if not FindKeyInArray(Token, Key) then raise EInvalidToken.Create('Неверный признак'); { эмулируем последовательность нажатия клавиш } SimKeyPresses(MakeWord(Key, 0)); end; AltKey : begin { устанавливаем флаг клавиши Alt } AltPressed := True; end; ControlKey : begin { устанавливаем флаг клавиши Control } ControlPressed := True; end; ShiftKey : begin { устанавливаем флаг клавиши Shift } ShiftPressed := True; end; else begin { Была нажата клавиша с нормальным символом } { конвертируем символ в число типа word, содержащее наибольший байт } { статуса shift и наименьший байт кода vk } KeyCode := vkKeyScan(MakeWord(Byte(S[index]), 0)); { эмулируем последовательность нажатия клавиш } SimKeyPresses(KeyCode); end; end; inc(index); until index > Length(S); end; function SendKeys(S: String): TSendKeyError; export; { Это первая точка входа. Базируясь на входном параметре - строке } { S, данная функция создает список keyup/keydown-сообщений, вешает } { hook на JournalPlayback, и повторяет сообщения нажатий клавиш. } var i: byte; begin try Result := sk_None; { успешный прием } MessageList := TMessageList.Create; { создаем список сообщений } ProcessKey(S); { создаем сообщения из строки } StartPlayback; { вешаем хук и воспроизводим сообщения } except { при возникновении исключения возвращаем код ошибки и наводим порядок } on E:ESendKeyError do begin MessageList.Free; if E is ESetHookError then Result := sk_FailSetHook else if E is EInvalidToken then Result := sk_InvalidToken; end else { Перехват дескрипторов всех объектов исключений гарантирует, } { что исключение не попадет в стек приложения } Result := sk_UnknownError; end; end; exports SendKeys index 1; begin end |
