VPF::Клавиатурный HOOK без DLL - Форум программистов

maestro2k

Дата 18.4.2006, 19:42 (ссылка)

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

Загрузка ...

Шустрый

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

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

Ребята подскажите, возможно ли, клавиатурный HOOK без DLL.
И дайте плиз пример.

Voyager

Дата 18.4.2006, 20:16 (ссылка)

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

Загрузка ...

Опытный

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

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

Если локальный для программы, то возможен, если глобальный для системы то без dll не обойтись. Насчет исходников - тут на форуме их заройся, ищи.

Rouse_

Дата 18.4.2006, 20:49 (ссылка)

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

Загрузка ...

Опытный

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

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

Начиная с 2000 ставь WH_KEYBOARD. Для него не требуется отдельная библиотека.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

var
  hHook: THandle;

{$R *.dfm}

function LowLevelKeyboardProc(nCode: Integer;
  WParam: WPARAM; LParam: LPARAM): LRESULT stdcall;
type
  PKbdDllHookStrukt = ^TKbdDllHookStrukt;
  _KBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: PDWORD;
  end;
  TKbdDllHookStrukt = _KBDLLHOOKSTRUCT;

const
  RPT_WPARAM_DATA = 'Keyboard message = %s ';
  RPT_LPARAM_DATA = 'scan code = %s [%d]';
var
  StrResult: String;
begin
  StrResult := '';
  if nCode = HC_ACTION then
    Result := CallNextHookEx(hHook, nCode, WParam, LParam);
  case WParam of
    WM_KEYDOWN: StrResult := Format(RPT_WPARAM_DATA, ['WM_KEYDOWN']);
    WM_KEYUP: StrResult := Format(RPT_WPARAM_DATA, ['WM_KEYUP']);
    WM_SYSKEYDOWN: StrResult := Format(RPT_WPARAM_DATA, ['WM_SYSKEYDOWN']);
    WM_SYSKEYUP: StrResult := Format(RPT_WPARAM_DATA, ['WM_SYSKEYUP']);
  end;

  StrResult := StrResult + Format(RPT_LPARAM_DATA, [
    Chr(PKbdDllHookStrukt(LParam)^.vkCode), PKbdDllHookStrukt(LParam)^.vkCode]);
  Form1.Memo1.Lines.Add(StrResult);
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  WH_KEYBOARD_LL = 13;
begin
  hHook := SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, hInstance, 0);
  if hHook = 0 then RaiseLastOSError;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if not UnhookWindowsHookEx(hHook) then RaiseLastOSError;
end;

end.

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

maestro2k

Дата 18.4.2006, 22:19 (ссылка)

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

Загрузка ...

Шустрый

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

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

Я пишу под WinApi, а этот пример требует добавления модулей Messages и SysUtils.

Нету ли другого способа?

Это сообщение отредактировал(а) maestro2k - 19.4.2006, 00:10

Rouse_

Дата 19.4.2006, 09:08 (ссылка)

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

Загрузка ...

Опытный

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

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

Маэстро - вы меня поражаете smile

Messages то зачем убирать? Там лежат только описания констант и в проект оттуда подгружаются только те, которые необходимы для использования. Кстати смею уверить - программирование на АПИ не включает в себя отключение данного модуля smile

ЗЗЫ: А вообще пример под апи можно было и переписать самому.

Код


program Project8;

uses
  Windows,
  Messages;

resourcestring
  TXT_CAPTION = 'Демо низкоуровнего хука.';

var
  MainWindow    : TWndClassEx;
  Msg           : TMsg;
  Left,
  Top,
  Width,
  Height        : Integer;
  RootHandle,
  hMemo,
  hHook,
  hFontNormal   : THandle;
  ClientRect    : TRect;

const
  WH_KEYBOARD_LL = 13;
  ID_MEMO = 100;

// Центрирование формы
// =============================================================================
procedure CenterMainForm;
var
  ScrWidth, ScrHeight: Cardinal;
begin
  ScrWidth := GetSystemMetrics(SM_CXSCREEN);
  ScrHeight := GetSystemMetrics(SM_CYSCREEN);
  Left := (Integer(ScrWidth) - Width) div 2;
  Top := (Integer(ScrHeight) - Height) div 2;
end;

// Обработчик низкоуровневого хука
// =============================================================================
function LowLevelKeyboardProc(nCode: Integer;
  WParam: WPARAM; LParam: LPARAM): LRESULT stdcall;
type
  PKbdDllHookStrukt = ^TKbdDllHookStrukt;
  _KBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: PDWORD;
  end;
  TKbdDllHookStrukt = _KBDLLHOOKSTRUCT;

const
  RPT_WPARAM_DATA = 'Keyboard message = ';
  RPT_LPARAM_DATA = 'scan code = ';
var
  StrResult, StrCurentText: String;
  Len: Integer;
begin
  StrResult := '';
  if nCode = HC_ACTION then
    Result := CallNextHookEx(hHook, nCode, WParam, LParam);
  case WParam of
    WM_KEYDOWN: StrResult := RPT_WPARAM_DATA + 'WM_KEYDOWN, ';
    WM_KEYUP: StrResult := RPT_WPARAM_DATA + 'WM_KEYUP, ';
    WM_SYSKEYDOWN: StrResult := RPT_WPARAM_DATA + 'WM_SYSKEYDOWN, ';
    WM_SYSKEYUP: StrResult := RPT_WPARAM_DATA + 'WM_SYSKEYUP, ';
  end;
  Len := SendMessage(hMemo, WM_GETTEXTLENGTH, 0, 0) + 1;
  SetLength(StrCurentText, Len);
  SendMessage(hMemo, WM_GETTEXT, Len, Integer(@StrCurentText[1]));
  StrCurentText[Len] := ' ';
  StrResult := StrResult + RPT_LPARAM_DATA +
    Chr(PKbdDllHookStrukt(LParam)^.vkCode);
  StrCurentText := String(StrCurentText) + StrResult + #13#10;
  SendMessage(hMemo, WM_SETTEXT, 0, Integer(@StrCurentText[1]));
  Len := SendMessage(hMemo, WM_GETTEXTLENGTH, 0, 0) + 1;
  SendMessage(hMemo, EM_SETSEL, Len, Len);
  SendMessage(hMemo, EM_SCROLLCARET, 0, 0);
end;     


// Главная оконная процедура
// =============================================================================
function WindowProc(Wnd: HWND; Msg: Integer;
  WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
  case Msg of
    WM_DESTROY:
    begin
      PostQuitMessage(0);
      Result:=0;
    end;
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

// Здесь программа стартует
// =============================================================================
begin
  with MainWindow do
  begin
    cbSize := SizeOf(MainWindow);
    style := CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hIcon := LoadIcon(0, IDI_APPLICATION);
    hCursor  := LoadCursor(0, IDC_ARROW);
    hbrBackground := COLOR_BTNFACE + 1;
    lpszMenuName := nil;
    lpszClassName := 'Demo';
  end;
  MainWindow.hInstance := HInstance;
  if RegisterClassEx(MainWindow) = 0 then
  begin
    Exit;
  end;
  
  Width := 360;
  Height := 200;
  CenterMainForm;

  RootHandle := CreateWindowEx(WS_EX_CONTROLPARENT, 'Demo',
    PChar(TXT_CAPTION), WS_OVERLAPPED or WS_SYSMENU,
    Left, Top, Width, Height, 0, 0, HInstance, nil);

  GetClientRect(RootHandle, ClientRect);
  ClientRect.Bottom := ClientRect.Bottom - ClientRect.Top;
  ClientRect.Right := ClientRect.Right - ClientRect.Left;

  hMemo := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', nil,
    ES_MULTILINE or WS_VSCROLL or WS_CHILD or WS_VISIBLE,
    0, 0, ClientRect.Right, ClientRect.Bottom, RootHandle,
    ID_MEMO, HInstance, nil);

  hFontNormal := CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,
                      OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
                      DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');

  if hFontNormal <> 0 then
    SendMessage(hMemo, WM_SETFONT, hFontNormal, 0);

  ShowWindow(RootHandle, SW_SHOW);

  hHook := SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, hInstance, 0);
  if hHook = 0 then PostQuitMessage(GetLastError);

  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

  UnhookWindowsHookEx(hHook);

end.

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

maestro2k

Дата 19.4.2006, 21:40 (ссылка)

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

Загрузка ...

Шустрый

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

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

Rouse_ При подключении SysUtils моё приложение увеличивается с 20кб до 45кб, а Messages да согласен.
Еще вопрос как рускую разкладку обрабатывать?

Это сообщение отредактировал(а) maestro2k - 19.4.2006, 22:07

Poseidon

Дата 19.4.2006, 23:01 (ссылка)

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

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

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

Цитата(maestro2k @ 19.4.2006, 20:40

)

При подключении SysUtils

А зачем там SysUtils, Там ведь нужно только Windows и Messages;

Цитата(maestro2k @ 19.4.2006, 20:40

)

Еще вопрос как рускую разкладку обрабатывать?

Что имеется ввиду? И вообще: один топик - один вопрос

--------------------

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

Loader

Дата 23.4.2006, 15:08 (ссылка)

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

Загрузка ...

Новичок

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

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

Сделать хук на клавиатуру без длл очень просто, надо просто поступить, как приложения, которые записывают макросы и ставить хук на WH_JOURNALRECORD, а в callback-процедуре ловить клавиши, отсеивая движения мыши и прочее. В MSDN это даже документировано.

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