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

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

29.03.2013, 10:13. Показов 5305. Ответов 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
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
30.03.2013, 20:37  [ТС]
Студворк — интернет-сервис помощи студентам
NT SERVICE а там флаг нужно еще дописать uiAccess?
Кликните здесь для просмотра всего текста
Delphi
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" uiAccess="true"/>
</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>


Добавлено через 5 минут
И как сделать этот .res файл? Пытался через Total Comander в консоли прописывал brcc32.exe manifest.rc но файл manifest.res не создается...
0
 Аватар для NT SERVICE
122 / 120 / 41
Регистрация: 27.01.2013
Сообщений: 546
30.03.2013, 21:17
Цитата Сообщение от InfoMaster Посмотреть сообщение
И как сделать этот .res файл?
Есть много способов, которые можно найти на этом форуме, но я лично ими не пользуюсь, т.к.
неудобно. Я использую ресторатор 2007 - он сразу создает *.res файл.
Опишу работу с ресторатор:
1 создаешь новый ресурс(*.res)
2 создаешь новый текстовый файл
3 вставляешь код(который я тебе дал)
4 меняешь кодировку на UTF8(я пользуюсь notepad++)
5 имя файла "1" расширение "Manifest" (1.Manifest)
6 Перетащи в ресторатор
7 сохрани под любым именем на латинице (MF.res)

Delphi
1
2
{$R *.dfm}
{$R MF.res} // в проекте добавь вот - это
В дельфи программу запускать нельзя - ВЫКИНЕТ!
Просто компилируешь и видишь, что иконка уже со щитом!
А при двойном клике видишь запрос на права администратора.
1
angstrom
30.03.2013, 21:30
Понаписал-то, понаписал. Способ у него свой. Чем тебе стандартные не угодили? И чем твой манифест (новый) отличается от других? Ещё и кодировку зачем менял придумал. Создаётся текстовый файл с расширением rc, в нём пишется
Delphi
1
1 24 "название манифеста"
и всё. собирается через brcc32.exe
 Аватар для NT SERVICE
122 / 120 / 41
Регистрация: 27.01.2013
Сообщений: 546
30.03.2013, 21:56
"encoding="***" должен совпадать с кодировкой документа.
Иначе он будет некорректно прочитан.

Почему UTF8?. Да фиг его знает - это не я придумал!

Цитата Сообщение от angstrom Посмотреть сообщение
и всё. собирается через brcc32.exe
На вкус и цвет все фломастеры разные, мне легче в рестораторе, т.к собрать в нем *.res с
множеством файлов заметно легче, чем писать их список в блокноте и даже один файл - это
всего лишь пару кликов .

Цитата Сообщение от angstrom Посмотреть сообщение
И чем твой манифест (новый) отличается от других?
Он уже готов и не надо там что - то менять.
0
angstrom
30.03.2013, 22:04
А вот теперь возьми Restorator, открой полученный res-файл и сохрани как rc-файл. Посмотри полученное содержимое, много нового для себя откроешь.
В манифесте, который выложил TC, также ничего менять не нужно. Сравни его манифест и свой и попытайся найти отличия помимо названия программы.

P.S. Попробуй в Resorator-е создать диалоговые окна в пару кликов - весело будет.
 Аватар для NT SERVICE
122 / 120 / 41
Регистрация: 27.01.2013
Сообщений: 546
30.03.2013, 22:22
Цитата Сообщение от angstrom Посмотреть сообщение
А вот теперь возьми Restorator, открой полученный res-файл и сохрани как rc-файл. Посмотри полученное содержимое, много нового для себя откроешь.
В манифесте, который выложил TC, также ничего менять не нужно. Сравни его манифест и свой и попытайся найти отличия помимо названия программы.
Я не буду спорить на эту тему, но проблема в том, что в свою программу добавил этот - же манифест
в кодировки ansi результат такой-же как и без его, пробовал такой как предложил InfoMaster
тоже не работает.
А мой работает, но замечу, что у меня Windows 7 максимальная 7600 и на других я не пробовал.
Может на XP он и работает.
1
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 07:33  [ТС]
Блин ччтот ваще не чего не создает... Создайте котонибудь плиз RES файл с вот таким кодом:
Code
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" uiAccess="true"/>
</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>
0
 Аватар для NT SERVICE
122 / 120 / 41
Регистрация: 27.01.2013
Сообщений: 546
31.03.2013, 09:04
Вот держи.
Вложения
Тип файла: rar UAC.rar (490 байт, 14 просмотров)
1
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 09:14  [ТС]
Ну как так? Вот все точно также делал , а консоль пишет ошибку:
Error uac.rc 1 2: Bad character in source input

Добавлено через 3 минуты
Хм все равно не фурчит. Манифест работает отлично... Наверно проге еще цифровая подпись нужна
0
 Аватар для NT SERVICE
122 / 120 / 41
Регистрация: 27.01.2013
Сообщений: 546
31.03.2013, 10:26
Распакуй архив в папку своего проекта.

И объяви ресурс:

Delphi
1
{$R UAC.res}
Потом просто компилируй и запусти в не дельфи.
0
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 12:08  [ТС]
Я же сказал манифест работает отлично.. шит на значке нарисован... прогу поместил в папку Program Files\Прога\
Но программа все равно не блокирует клаву (функция k_OldKbHook возвращает 0 ) Скорее всего требует цифровой подписи... Но как ее сделать ХЗ (програмно разумеется)
0
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 12:45  [ТС]
Вот готова прога. BLOK.rar Проверьте пожалуйста те у кого Windows 7... Я сделал ей электронную подписку серавно у меня не блокирует клаву. Может у вас у кого нибудь заработает.
0
angstrom
31.03.2013, 12:50
Выбрось на фиг предложенный тебе res-файл и сделай в коде небольшое изменение
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
function KeyboardOnOff : Boolean;
begin
  KeyboardLock := not KeyboardLock;
  case KeyboardLock of
    True : k_OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, hInstance, GetCurrentThreadId); // здесь
 
    False :
    begin
      if k_OldKbHook <> 0 then
      begin
        UnHookWindowshookEx(k_OldKbHook);
        k_OldKbHook := 0;
      end;
    end;
 
  end;
 
  Result := KeyboardLock;
end;
 
function MouseOnOff : Boolean;
begin
  MouseLock := not MouseLock;
  case MouseLock of
    True : m_OldMHook := SetWindowsHookEx(WH_MOUSE, @MOUSEHook, hInstance, GetCurrentThreadId); // здесь
 
    False :
    begin
      if m_OldMHook <> 0 then
      begin
        UnHookWindowshookEx(m_OldMHook);
        m_OldMHook := 0;
      end;
    end;
  end;
 
  Result := MouseLock;
end;
Проверил на Win 7, нормально блокирует.
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 13:00  [ТС]
Спасибо.. .Вот только почему блокируется ввод только в программе попробовал писать в блокноте пишет и все комбенации CAD, Ctrl+Tab+Esc, Win+D, Win+L, Alt+Tab Все работаю... Жаль я ждал от этого кода больше...
0
angstrom
31.03.2013, 13:04
Так такой код и должен работать только локально, а Ctrl-Alt-Del вообще проблематично заблокировать.
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 13:05  [ТС]
Ну с CAD у меня проблем нет... Но вот с Win+D , Win+L и Alt+Tab
0
 Аватар для NT SERVICE
122 / 120 / 41
Регистрация: 27.01.2013
Сообщений: 546
31.03.2013, 13:07
Соглашусь права администратора тут не причем!

Цитата Сообщение от InfoMaster Посмотреть сообщение
возвращает 0
Обрати внимание на твой код выше:

Delphi
1
windows.MessageBoxA(0,'',pchar(inttostr(Key)),0);
Ты ничего не присваиваешь переменной KEY, потому и 0

Delphi
1
 windows.MessageBoxA(0,'',pchar(IntToStr(wParam)),0);
0
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 13:40  [ТС]
Не это не мой код... Я по другому писал

Добавлено через 29 минут
Вот в чем проблема...
Если идентификатор неравен нулю, то хук устанавливается только на указанный поток. Если идентификатор равен нулю, то хук устанавливается на всю систему.
Но при установке 0 программа перестает работать из-за UAC... Какой-то замкнутый круг получается...
0
angstrom
31.03.2013, 14:24
Как всё хорошо начиналось, а заканчивается банальной попыткой вымогательства денег у бедных юзеров.
25 / 14 / 3
Регистрация: 12.08.2011
Сообщений: 276
31.03.2013, 15:15  [ТС]
Я тут подумал можно по всем окнам активным пройтись и поставить на них хук... Ведь когда будет выполняться строка из кода:
Delphi
1
k_OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, hInstance, GetCurrentThreadId);
ТО если будет активно окно другое (например Диспетчер задач), то номер потока GetCurrentThreadId будет отличаться от номера потока самой проги... => и hook будет ставиться на все другие проги... Но надо еще проводник заблокировать будет... Поправьте если где-то ошибся
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
31.03.2013, 15:15

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

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

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

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

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


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

Или воспользуйтесь поиском по форуму:
60
Ответ Создать тему
Новые блоги и статьи
тв 16 бой ии
anaschu 27.07.2026
Великий Перелом ИИ: Как уравнения ОДУ Radau дожали цензурные фильтры Алисы Фиксируем в мемофонде Теории Всего беспрецедентный факт в истории ИИ-зондирования. В затяжном многораундовом. . .
мв 15. непроверенное, возможно, глюк
anaschu 27.07.2026
НАУЧНО-АНАЛИТИЧЕСКИЙ ОТЧЕТ. РАЗДЕЛ 1. 1: «НАУКА» (РАСШИРЕННАЯ СТЕХИОМЕТРИЧЕСКАЯ И ГЕНЕТИЧЕСКАЯ ВЕРСИЯ)Тема: Теоретическое обоснование инвариантности 19-мерного тензорного ядра непрерывных ОДУ и. . .
Очистка реквизитов и табличных частей документа при копировании
Maks 26.07.2026
Алгоритм из решения ниже разработан на примере нетипового документа "ЗаявкаНаРаботу", разработанного в КА2. Задача: Заменить алгоритм запрета копирования документов для сотрудников с ролью "Стажер",. . .
Доктрина интенционального знания - Доктрина для портала "Срез".
Hrethgir 25.07.2026
Может найдётся кто захочет оценить доктрину. . . Написания правил участия для меня роскошь, требующая лимита времени, поэтому все сообщения не прошедшие модерацию будут видны только участникам портала,. . .
сукцессия 44. Решил подать на припринт в межународные сервисы препринтов. Но нужно одобрение от ученых
anaschu 25.07.2026
Английский вариант. Пока кто то не одобрит мою личность, мне не получиться это опубликовать на препринте. Но заявку на публикацию статьи я сегодня подам.
сукцессия 43. Вторая научная статья за месяц- прайминг и гатгил
anaschu 25.07.2026
две стороны одной монеты
Более приземисто - Эстафету хвоста в .cdl (деревья эстафеты в сад).
Hrethgir 24.07.2026
В будущем, после написания блока инверсии обхода дерева (эстафеты хвоста), я планирую вернуться к нашему прошлому разговору о том, обладают ли знания целеполаганием. Тогда я пришел к выводу, что. . .
Вот представьте что вам дали бессмертие.
kumehtar 24.07.2026
Вот представьте что вам дали бессмертие, ничего более не меняя. Вообще ничего, только бессмертие в нынешнем виде. Рады были бы? Что бы вы тут делали всё это время? Никакой пенсии. Никакого нового. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru