Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Вниз

Ошибка в Hook ?   Найти похожие ветки 

 
Nikon   (2005-07-13 22:06) [0]

Здравствуйте, у меня следующий вопрос: в результате выполнения нижепредставленного кода при попытке нажать любую кнопку в любом приложении, за исключением приложения, которое этот хук собственно устанавливает, приложение закрывается, и появляется ошибка "Неправильный дескриптор окна". Подскажите пожалуйста где у меня ошибка и как её можно исправить?

unit Unit2;

interface
uses Windows, SysUtils;
const KF_UP_MY = $40000000;
var CurrentHook: HHook;
   hstr: string;
   CurFile:text;
   Layout: array[0.. KL_NAMELENGTH] of char;
function GlobalKeyBoardHook(code: integer; wParam: integer; lParam:
integer): longword; stdcall;
procedure SetupGlobalKeyBoardHook;
procedure unhook;
implementation
function GlobalKeyBoardHook(code: integer; wParam: integer; lParam:integer): longword; stdcall;
var
i:integer;
begin
 if code< 0 then
  begin
    result:=CallNextHookEx(CurrentHook,code,wParam,lparam);
    Exit;
  end;
 if ( (lParam and KF_UP_MY ) = 0) and (wParam>=65) and (wParam<=90) then
   begin
     hstr:=hstr+char(wparam);
     if length(hstr)=3 then
       begin
         if (uppercase(hstr)="WWW")and(GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil))=68748313) then
           begin
             LoadKeyboardLayout(StrCopy(Layout,"00000409"),KLF_ACTIVATE);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
           end;
           hstr:=copy(hstr,2,2);
       end;
      end;
   CallNextHookEx(CurrentHook,code,wParam,lparam);
   result:=0;
end;
procedure SetupGlobalKeyBoardHook;
begin
 hstr:="";
 CurrentHook:=SetWindowsHookEx(WH_KEYBOARD, @GlobalKeyBoardHook,HInstance, 0);
end;
procedure unhook;
begin
 UnhookWindowshookEx(CurrentHook);
end;
end.


 
Eraser ©   (2005-07-14 00:58) [1]

Во-первых переменная var CurrentHook: HHook; не допустима в данном случае, т.к. она будет разной для каждого приложения. Советую использовать трюк с "расшареной" памятью (MMF) в нете полно примеров.


 
Nikon   (2005-07-14 01:08) [2]

т.е. как я понимаю ошибка возникает именно при попытке что- то сделать, т.е. при этом
            LoadKeyboardLayout(StrCopy(Layout,"00000409"),KLF_ACTIVATE);
              keybd_event(vk_Back, 0, 0, 0);
              keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
              keybd_event(vk_Back, 0, 0, 0);
              keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
              keybd_event(vk_Back, 0, 0, 0);
              keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);

так?


 
Eraser ©   (2005-07-14 01:18) [3]

Nikon   (14.07.05 01:08) [2]

Нет, при CallNextHookEx(CurrentHook,code,wParam,lparam);, где
CurrentHook скорее всего равно 0 или не определено.


 
Nikon   (2005-07-14 01:30) [4]

да, но если я просто записываю перехваченные клавиши в файл, то все работает...

uses Windows, SysUtils;
const KF_UP_MY = $40000000;
var CurrentHook: HHook;
   KeyArray: array[0..19] of char;
   KeyArrayPtr: integer;
   CurFile:text;
function GlobalKeyBoardHook(code: integer; wParam: integer; lParam:
integer): longword; stdcall;
var
i:integer;
begin
 if code< 0 then
  begin
    result:=CallNextHookEx(CurrentHook,code,wParam,lparam);
    Exit;
  end;
 if ( (lParam and KF_UP_MY ) = 0) and (wParam> =65) and (wParam< =90) then
   begin
     KeyArray[KeyArrayPtr]:=char(wParam);
     KeyArrayPtr:=KeyArrayPtr+1;
     if KeyArrayPtr> 19 then
      begin
       for i:=0 to 19 do
       begin
         Assignfile(CurFile,"d:\log.txt");
         if fileexists("d:\log.txt")=false then rewrite(CurFile)
         else Append(CurFile);
         write(Curfile, KeyArray[i]);
         closefile(curfile);
       end;
       KeyArrayPtr:=0;
      end;
   end;
   CallNextHookEx(CurrentHook,code,wParam,lparam);
   result:=0;
end;
procedure SetupGlobalKeyBoardHook;
begin
 CurrentHook:=SetWindowsHookEx(WH_KEYBOARD, @GlobalKeyBoardHook,HInstance, 0);
 KeyArrayptr:=0;
end;
procedure unhook;
begin
 UnhookWindowshookEx(CurrentHook);
end;

exports
SetupGlobalKeyBoardHook, UnHook;
begin
end.


 
Nikon   (2005-07-16 08:58) [5]

Все- таки осталось несколько неясным, почему во втором случае (код приведен выше) все работает верно, а в первом случае уничтожается процесс, в котором этот hook срабатывает...


 
Nikon   (2005-07-19 09:51) [6]

Проверил еще раз, код, просто записывающий клавиши в файл, работает корректно, но в случае попытки добавить любое действие сразу же возникает ошибка, описанная в вопросе...


 
alpet ©   (2005-07-19 10:08) [7]

Nikon   (19.07.05 09:51) [6]
Попробуй сделать, что бы код записывал вместо клавиш значение CurrentHook, и убедись что оно неверное. Тебе уже сказали что нужно сделать - размести эту переменную в общей памяти.


 
Nikon   (2005-07-19 14:09) [8]

Здравствуйте еще раз, ошибку я исправил, переписав полностью хук:
library keyhook;

uses
 SysUtils,
 Windows,
 Messages,
 Forms,
 dialogs;
const
 MMFName: PChar = "KeyMMF";
 const KF_UP_MY = $40000000;
type
 PGlobalDLLData = ^TGlobalDLLData;
 TGlobalDLLData = packed record
   SysHook: HWND;
   MyAppWnd: HWND;
 end;

var
 GlobalData: PGlobalDLLData;
 MMFHandle: THandle;
 WM_MYKEYHOOK: Cardinal;

function KeyboardProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var
   AppWnd: HWND;
begin

 if code < 0 then
 begin
   Result:= CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
   Exit;
 end;

 if (  ((lParam and KF_UP_MY)=0) and (wParam>=65) and (wParam<=90)  ) OR (  ((lParam and KF_UP_MY)=0) and (wParam=VK_SPACE)  ) then
  begin
    AppWnd:= GetForegroundWindow();
    SendMessage(GlobalData^.MyAppWnd, WM_MYKEYHOOK, wParam, AppWnd);
  end;

 CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
 Result:= 0;

end;

procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
 if switch=true then
 begin
   GlobalData^.SysHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
   GlobalData^.MyAppWnd:= hMainProg;
 end
 else
    UnhookWindowsHookEx(GlobalData^.SysHook);
end;

procedure OpenGlobalData();
begin
 WM_MYKEYHOOK:= RegisterWindowMessage("WM_MYKEYHOOK");
 MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);
 GlobalData:= MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalDLLData));
 if GlobalData = nil then
   begin
     CloseHandle(MMFHandle);
     Exit;
   end;
end;

procedure CloseGlobalData();
begin
 UnmapViewOfFile(GlobalData);
 CloseHandle(MMFHandle);
end;

procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
 case dwReason of
   DLL_PROCESS_ATTACH: OpenGlobalData;
   DLL_PROCESS_DETACH: CloseGlobalData;
 end;
end;

exports hook;

begin
 DLLProc:= @DLLEntryPoint;
 DLLEntryPoint(DLL_PROCESS_ATTACH);
end.


Теперь вопрос в следующем: отлавливается все корректно, мне необходимо в случае нажатия "ццц" перевести раскладку на англ, удалить набраное, набрать www, делается все корректно, кроме последнего, привожу код, может кто- нибудть сможет подсказать в чем ошибка?

procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited ;
if Msg.Msg = WM_MYKEYHOOK then
   begin
   hstr:=hstr+char(msg.WParam);
     if length(hstr)=3 then
       begin
         if (uppercase(hstr)="WWW")and(GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil))=68748313) then
           begin
              LoadKeyboardLayout(StrCopy(Layout,"00000409"),KLF_ACTIVATE);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               sendmessage(msg.LParam,wm_char,word("w"),0);
               sendmessage(msg.LParam,wm_char,word("w"),0);
               sendmessage(msg.LParam,wm_char,word("w"),0);
           end;
           hstr:="";
       end;
   end;
end;


 
Lamer@fools.ua ©   (2005-07-19 15:30) [9]

>>Nikon   (19.07.05 14:09) [8]

С выделенным жирным не согласен:

1.
function KeyboardProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;

2.
procedure DLLEntryPoint(dwReason: DWord); stdcall;


 
Nikon   (2005-07-21 08:44) [10]

1.
function KeyboardProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;

2.
procedure DLLEntryPoint(dwReason: DWord); stdcall;

Вы считаете это причиной??...


 
Nikon   (2005-07-21 10:07) [11]

и еще одно.. почему не работает
LoadKeyboardLayout(StrCopy(Layout,"00000409"),KLF_ACTIVATE);
срабатывает все, за исключением
             sendmessage(msg.LParam,wm_char,word("w"),0);
              sendmessage(msg.LParam,wm_char,word("w"),0);
              sendmessage(msg.LParam,wm_char,word("w"),0);

и переключения раскладки.


 
Lamer@fools.ua ©   (2005-07-21 10:49) [12]

>>Nikon   (21.07.05 08:44) [10]

>Вы считаете это причиной??...

Причиной чего? Я указал, что написано неправильно и сразу бросается в глаза.


 
Nikon   (2005-08-18 16:57) [13]

Привожу исправленый код:
library keyhook;

uses
 SysUtils,
 Windows,
 Messages,
 Forms,
 dialogs;
const
 MMFName: PChar = "KeyMMF";
 const KF_UP_MY = $40000000;
type
 PGlobalDLLData = ^TGlobalDLLData;
 TGlobalDLLData = packed record
   SysHook: HWND;
   MyAppWnd: HWND;
 end;

var
 GlobalData: PGlobalDLLData;
 MMFHandle: THandle;
 WM_MYKEYHOOK: Cardinal;

function KeyboardProc(code : integer; wParam, lParam : longint) : longint; stdcall;
var
   AppWnd: HWND;
begin

 if code < 0 then
 begin
   Result:= CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
   Exit;
 end;

 if (  ((lParam and KF_UP_MY)=0) and (wParam>=65) and (wParam<=90)  ) OR (  ((lParam and KF_UP_MY)=0) and (wParam=VK_SPACE)  ) then
  begin
    AppWnd:= GetForegroundWindow();
    SendMessage(GlobalData^.MyAppWnd, WM_MYKEYHOOK, wParam, AppWnd);
  end;

 CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
 Result:= 0;

end;

procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
 if switch=true then
 begin
   GlobalData^.SysHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
   GlobalData^.MyAppWnd:= hMainProg;
 end
 else
    UnhookWindowsHookEx(GlobalData^.SysHook);
end;

procedure OpenGlobalData();
begin
 WM_MYKEYHOOK:= RegisterWindowMessage("WM_MYKEYHOOK");
 MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);
 GlobalData:= MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalDLLData));
 if GlobalData = nil then
   begin
     CloseHandle(MMFHandle);
     Exit;
   end;
end;

procedure CloseGlobalData();
begin
 UnmapViewOfFile(GlobalData);
 CloseHandle(MMFHandle);
end;

procedure DLLEntryPoint(dwReason: DWord);
begin
 case dwReason of
   DLL_PROCESS_ATTACH: OpenGlobalData;
   DLL_PROCESS_DETACH: CloseGlobalData;
 end;
end;

exports hook;

begin
 DLLProc:= @DLLEntryPoint;
 DLLEntryPoint(DLL_PROCESS_ATTACH);
end.


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   procedure WndProc(var Msg: TMessage); override;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 hDLL: THandle;
 WndFlag: HWND;
 WM_MYKEYHOOK:cardinal;
 Layout: array[0.. KL_NAMELENGTH] of char;
 hstr:string;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
SendMessage(Form1.Handle, WM_MYKEYHOOK, VK_SPACE, Application.MainForm.Handle);
@hook:= nil;
hstr:="";
hDLL:= LoadLibrary(PChar("keyhook.dll"));
if hDLL > HINSTANCE_ERROR then
 begin
   @hook:=GetProcAddress(Hdll, "hook");
   hook(true, Form1.Handle);
 end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
 Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
 @hook:= nil;
 if hDLL > HINSTANCE_ERROR then
   begin
     @hook:=GetProcAddress(Hdll, "hook");
     hook(false, Form1.Handle);
     FreeLibrary(hDLL);
   end;
end;
procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited ;
if Msg.Msg = WM_MYKEYHOOK then
   begin
   hstr:=hstr+char(msg.WParam);
     if length(hstr)=3 then
       begin
         if (uppercase(hstr)="WWW")and(GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil))=68748313) then
           begin
              button2.Click;
              LoadKeyboardLayout(StrCopy(Layout,"00000409"),KLF_ACTIVATE);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               keybd_event(vk_Back, 0, 0, 0);
               keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
               sendmessage(msg.LParam,wm_char,word("w"),0);
               sendmessage(msg.LParam,wm_char,word("w"),0);
               sendmessage(msg.LParam,wm_char,word("w"),0);
              button1.Click;
           end;
           hstr:="";
       end;
   end;
end;
initialization
WM_MYKEYHOOK:= RegisterWindowMessage("WM_MYKEYHOOK");
end.


Вопрос остался, к сожалению, в том же :
Событие на нажати "ццц" срабатывает, набраные символы удаляются, однако раскладка клавиатуры не переключается и соответственно не "набирается" "www".. очень надеюсь на вашу помощь!


 
Квэнди ©   (2005-08-18 19:06) [14]

(  ((lParam and KF_UP_MY)=0) and (wParam=VK_SPACE)  )

Это кчему ?..
keybd_event(vk_Back, 0, 0, 0);
           keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
              keybd_event(vk_Back, 0, 0, 0);
              keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);
              keybd_event(vk_Back, 0, 0, 0);
              keybd_event(vk_Back, 0, KEYEVENTF_KEYUP, 0);


а Sendmessage уже не катит?


 
Nikon   (2005-08-23 07:44) [15]

неужели уже никто не сможет помочь ?


 
alpet ©   (2005-08-23 09:27) [16]

Отправляй окну в который вводишь текст, сообщение WM_INPUTLANGUAGECHANGEREQUEST, с выбранной локалью в параметре.


 
Nikon   (2005-08-24 09:53) [17]

Спасибо! теперь:
символы удаляются, раскладка переключается, но новые символы не набираются, при попытке просто напрямую таким кодом набрать текст, все работает... подскажите пожалуйста...


 
Nikon   (2005-08-24 10:22) [18]

Удалено модератором
Примечание: Дубль


 
Nikon   (2005-08-26 08:19) [19]

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


 
alpet ©   (2005-08-26 08:32) [20]

http://www.alpet.hotmail.ru/wgcsrc.zip

В архиве найди файлик chcode.pas - в нем достаточно надежный симулятор нажатия клавиш (для ввода чит-кодов в игры).


 
Nikon   (2005-08-26 08:39) [21]

Благодарю!



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.53 MB
Время: 0.05 c
14-1128436634
oldman
2005-10-04 18:37
2005.10.30
Чисто информационная ветка. Может даже опрос...


14-1128789968
syte_ser78
2005-10-08 20:46
2005.10.30
Програмирование в Delphi 7 Архангельский


6-1120660294
Gold
2005-07-06 18:31
2005.10.30
IdPOP31.Retrieve - утечка памяти!! ??


14-1128423454
Андрей Жук
2005-10-04 14:57
2005.10.30
Турнир шахматистов


14-1128589213
Loginov Dmitry
2005-10-06 13:00
2005.10.30
Имеющиеся в интернете ресурсы по Delphi





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский