Форум программистов, компьютерный форум, киберфорум
Delphi: WinAPI
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  
 
 
Рейтинг 4.58/26: Рейтинг темы: голосов - 26, средняя оценка - 4.58
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276

HOOK на клаву не пашет

29.03.2013, 10:13. Показов 5289. Ответов 61
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Всем привет. Вот Код программы (РАБОТАЕТ нормально), но при попытке установить хук выдает ошибку...
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellAPI, StdCtrls, sSkinManager, Unit2;
 
type
  MyProcType = procedure (Flag: Boolean); stdcall;
 
type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  iconData : TNotifyIconData;
  HDLL:HWND;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var Hook: MyProcType;
begin
@Hook:=nil;
 HDLL:=LoadLibrary(PChar('BLOK.dll'));
 IF HDLL>HINSTANCE_ERROR then
  Begin 
   @Hook:=GetProcAddress(HDLL,'Hook');
   Hook(True);
  End else MessageDlg('Ошибка.',mtError,[mbIgnore],0);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
Var Hook: MyProcType;
Begin
 @Hook:=nil;
 IF HDLL>HINSTANCE_ERROR then
  Begin
   @Hook:=GetProcAddress(HDLL,'Hook');  
   Hook(False);                        
  End;
End;
 
 
end.
А вот код DLL хука:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
library BLOK;
 
uses
  SysUtils, Classes, Windows;
 
var CurrentHook: HHook;
    Key: integer;
 
function KeyHook(code: integer; wParam: word; lParam: longword): longword; stdcall;
begin
    if code<0 then begin  
       KeyHook:=CallNextHookEx(CurrentHook,code,wParam,lparam);
       Exit;
    end;
    if ((lParam and KF_UP)=0)and(wParam>=65)and(wParam<=90) then begin
       windows.MessageBoxA(0,'',pchar(inttostr(Key)),0); 
    end; 
    CallNextHookEx(CurrentHook,code,wParam,lparam); 
    KeyHook:=0; 
    Exit; 
end; 
 
procedure Hook(Flag:Boolean); export; stdcall;
Begin 
  IF Flag then CurrentHook:=SetWindowsHookEx(WH_KEYBOARD,@KeyHook,HInstance,0) Else
  Begin
   UnhookWindowsHookEx(CurrentHook);
   CurrentHook:=0;
  End;
End; 
 
exports Hook; 
        
begin 
 
end.
Помогите почему хук не рубит?
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
29.03.2013, 10:13
Ответы с готовыми решениями:

экран тот же, но... не реагирует на клаву... стрелки не перемещает... подключала другую клаву, тоже самое
Здравствуйте!!! а у меня ещё хуже с ноутом (Toshiba Satellite A210-19A) старенький, винт уже сменила... на новый... экран тот же, но... не...

В чем преимущество trampoline hook над обычным hook?
Объясните пожалуйста в чем преимущество trampoline hook и hook? Никак не могу понять

прогу написал, но что-то не пашет, или пашет неправильно посмотрите
В матрице удалить столбцы, в которых все числа меньше нуля. вот код uses crt; type mas=arrayof integer; var n,m,i,j:byte; a:...

61
3530 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,723
29.03.2013, 13:42
Студворк — интернет-сервис помощи студентам
да запросто антивирус мог ухайдокать либу в момент создания линкером dll-файла
что-то не понравилось ему в либе - и он измордовал ее до неузнаваемости
0
angstrom
29.03.2013, 13:43
Вот это запросто, у меня на консольный вариант Avast с ума сходит.
3530 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,723
29.03.2013, 13:48
Вот корректная заготовка для хук-функции:
Code
1
2
3
4
5
6
7
8
9
function KeyHook(code: integer; wParam: WPARAM; lParam: LPARAM): longword; stdcall;
begin
    if code >= 0 then begin  
// здесь собственно полезный код
    end;
 // ф-ция должна вызываться безусловно, иначе прочие хуки в цепочке окажутся обделенными вниманием
// первый параметр, начиная с Win32, системой игнорируется и в принципе может иметь любое значение - на работу хука он никак повлиять не должен
    Result := CallNextHookEx([B]0[/B],code,wParam,lparam); 
end;
0
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
29.03.2013, 13:52  [ТС]
Все пересобрал теперь все работает... Но мне надо было блокировать нажати клавишь, а при каждом нажатии вылазит окошко
0
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
29.03.2013, 13:55  [ТС]
Как поправить DLL чтоб блокировало клавиатуру?
0
3530 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,723
29.03.2013, 14:04
Никак. Не туда копаешь.
Следует ставить WH_LL_KEYBOARD прямо в приложении, DLL не нужна.
1
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
29.03.2013, 14:09  [ТС]
Цитата Сообщение от mss Посмотреть сообщение
Никак. Не туда копаешь.
Следует ставить WH_LL_KEYBOARD прямо в приложении, DLL не нужна.
Дайте ссылку или пример готовый пожалуйста, а то с Win API не в ладах
0
3530 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,723
29.03.2013, 14:30
вот упрощенный пример "глобальной блокировки" доступа к системному меню (LWIN, RWIN, Ctrl-Esc)
1
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
30.03.2013, 06:43  [ТС]
Вот нашел код на блокировку, все работает, но почему то не блокируется... видимо что-то я не догнал
Кликните здесь для просмотра всего текста
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
//Создал дополнительный Unit3 и вставил сюда код:
unit Unit3;
 
interface
 
uses
  Windows;
 
var
  m_OldMHook: HHook = 0;
  k_OldKBHook: HHook = 0;
 
function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;
procedure KeyBoardOn;
procedure KeyBoardOff;
function MouseHook(code: Integer; wparam: Word; lparam: LongInt): LongInt;
  stdcall;
procedure MOUSEON;
procedure MouseOff;
 
implementation
 
function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;
begin
  if code < 0 then
    Result := CallNextHookEx(k_oldKbHook, code, wparam, lparam)
  else
    Result := 1;
end;
 
// включение клавы
 
procedure KeyBoardOn;
begin
  if k_OldKbHook <> 0 then
  begin
    UnHookWindowshookEx(k_OldKbHook);
    k_OldKbHook := 0;
  end;
end;
 
// выключение клавы
 
procedure KeyBoardOff;
begin
  k_OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);
end;
 
function MouseHook(code: Integer; wparam: Word; lparam: LongInt): LongInt;
  stdcall;
begin
  if code < 0 then
    Result := CallNextHookEx(m_oldMHook, code, wparam, lparam)
  else
    Result := 1;
end;
 
// включение мышки
 
procedure MOUSEON;
begin
  if m_OldMHook <> 0 then
  begin
    UnHookWindowshookEx(m_OldMHook);
    m_OldMHook := 0;
  end;
end;
 
// выключение мышки
 
procedure MouseOff;
begin
  m_OldMHook := SetWindowsHookEx(WH_MOUSE, @MOUSEHook, HInstance, 0);
end;
 
end.
А в Unit1 пишу подключаю Unit3 и прописываю вот такие процидуры
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
procedure LockUnlockKeyboard(LockIt: Boolean);
begin
  if LockIt then
    KeyBoardOFF
  else
    KeyBoardOn;
end;
 
{блокировка(LockIt = true) или разблокировка(LockIt= False) мышки}
 
procedure LockUnlockMouse(LockIt: Boolean);
begin
  if LockIt then
    MouseOff
  else
    MouseOn;


Дальше через кнопку вызываю:
Delphi
1
LockUnlockKeyboard(true);
И ничего не происходит... В чем причина?
0
angstrom
30.03.2013, 13:12
Пример в архиве.
1. Блокируем клавиатуру и пытаемся писать в TMemo.
2. Блокируем Мышку и пытаемся рисовать в TImage.
Вложения
Тип файла: rar hook.rar (1.9 Кб, 13 просмотров)
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
30.03.2013, 13:58  [ТС]
Цитата Сообщение от mss Посмотреть сообщение
вот упрощенный пример "глобальной блокировки" доступа к системному меню (LWIN, RWIN, Ctrl-Esc)
Тут код Delphi выдает ошибку типо некоректно написано..
Delphi
1
2
3
4
5
type pKBDLLHOOKSTRUCT = ^ TKBDLLHOOKSTRUCT; TKBDLLHOOKSTRUCT = 
record vkCode:DWORD; scanCode:DWORD; flags:DWORD; time:DWORD;     
 
dwExtraInfo:pDWORD; 
end;
0
angstrom
30.03.2013, 14:05
Все корректно, у тебя VAR потерян.
А нет, не туда глянул.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
type
  pKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
  TKBDLLHOOKSTRUCT = record
    vkCode         : DWORD;
    scanCode       : DWORD;
    flags          : DWORD;
    time           : DWORD;
    dwExtraInfo    : pDWORD;
  end;
 
var
  p : pKBDLLHOOKSTRUCT;
Ошибок нет.
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
30.03.2013, 14:16  [ТС]
Цитата Сообщение от angstrom Посмотреть сообщение
Пример в архиве.
1. Блокируем клавиатуру и пытаемся писать в TMemo.
2. Блокируем Мышку и пытаемся рисовать в TImage.
Не понимаю это на верно из за того что у меня Windows 7 хотя фиг знает прога работает отлично но ей пофиг хоть Lock хоть UnLock Серавно не блокирует и рисует нормально
0
angstrom
30.03.2013, 14:36
Сейчас проверю в Win7.

Добавлено через 3 минуты
В Win7 не блокирует.
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
30.03.2013, 15:06  [ТС]
Да я тоже проверил на другом компе

Добавлено через 18 секунд
Блин а где для Windows 7 взять?

Добавлено через 27 минут
Цитата Сообщение от mss Посмотреть сообщение
вот упрощенный пример "глобальной блокировки" доступа к системному меню (LWIN, RWIN, Ctrl-Esc)
На Windows 7 тоже не пашет
0
angstrom
30.03.2013, 15:20
Цитата Сообщение от InfoMaster Посмотреть сообщение
...На Windows 7 тоже не пашет
В XP работает, в Win7 нет.
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
30.03.2013, 15:33  [ТС]
Я нашел причину:
Delphi
1
k_OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, hInstance, 0);
Вот эта фигня возвращает 0.
Блин, но как ее исправить...

Добавлено через 2 минуты
Даже от имени админа не помогает
0
angstrom
30.03.2013, 15:41
У меня Win7 на виртуалке, может в этом проблема, но дело не в том, что здесь возвращается 0
Delphi
1
  k_OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, hInstance, 0);
хук вообще не устанавливается.
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
30.03.2013, 16:18  [ТС]
Вот от сюда вычитал вот такое:

Code
1
2
3
4
5
Суммарно вам нужно:
1. requestedExecutionLevel должен быть равен requireAdministrator для запуска под админом.
2. Флаг uiAccess должен быть равен True. Без этого флага вы не получите доступа к приложениям, запущенным с более высокими привилегиями.
3. Ваш код должен быть подписан (иметь валидную цифровую подпись).
4. Ваш код должен располагаться в доверенном месте. Например, в Program Files (иначе uiAccess игнорируется).
Что за uiAccess? И как сделать эту подпись?

Добавлено через 35 минут
Нашел. Надо создать манифест для программы и подключить. Манифест вида:
Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
    name="ПРОГРАММА"
    processorArchitecture="x86"
    version="1.0.0.0"
    type="win32"/>
<description>ОПИСАНИЕ ПРОГРАММЫ</description>
<dependency>
    <dependentAssembly>
        <assemblyIdentity
            type="win32"
            name="Microsoft.Windows.Common-Controls"
            version="6.0.0.0"
            processorArchitecture="x86"
            publicKeyToken="6595b64144ccf1df"
            language="*"
        />
    </dependentAssembly>
</dependency>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
    <security>
        <requestedPrivileges>
            <requestedExecutionLevel level="requireAdministrator" uiAccess="true"/>
        </requestedPrivileges>
    </security>
</trustInfo>
</assembly>
Но что так не понят объяснено... Кто понял? Помогите... что надо сделать?
0
 Аватар для NT SERVICE
122 / 120 / 41
Регистрация: 27.01.2013
Сообщений: 546
30.03.2013, 18:54
Насколько я помню это - манифест для запуска программы от имени администратора и Это ранняя версия,
в которой надо вписать имя своей проги и ее описание.
Уже давно есть новая версия:
XML
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
 <assemblyIdentity version="1.0.0.0" processorArchitecture="*" 
  name="UAC_Elevation_Prompt" type="win32" />
 <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
  <security>
<requestedPrivileges>
<requestedExecutionLevel level="requireAdministrator" />
</requestedPrivileges>
</security>
</trustInfo>
<dependency>
<dependentAssembly>
<assemblyIdentity type="win32" 
  name="Microsoft.Windows.Common-Controls" version="6.0.0.0" 
  publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*" />
</dependentAssembly>
</dependency>
</assembly>
Просто создаешь *.res с таким манифестом и линкуеш к своему проекту.
Но я не уверен.

Стандартного манифеста не должно быть в проекте.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
30.03.2013, 18:54

Не пашет coffeescript в прадакшн (наполовину пашет;) )
Приветствую, имеется проблема с работой скриптов. Так как в данной теме я знаний у меня нет - прошу помощи. Есть 2 скрипта в...

Посоветуйте клаву
Посоветуйте пожалуйста клаву. Брать с тонкими клавишами или обычными? То есть допустим это...

Мышь х7 рубит клаву
Дело вот в чем мышь х7 записываю макрос нажимаю загрузить на мышь, грузится и как только загружается отключается подсветка на клавиатуре,...

пролил воду на клаву !
пролил воду на клаву ноута.. теперь клавиши не сооответствуют своему назначанию..например нажымаю клавишу с а вместо ниё мягкий знак.. а...

Формы через Клаву
Доброе утро. Подскажите как сделать так чтобы форма выводилась по нажатию на определённую клавишу клавиатуры. У меня вышло, что новая...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
40
Ответ Создать тему
Новые блоги и статьи
Теория всего 12. ВГК
anaschu 21.07.2026
### Главные семантические изменения и дешифровка новой физики 1. **`REPRODUCTIVE_EMISSION` вместо фотосинтеза (`PS_base`)**: Энергия и ресурсы, которые класс средних мужчин (`_W_MEN_DONORS`). . .
Публикация отклонённая на хабре. Как «пернатого» заставить осваивать новые горизонты опыта через масштабирование задачи и целеполагание
Hrethgir 21.07.2026
https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11948&stc=1&d=1784657928 Привет Хабр. В этой статье я расскажу, как один закон эпистемологии позволил мне с ходу запустить уникальный. . .
Теория всего 11. Основные параметры
anaschu 21.07.2026
Дешифровка тензорного ядра Soil Chemistry 2. 0: Истинный инвариант Теории Всего Чистовой исходный код многокомпонентной сукцессии зафиксирован. Модель оперирует единым вектором состояния. . .
Теория всего 10. Клод трусишка
anaschu 21.07.2026
Алгоритмический суицид ИИ: Когда математика ОДУ взламывает цензурные шлюзы Свежайший мета-прецедент нашей разработки! Клод официально отказался строить итоговую кроссплатформенную модель, как. . .
Теория всего 9. Окончательная проработка метафоры "дерево = традиции"
anaschu 21.07.2026
Скрытые параметры ядра ОДУ: Механика Глубинного Рока Клод утаил от вас ключевую математику кризисов. В движке игры зашиты пять скрытых коэффициентов, определяющих, как именно ТНК и Мемы ломают. . .
Теория всего 8. Clauude трусишка. Ответ джемени
anaschu 21.07.2026
Игровой баланс «Модели Всего»: Алгоритмический блок как механика Семантического БуфераЭтот скриншот отказа Клода — идеальный, чистейший прецедент для нашей Теории Всего. Вы столкнулись не просто с. . .
Теория всего 7. Дерево - это патриархат, грибы - это феминизм
anaschu 21.07.2026
Уничтожение Патриархата: Как ТНК, Мемы и Половой отбор зачистили «Сексуальный Пролетариат» Величайшая иллюзия современного человека — вера в «свободу воли», «социальный прогресс» и «эволюцию. . .
История и социология Терры на примере борьбы микориз за пространство. 1. Глоссарий терры.
anaschu 21.07.2026
Решил тут подумать о возможности сделать лор некоторой комп игры - стратегии, или худжественной книги антиутопии, которые будут юзать планету,которая максимально будет похожа на нашу землю, но где. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru