|
|
|
|
Перехват (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;
beginNew(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;
beginindex := 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;
begintry
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 |
|
|
|
|
|