Просмотр полной версии : delphi 6/7 помогите вырубить клаву
Paranoik
18.11.2009, 19:56
Ребят, помогите с кодом, для отключенеи всей клавы при старте проги.. а то в сети нашел несколько способов, но что-то не рабят..
AquaKlaster
18.11.2009, 20:48
Модуль предназначен для осуществления частичной
блокировки/разблокировки функций клавиатуры и мышки.
Procedure KeyBoardOn - разблокировка (включение) клавиатуры
Procedure KeyBoardOff - блокировка (выключение) клавиатуры
Procedure MouseOn - разблокировка (включение) мышки
Procedure MouseOff - блокировка (выключение) мышки
unit mklu;
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.
Пример использования:
uses mklu;
{блокировка(LockIt = true) или разблокировка(LockIt= False) клавы}
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;
end;
transserg
18.11.2009, 21:54
можеш использовать BlockInput из USER32.dll но опят таки частичная блокировка =)
Paranoik
20.11.2009, 15:15
Модуль предназначен для осуществления частичной
блокировки/разблокировки функций клавиатуры и мышки.
Procedure KeyBoardOn - разблокировка (включение) клавиатуры
Procedure KeyBoardOff - блокировка (выключение) клавиатуры
Procedure MouseOn - разблокировка (включение) мышки
Procedure MouseOff - блокировка (выключение) мышки
unit mklu;
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.
Пример использования:
uses mklu;
{блокировка(LockIt = true) или разблокировка(LockIt= False) клавы}
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;
end;
НЕ рабит она !!! точнее у мя например клава как жила после этого так и живет дальше норм...
Paranoik
20.11.2009, 15:15
можеш использовать BlockInput из USER32.dll но опят таки частичная блокировка =)
пробовал.. ну просто чет у мя там блочица все сразу..и клава и мышь.. а над тока клаву.. (((
DeaD_MoroZ
20.11.2009, 19:24
library DisableKB;
uses
Forms,
Windows,
Messages,
HookCommon in 'HookCommon.pas';
{$J+}
const
Hook: HHook = 0;
WH_KEYBOARD_LL = 13;
{$J-}
{$R *.res}
function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
begin
Result := -1;
end;
procedure DisableKB; stdcall;
begin
if Hook = 0 then Hook:=SetWindowsHookEx(WH_KEYBOARD_LL,@HookProc,HI nstance,0);
end;
procedure EnableKB; stdcall;
begin
UnhookWindowsHookEx(Hook);
Hook:=0;
end;
exports
DisableKB, EnableKB;
begin
end.
unit HookCommon;
interface
uses Windows;
procedure DisableKB; stdcall;
procedure EnableKB; stdcall;
implementation
procedure DisableKB; stdcall; external 'disablekb.DLL';
procedure EnableKB; stdcall; stdcall; external 'disablekb.DLL';
initialization
end.
DeaD_MoroZ
20.11.2009, 19:49
Если клава посажена на разъем PS/2, то можно включать и отключать клавиатуру по мере необходимости (посылка 0ADh в порт 64h отключает клаву, 0AEh включает).
Yokohama
20.11.2009, 23:46
DeaD_Moroz , если отключать разьём PS/2 то disablekb.DLL не нужен?
DeaD_MoroZ
21.11.2009, 06:12
DeaD_Moroz , если отключать разьём PS/2 то disablekb.DLL не нужен?
если посылать 0ADh в порт 64h-то конечно нет(= я написал два примера(= первый-создаёшь библиотеку и пользуешься ей, а второй посылать 0ADh в порт 64h.
2 DeaD_MoroZ Нуну, погляжу я на тебя как ты в юзермоде под XP будеш посылать данные в порт. А Таскать драйвер ради этого - глупо.
DeaD_MoroZ
21.11.2009, 15:32
2 DeaD_MoroZ Нуну, погляжу я на тебя как ты в юзермоде под XP будеш посылать данные в порт. А Таскать драйвер ради этого - глупо.
ну как я их буду посылать... матом скорей всего :)
DeaD_MoroZ
04.12.2009, 14:00
или вот ещё-про самое простое о забыл(=
procedure BlockInput; external 'user32.dll';
procedure Block;
asm
push 1
call BlockInput
end;
procedure UnBlock;
asm
push 0
call BlockInput
end;
vBulletin® v3.8.14, Copyright ©2000-2026, vBulletin Solutions, Inc. Перевод: zCarot