Советы по Delphi


              

Перехват (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
[000140]



Содержание  Назад  Вперед