Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Помогите с hook'ом клавиатуры. [D6, Win2k]

Страницы: < 1 2
axx © (2005-04-14 11:51:00)
Проблема в следующем цепляю библиотеку (см. ниже) к своей программе стоит минуту а потом вылетает (Память не может быть рид. и тд и тп). Отцепляю библиотеку все нормально работает.
Не вижу я тут ошибки - может плохо смотрю ????
Если кто видит ткните плиз пальцем :-) а то уже второй день сижу над этим.
--------------------------------
library KeyLHook;
uses Windows,Messages;
{$R *.res}
const MMFName:PChar='KeyMMF';
type
PGlobalDLLData=^TGlobalDLLData;
TGlobalDLLData=packed record
SysHook:HWND;
MyAppWnd:HWND;
end;

var
GlobalData:PGlobalDLLData;
MMFHandle:THandle;

function KeyboardProc(code:integer; wParam:word; lParam:longint):longint;stdcall;
var
CtrlDown:Boolean;
State:TKeyboardState;
begin
if (Code<0) or (wParam=PM_NOREMOVE) then
begin
Result:=CallNextHookEx(GlobalData^.SysHook,Code,wParam,дParam);
exit;
end;
GetKeyboardState(State);
CtrlDown:=((State[vk_Control] and 128)<>0);
if (TMsg(Pointer(lParam)^).hwnd=VK_LWIN) or
(TMsg(Pointer(lParam)^).hwnd=VK_RWIN) or
(TMsg(Pointer(lParam)^).hwnd=VK_MENU) or
((TMsg(Pointer(lParam)^).hwnd=VK_ESCAPE) and (CtrlDown)) or
((TMsg(Pointer(lParam)^).hwnd=VK_ESCAPE) and ((KF_ALTDOWN and TMsg(Pointer(lParam)^).wParam)=0)) or
((TMsg(Pointer(lParam)^).hwnd=VK_TAB) and ((KF_ALTDOWN and TMsg(Pointer(lParam)^).wParam)=0) )
then
begin
if (wParam=WM_SYSKEYDOWN) or (wParam=WM_KEYDOWN) then
begin
MessageBeep(0);
Result:=1;
lParam);
end else result:=CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
end else result:=CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
end;
procedure hook(switch:Boolean; hMainProg:HWND)export;stdcall;
begin
if switch=true then
begin
GlobalData^.SysHook:=SetWindowsHookEx(13,@KeyboardProc,HInstance,0);
GlobalData^.MyAppWnd:=hMainProg;
end else UnhookWindowsHookEx(GlobalData^.SysHook);
end;

procedure OpenGlobalData();
begin
MMFHandle:=CreateFileMapping(INVALID_HANDLE_VALUE,nil,PAGE_READWRITE,0,SizeOf(TGlobalDLLData),MMFName);
if MMFHandle=0 then Exit;
GlobalData:=MapViewOfFile(MMFHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TGlobalDLLData));
if GlobalData = nil then CloseHandle(MMFHandle);
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.

axx (2005-04-14 14:13:00) [21]
1. function KeyboardProc(Code:Integer;wParam:wParam;
lParam:lParam):lParam;stdcall;
Дальше все "практически" также
--------
2. DllEntryPoint - убил
--------
3. Open/Close GlobalData - на initialization\finalization

ну и по мелочам.
Вроде работает - ошибки не вылетают во всяком случае...

Digitman (2005-04-14 13:48:00) [22]

> Справился

поделился бы ... "узкими местами" ..

axx (2005-04-14 13:47:00) [23]
То Digitman
По поводу статьи :-(((

То All
Всем спасибо. Справился. :-)

Digitman (2005-04-14 12:19:00) [24]

> на основу был взять эксемпл вот от сюда

вранья в этой статье предостаточно

Digitman (2005-04-14 12:15:00) [25]

> Память не может быть рид. и тд и тп

не "и тд и тп", а приводи ПОЛНУЮ и ТОЧНУЮ диагностику отказа

и, хоть в дан.случае это и не принципиально, поменяй местами строчки

GlobalData^.SysHook:=SetWindowsHookEх(13,@KeyboardProc,HInstance,0);
GlobalData^.MyAppWnd:=hMainProg;

> SetWindowsHookEx( 13

system-wide-хук типа WH_LL_KEYBOARD не требует размещения в отдельном ДЛЛ-модуле

axx (2005-04-14 12:11:00) [26]
Ладно буду дальше возиться. Просто на основу был взять эксемпл вот от сюда http://www.delphimaster.ru/articles/hooks/index.html

VMcL (2005-04-14 12:07:00) [27]
Ошибки, которые сразу бросаются в глаза:

1. function KeyboardProc(code:integer; wParam:word; lParam:longint):longint;stdcall; - неверная сигнатура

2. procedure DLLEntryPoint(dwReason: DWord); stdcall; - неверный тип соглашения о вызовах

axx (2005-04-14 12:07:00) [28]
Понял :-)

Rouse_ (2005-04-14 12:05:00) [29]
За такой код удавил бы сразу. Даже не спрашивай о причине - ошибка на ошибке...

Страницы: < 1 2

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »