25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276

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

29.03.2013, 10:13. Показов 5334. Ответов 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
Ответ Создать тему
Опции темы

Новые блоги и статьи
Был там один разговор по поводу свободы в материальном мире.
kumehtar 19.08.2026
Суть: рассматривается живое существо, оказавшееся внутри довольно странной системы (этого мира) и пытающееся обустроить в ней свой кусок пространства. Жизнь действительно предъявляет каждому. . .
Когда логика программы не спасает от человеческих ошибок
Maks 18.08.2026
В последнее время всё чаще и чаще сталкиваюсь с таким явлением, как абсолютная невнимательность (или глупость) пользователей. Проявляется это чаще всего на работе в коллективе. Допустим, человек с. . .
Лето уходит
kumehtar 17.08.2026
Мысли в слух
kumehtar 17.08.2026
Забавно, насколько сейчас стала доступна информация. Например о магии, духовном развитии, медитациях, и других подобных направлениях, ранее зачастую тайных, передаваемых от учителя к ученику. Хотя. . .
Перемещение строк из ТЧ в другой документ с учетом текущего пробега
Maks 17.08.2026
Реализация из решения ниже выполнена на примере нетипового документа "Автозапчасти", с ТЧ "Шины". За основу взят алгоритм отсюда: https:/ / www. cyberforum. ru/ blogs/ 359708/ 10838. html Задача: . . .
Саморегулирующийся социальный контракт для сервера cross-section.
Hrethgir 14.08.2026
С кодом конечно таких глубоких размышлений пока не было, впрочем я уже привык к алгоритмизации. Суть предмета записи: снова в диалоге с нейросетью (я взял пока себе ник для учётки админа - Rector). . . .
Часы электронные
Uhbif79 12.08.2026
Выкладываю программу часов. Программа позволяет: 1. Использовать системное время и дату, 2. Есть возможность вводить время и дату вручную. 3. Реализованы 2 будильника: начало и конец рабочего дня. . . .
Часы с будильником на основе класса QLCDNumber
Uhbif79 12.08.2026
Всем добрый день, выкладываю программу часов с будильником на основе класса QLCDNumber. Здесь я пробовал самостоятельно создавал классы, впервые столкнулся с видимостью переменной одного класса из. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru