:Приветсвую
Делаю ловушку на клавиатуру. Использую Hook, использую DLL. Все норм работает, но есть проблема - при запуске проги все тормозит. TaskMan 100%ую загрузку ЦП показывает.
Видать получился глобальный Хук, а хотелось чтоб не тормозило. Помогите плз

Я тоже когда-то пытлся делать ловушки, осталось вот несколько примеров, незабывай проверять раскладку клавиатуры.

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

Можно использовать getkeystate тогда и без дллки обойтись можно.

Budy Покажи код.

Прога, запускающая DLL'ку:

Код

procedure StartHOOK; stdcall; external 'getkeys.dll' index 1; begin   StartHOOK;   repeat until false; end.

Прога в памяти весит, всего около 300 Кб имеет.
А вот DLL'ка:

Код

library getkeys; uses windows; type    ca=array[0..255] of Char; var   HookHandle: hHook = 0;   hook:hHook=0;   Last_Key: String; //Из заглавных в строчные function DownKey(key: char): char; begin ... end; //По клавиатуре с англ на русс function lat_to_rus(key: char):char; begin ... end; //Сохраняем полученную клавишу procedure AddKey(Key: String); begin ... end; function gethook(code: integer; wParam, lParam: longint): longword; StdCall; var   Key_Name: Char_array;   WhatLan: Array[0..$FFF] of Char;   CapsLock, Russian: Boolean;   ResKey: Char;   Key: String; begin   if Code<0 then begin     Result:=CallNextHookEx(HK,Code,wParam,lParam);     Exit;   end;   if(Code=HC_ACTION)and(((lParam shr 16) and KF_UP)=0)then     begin       CapsLock:=(GetKeyState(VK_CAPITAL) and $01)<>0;       if GetKeyboardLayoutName(WhatLan)then if WhatLan='00000419' then Russian:=True else Russian:=False;       GetKeyNameText(lParam, Key_Name, sizeof(Key_Name));       Key:=Key_Name; //Если буква или цифра (1 символ)       if Length(Key)=1 then         begin           case Key[1] of             '1'..'9','0':ResKey:=Key[1];             'A'..'Z':begin                       if Russian then ResKey:=lat_to_rus(Key[1])else ResKey:=Key[1];                       if CapsLock=False then ResKey:=DownKey(ResKey);                      end;             else ResKey:=Key[1];           end;           Key:='';         end else           begin             if Key='Space' then Key:=' ' else             if Key='Page Up' then Key:=' [PUp] ' else             if Key='Page Down' then Key:=' [PDown] ' else             if Key='Right Shift' then Key:=' [RShift] ' else             if Key='Right Alt' then Key:=' [RAlt] ' else             if Key='Right Ctrl' then Key:=' [RCtrl] ' else             if Key='Insert' then Key:=' [Ins] ' else             if Key='Delete' then Key:=' [Del] ' else             if Pos('Num ',Key)>0 then Key:=' [N'+Copy(Key,5,Length(Key)-4)+'] ' else             Key:=' ['+Key+'] ';           end;       if Key='' then Key:=ResKey;       if(Last_Key<>Key)or(Length(Key)=1) then AddKey(Key);       if(Pos('Ctrl',Key)>0)or(Pos('Alt',Key)>0)or(Pos('Shift',Key)>0)then Last_Key:=Key else Last_Key:='';     end;   CallNextHookEx(HK,Code,wParam,lParam);   Result:=0; end; procedure StartHOOK; StdCall; begin   hook:=SetWindowsHookEx(WH_KEYBOARD,@gethook,hInstance,0); end; exports   StartHOOK; end.

PS.В коде (здесь строки 75-76) пробовал писать Result:=CallNewxt...... Тогда клавиши не возращаются нужным приложениям.


Bes, расскажи поподробнее. Просто пробовал в EXE'шник пихнуть - когда на клаве щелкаешь кнопки при других окнах, они закрываются.

Это сообщение отредактировал(а) Budy - 20.4.2005, 17:25

Убери repeat until false;

RAdmin, дык тогда ничего работать и не будет

Ты пробовал?

То верхнее это моя оценка на вскидку.

А вот специально решил
посмотреть что к чему:



Почему в CallNextHookEx(HK,Code,wParam,lParam); переменная "HK"
а тут
hook:=SetWindowsHookEx(WH_KEYBOARD,@gethook,hInstance,0); hook ?

Они хоть потом связываются или как?
Я заменил HK на Hook.


Загузчик ......

implementation
function StartHOOK: Longint; external 'getkeys.dll' name 'StartHOOK';
{$R *.dfm}

procedure .....
begin
StartHOOK;
end;


И всё работает пучком.

ЗЫ: так как код процедуры "AddKey" ты не показал то я туда вставил бональный ShowMessage. (для теста)

RAdmin, я с "HK" и "hook" перепутал, короче это одна и та же переменная, иначе "hook: HHOOK;"
AddKey - здесь я сохраняю клавиши в оперативную память, пробовал в файл сохранять - возникают проблемы из за загрузки ЦП.
Добавлено @ 14:45

Цитата(RAdmin @ 20.4.2005, 20:28)

Убери repeat until false;

Цитата(RAdmin @ 20.4.2005, 23:15)

Ты пробовал?

Дак прога тогда закрывается.

Цитата(RAdmin @ 20.4.2005, 23:48)

И всё работает пучком

Работать то работает, да вот память сильно грузит :\

Budy Ну не знаю, то что я проверял работало без напрягов.
Пришли мне на мыло весь исходник, или тут выложи (только в аттаче).
exxxxx [a] gmail.com

RAdmin, дак я весь и выложил. Есть прога (там всего 5 строчек), которая запускает DLL и держит его в памяти. DLL в свою очередь ставит ловушку, и проверяет на нажатие клавиш на клавиатуре. Три процедуры, что я не расписывал не представляют из себя ничего серьезного - у все сводил к минимуму, просто получал Key_Name (GetKeyNameText(lParam, Key_Name, sizeof(Key_Name));) и записывал в файл. Всеравно всю память использует.
Может ловушка "слишком много на себя берет"?

Цитата(Budy @ 21.4.2005, 17:43)

Цитата (RAdmin @ 20.4.2005, 20:28) Убери repeat until false; Цитата (RAdmin @ 20.4.2005, 23:15) Ты пробовал? Дак прога тогда закрывается.

Ага, в этом все и дело. Я переделал запускающую прогу чтоб без зацикливания была, все встало на место

Добавлено @ 20:57
А я себе в голову вбил, что ето все DLL'ька виновата

ну вот и замечательно

А как мона сделать чтоб DLL передавала какието параметры вызвающей программе?
Ну например в этом случае, DLL получила клавишу и нужно ее передать программе..

Вот есть хороший пример:



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

Цитата

repeat until false;

Это в Win-проге использовать просто нельзя!
Нужно:

Код

program Project1; uses   Windows, Messages; var Msg: TMsg; procedure Timer; stdcall; begin    MessageBox(0, 'Работаем!', 'Сообщение :)', MB_ICONINFORMATION); end; begin    SetTimer(0, 0, 3000, @Timer);    while GetMessage(Msg,0,0,0) do     begin        TranslateMessage(Msg);        DispatchMessage(Msg);     end; end.

PS. SetTimer и всё что с ним связано - чисто для показухи

vintch, ага, я уже понял Просто я между делом делал маленькую запускающую прогруамму

Цитата

А как мона сделать чтоб DLL передавала какието параметры вызвающей программе? Ну например в этом случае, DLL получила клавишу и нужно ее передать программе..

Зачем? и какие именно?

RAdmin, я мона полегче примерчик? Я шото там запутался


Dr.No_xXx, посмотри эту тему. Я кидал код, там процедуре "procedure AddKey(Key: String);" я передаю полученную нажатую клавишу. Дак вот спрашиваю, как эту "Key: String" - клавишу передать в главную прогу?

Цитата(Budy @ 25.4.2005, 16:36)

RAdmin, я мона полегче примерчик? Я шото там запутался

Ты работаешь под NT? Если так то не нужны никакие лишние DLL. Вот смотри примерчик:

Код

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.

Да, признаться, давно я на MSDN небыл

Rouse, ещё новичком себя называет

PS. А можно ещё так: не repeat until false; а repeat sleep(10) until false; И проц не на сотню

Это сообщение отредактировал(а) Girder - 26.4.2005, 13:54

Цитата(vintch @ 26.4.2005, 13:34)

А можно ещё так: не repeat until false; а repeat sleep(10) until false;  И проц не на сотню

Ну можно и application.HandleMessage или ее аналог написать. Самый ненапряжный вариант

Ну чтож, давайте теперь разберем ошибки.

dsergey:
Папка D6Hook1 файл hook.pas
смотрим код:

Код

function HookProc(Code: integer; WParam: word; LParam: Longint): Longint; stdcall;

Теперь вопрос. С каких пор WParam поменяло значение с двойного слова на одинарное? Правильней будет Longint(DWORD, Cardinal) но никак не word. Самое правильное - специально определенный тип для всех hook procedures объявленный в модуле Windows.pas под названием WPARAM;
Собстенно вот все используемые типы:

Код

type   WPARAM = Longint;   {$EXTERNALSYM WPARAM}   LPARAM = Longint;   {$EXTERNALSYM LPARAM}   LRESULT = Longint;   {$EXTERNALSYM LRESULT}

Исследуем далее код функции function HookProc того же модуля

Код

if Code >= 0 then begin     ...   end else     result := CallNextHookEx(HookHandle, code, WParam, LParam);

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

Ну и естестенно довольно странно видеть проверку при уничтожении хука:

Код

procedure TfmMain.FormDestroy(Sender: TObject); begin   if HookHandle > 0 then     UnhookWindowsHookEx(HookHandle); end;

...при ее полном отсутствии на момент создания:

Код

procedure TfmMain.FormCreate(Sender: TObject); begin ...   HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, @HookProc, HInstance, 0); ... end;

Папка D6Hook2DLL, модуль keyboardhook.dpr:
смотрим код:

Код

procedure DLLEntryPoint(dwReason: DWord); stdcall;

В данном случае из-за объявления stdcall, абсолютно здесь не уместного никогда в жизни не отработает сообщение DLL_PROCESS_DETACH

Далее абсолютно не понятен двойной вызов следующей функции на момент инициализации библиотеки.

Код

WM_MYKEYHOOK:=RegisterWindowMessage('WM_MYKEYHOOK');

Папка D6Hooks модуль HookDll.pas
Та же ошибка с word, ну и явно безграмотное написание библиотеки с разбитием цепочки хуков, так как автор видимо забывает что все экземпляры библиотеки разнесены по различным адресным пространствам приложений и не потрудился создать единые экземпляры констант чере отображаемые в память процесса файлы.
Предыдужий пример был написан намного лучше.

Примеры в архивах даже не хочется комментировать.


По поводу примера от RAdmin.
Ну это немного не из той серии, но очень грамотно написаный пример...

Мой пост собственно не указание на ошибки, а указание на возможные неприятности при бездумном использовании кода...

Это сообщение отредактировал(а) Rouse_ - 26.4.2005, 20:05

Цитата(Rouse_ @ 26.4.2005, 20:03)

Ну это немного не из той серии, но очень грамотно написаный пример...

Дык человек вопрос задал :

Цитата(Budy @ 25.4.2005, 06:25)

А как мона сделать чтоб DLL передавала какието параметры вызвающей программе? Ну например в этом случае, DLL получила клавишу и нужно ее передать программе..

Естесно потом возникнет вопрос а как текст передать. и тд.


А что касатется хука на клаву то мой пример уже давно пылится в кладовке.
(тотже принцип что и у тебя, толкьо с перламутровыми пуговицами )

Это сообщение отредактировал(а) RAdmin - 26.4.2005, 20:56

RAdmin, Rouse_, пасибо, ребята! Оба помогли, у обоих код позаимствовал Еще раз спасибо

Уменьшь её на сколько можно и пусть результат не в прогу пишется, а в LOG файл, не указывая время(Только беквы и цифры). Ещё можно эту штуку коммандной строкой сделать!!! Также можно сделать так, чтобы не все буквы запоминались, а некоторые.

Это сообщение отредактировал(а) Girder - 27.4.2005, 23:57