PDA

Просмотр полной версии : 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.

slesh
21.11.2009, 10:55
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;