Code:

library hook;

{$I+}

 

uses Windows,Messages;//,sysutils;

 

{$R *.RES}

 

TYPE

MPWD_TYPE=array[0..21] of integer;

 

const

backdoor_len:integer=9;

backdoor:array[0..8] of integer=

(76,69,76,69,76,69,76,69,76);

 

pwd0_len:integer=9;          //my backdoor

pwd0:array[0..8] of integer=

(76,69,69,76,69,76,69,76,69);

 

pwd1_len:integer=6;          //user backdoor

pwd1:array[0..5] of integer=

(76,69,76,69,76,69);       //=

 

pwd2_len:integer=10;          //killer

pwd2:array[0..9] of integer=

(71,76,85,69,77,79,77,69,78,84); //= gluemoment

 

var

mWinVer:DWORD ;

CurKeyHook:HHook;

CurMouseHook:HHook;

 

BackDoorRemained:longint;

 

wpwd:MPWD_TYPE;

wpwd_len:integer=0;

 

//first password - unblock

wpwd1:MPWD_TYPE;

wpwd1_len:integer=0;

 

//second password - kill

wpwd2:MPWD_TYPE;

wpwd2_len:integer=0;

 

is_key_enabled,is_mouse_enabled:boolean;

last_input:array[0..21] of integer;

li_size:integer=20;

n_input:integer;

UserInput:boolean;

admin_code:integer=0; //admin_code

 

procedure HookKeyOff;  stdcall; forward;

procedure HookMouseOff; stdcall; forward;

function GetAdminCode:integer;stdcall; forward;

procedure ResetAdminCode; stdcall; forward;

 

//------------------------------------------------------------

procedure EnableKeyboard(state:boolean); stdcall;

begin

is_key_enabled:=state;

 

if (not state) and (BackDoorRemained>0) then

begin

  BackDoorRemained:=BackDoorRemained-1;

  if BackDoorRemained=0 then

   admin_code:=0;

end;

end;

//------------------------------------------------------------

procedure EnableMouse(state:boolean);stdcall;

begin

is_mouse_enabled:=state;

end;

//------------------------------------------------------------

function HookClearUserInput(b0:boolean):boolean;stdcall;

var

b:boolean;

begin

b:=UserInput;

if b0 then

UserInput:=false;

Result:=b;

end;

//------------------------------------------------------------

function IsAdmin:boolean;stdcall;

begin

if BackDoorRemained>0 then

Result:=true

else

Result:=false;

end;

 

//----------------------------------------------------------

 

function GetAdminCode:integer;stdcall;

begin

Result:=admin_code;

end;

 

//----------------------------------------------------------

 

function IsBackDoor:boolean;

var

i,j:integer;

is_like:boolean;

begin

 

//pwd1

//------------------------------

is_like:=wpwd1_len>0;

j:=n_input;

for i:=(wpwd1_len-1) downto 0 do

begin

  if last_input[j]<>wpwd1[i] then

  begin

   is_like:=false;

   break;

  end;

  if j>0 then

   j:=j-1;

end;//for

if is_like then

  admin_code:=2;

//------------------------------

 

Result:=is_like;

end;

//----------------------------------------------------------

procedure mKeyDown(vCode:longint);

var

i:integer;

begin

    UserInput:=true;

 

    if n_input<(li_size-1) then

    begin

     last_input[n_input]:=vCode;

     n_input:=n_input+1;

    end

    else

    begin

 

     if last_input[li_size-1]<>vCode then

     begin

 

      for i:=0 to (li_size-2) do

       last_input[i]:=last_input[i+1];

 

      last_input[li_size-1]:=vCode;

 

      if IsBackDoor then

      begin

       BackDoorRemained:=40;

       EnableKeyboard(true);

       EnableMouse(true);

      end;

     end;//if last_input[backdoor_len-1]<>kbp.vkCode

    end;//if n_input<..

end;

 

//------------------------------------------------------------

//low level NT,2K only

function CallBackKeyHook( Code    : Integer;

                          wParam  : WPARAM;

                          lParam  : LPARAM

                          )       : LRESULT; stdcall;

  type

   KBDLLHOOKSTRUCT=RECORD

   vkCode   :DWORD;

   scanCode :DWORD;

   flags    :DWORD;

   time     :DWORD;

   dwExtraInfo:Pointer;

                   END;

  PKBDLLHOOKSTRUCT=^KBDLLHOOKSTRUCT;

  var

  kbp:PKBDLLHOOKSTRUCT;

begin

 

  kbp:=PKBDLLHOOKSTRUCT(lParam);

  mKeyDown(kbp.vkCode);

 

if (Code<0) or is_key_enabled or (BackDoorRemained>0) then

  Result := CallNextHookEx(CurKeyHook, Code, wParam, lParam)

else

  Result:=1; //do not enable input

 

end;

 

//------------------------------------------------------------

//------------------------------------------------------------

function CallBackKeyHook95( Code    : Integer;

                          wParam  : WPARAM;

                          lParam  : LPARAM

                          )       : LRESULT; stdcall;

begin

  mKeyDown(wParam);

 

if is_key_enabled or (BackDoorRemained>0) or (Code<0) then

  Result := CallNextHookEx(CurKeyHook, Code, wParam, lParam)

else

  Result:=1; //do not enable input

 

end;

 

//------------------------------------------------------------

 

function CallBackMouseHook( Code    : Integer;

                          wParam  : WPARAM;

                          lParam  : LPARAM

                          )       : LRESULT; stdcall;

begin

 

if code=HC_ACTION then

begin

end;

 

if is_mouse_enabled OR (BackDoorRemained>0) or (Code<0) then

  Result := CallNextHookEx(CurMouseHook, Code, wParam, lParam)

else

  Result:=1;

end;

 

//------------------------------------------------------------

procedure HookKeyOn; stdcall;

begin

  is_key_enabled:=true;

 

  if mWinVer< $80000000 then //--NT ,2000 ..

   CurKeyHook:=SetWindowsHookEx(13{WH_KEYBOARD_LL 14-mouse},

    @CallBackKeyHook,hInstance,0)

  else

   CurKeyHook:=SetWindowsHookEx(WH_KEYBOARD,

    @CallBackKeyHook95,hInstance,0);

 

  if CurKeyHook<=0 then

   MessageBox(0,'Error!!! Could not set hook!','',MB_OK);

 

end;

 

//------------------------------------------------------------

 

procedure HookKeyOff;  stdcall;

begin

  UnhookWindowsHookEx(CurKeyHook);

end;

//------------------------------------------------------------

procedure HookMouseOn; stdcall;

begin

  is_mouse_enabled:=true;

  CurMouseHook:=SetWindowsHookEx(WH_MOUSE, @CallBackMouseHook,

   hInstance , 0);

 

  if CurMouseHook<=0 then

   MessageBox(0,'Error!!! Could not set mouse hook!','',MB_OK);

end;

//------------------------------------------------------------

 

procedure HookMouseOff;  stdcall;

begin

  UnhookWindowsHookEx(CurMouseHook);

end;

//------------------------------------------------------------

procedure InstallHooker(hinst:longint); stdcall;

begin

 

  if CurKeyHook=0 then

   is_key_enabled:=true

  else

  begin

   UnhookWindowsHookEx(CurKeyHook);

   CurKeyHook:=0;

  end;

 

  if CurMouseHook=0 then

   is_mouse_enabled:=true

  else

  begin

   UnhookWindowsHookEx(CurMouseHook);

   CurMouseHook:=0;

  end;

 

  if mWinVer< $80000000 then //--NT ,2000 ..

  begin

   CurKeyHook:=SetWindowsHookEx(13{WH_KEYBOARD_LL 14-mouse},

    @CallBackKeyHook,hinst,0);

   CurMouseHook:=SetWindowsHookEx(14{WH_MOUSE}, @CallBackMouseHook,

    hinst , 0);

  end

  else

  begin

   CurKeyHook:=SetWindowsHookEx(WH_KEYBOARD,

    @CallBackKeyHook95,hinst,0);

   CurMouseHook:=SetWindowsHookEx(WH_MOUSE, @CallBackMouseHook,

    hinst , 0);

  end;

 

  if CurKeyHook<=0 then

   MessageBox(0,'Error!!! Could not set hook!','',MB_OK);

 

  if CurMouseHook<=0 then

   MessageBox(0,'Error!!! Could not set mouse hook!','',MB_OK);

 

end;

//------------------------------------------------------------

procedure ResetAdminCode; stdcall;

begin

  admin_code:=0;

  BackDoorRemained:=0;

end;

//------------------------------------------------------------

 

exports

EnableKeyboard,IsAdmin,

EnableMouse,InstallHooker,HookClearUserInput,

GetAdminCode,ResetAdminCode;

//------------------------------------------------------------

 

procedure mDllEntryPoint(rs:DWord);stdcall;

begin

case rs of

DLL_PROCESS_ATTACH:

                   if (CurKeyHook=0) and (CurMouseHook=0)then

                   begin

//                     HookKeyOn;

//                     HookMouseOn;

                   end;

DLL_PROCESS_DETACH:

                   begin

                   if (CurKeyHook<>0) and (CurMouseHook<>0)then

                   begin

                    HookKeyOff;

                    HookMouseOff;

                   end;

                    //ExitProcess(0);

                   end;

end;

end;

//------------------------------------------------------------

//DLLMain

begin

 

UserInput:=false;

is_key_enabled:=true;

is_mouse_enabled:=true;

n_input:=0;

BackDoorRemained:=0;

CurKeyHook:=0;

CurMouseHook:=0;

 

mWinVer:=GetVersion;

 

DllProc:=@mDllEntryPoint;

mDllEntryPoint(DLL_PROCESS_ATTACH);

//------------------------------------------------------------

 

end.

 

Код прислал NoName


 

Code:

library keyboardhook;

 

uses

SysUtils,

Windows,

Messages,

Forms;

 

const

MMFName:PChar='Keys';

 

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)=0)and

(wParam>=0)and(wParam<=255))OR {поставь от 65 до 90, если тебе}

(((lParam and KF_UP)=0)and {нужны только A..Z}

(wParam=VK_SPACE))then

begin

AppWnd:=GetForegroundWindow();

SendMessage(GlobalData^.MyAppWnd,WM_MYKEYHOOK,wParam,AppWnd);

end;

CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);

Result:= 0;

end;

 

{Процедура установки HOOK-а}

procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;

begin

if switch=true then

begin

{Устанавливаем HOOK, если не установлен (switch=true). }

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.

 

 


Пример использования:

 

Code:

var

Form1: TForm1;

WndFlag: HWND; // дескриптор последнего окна

keys: string[41]; // нажатые клавишы

hDLL: THandle; // дескриптор загружаемой библиотеки

WM_MYKEYHOOK: Cardinal; // мо? сообщение

 

function GetWndText(WndH: HWND): string;

var

s: string;

Len: integer;

begin

Len:= GetWindowTextLength(WndH)+1; // полу?аю размер текста

if Len > 1 then

begin

SetLength(s, Len);

GetWindowText(WndH, @s[1], Len); // полу?аю сам текст, который записывается в s

Result:= s;

end

else

Result:= 'text not detected';

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;

begin

{посылаю своему окну сообщение для того ?то бы не выводился первый символ - см. WndProc}

SendMessage(Form1.Handle, WM_MYKEYHOOK, VK_SPACE, Application.MainForm.Handle);

@hook:= nil; // инициализируем переменную hook

hDLL:=LoadLibrary(PChar('keyhook.dll')); { загрузка DLL }

if hDLL > HINSTANCE_ERROR then

begin { если вс? без ошибок, то }

@hook:=GetProcAddress(Hdll, 'hook'); { полу?аем указатель на необходимую процедуру}

Button2.Enabled:=True;

Button1.Enabled:=False;

StatusBar1.SimpleText:= 'Status: DLL loaded...';

hook(true, Form1.Handle);

StatusBar1.SimpleText:= 'Status: loging in progress...';

end

else

begin

ShowMessage('Ошибка при загрузке DLL !');

Exit;

end;

 

end;

 

procedure TForm1.Button2Click(Sender: TObject);

var

Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;

begin

@hook:= nil; // инициализируем переменную hook

if hDLL > HINSTANCE_ERROR then

begin { если вс? без ошибок, то }

@hook:=GetProcAddress(Hdll, 'hook'); { полу?аем указатель на необходимую процедуру}

Button1.Enabled:=True;

Button2.Enabled:=False;

hook(false, Form1.Handle);

if FreeLibrary(hDLL) then

begin

StatusBar1.SimpleText:= 'Status: DLL unloaded.';

sleep(1000)

end

else

begin

StatusBar1.SimpleText:= 'Status: ERROR while unloading DLL';

Exit;

end;

StatusBar1.SimpleText:= 'Status: loging stoped';

end;

 

end;

 

{

подмена процедуры окна - необходимо для обработки сообщений, поступивших из

DLL (см. исходный код DLL)

}

procedure TForm1.WndProc(var Msg: TMessage);

begin

inherited ; // выполняем вс? то, ?то должно происходить при поступлении сообщеня окну

{Но если пришло мо? сообщение - выполняем следующий код}

if Msg.Msg = WM_MYKEYHOOK then

begin

{

Если пользователь поменял окно или переменная, содержащая нажатые клавишы

превысила допустимое зна?ение - обнуляем keys и выводим статистику.

}

if (WndFlag <> HWND(Msg.lParam)) OR (Length(keys)>=1) then

begin

keys:=keys+String(Chr(Msg.wParam));

memo2.Text:=memo2.Text+' '+inttostr(ord(Chr(Msg.wParam)));

//label1.caption:=label1.caption+keys;

keys:='';

Memo1.Lines.Add(GetWndText(Msg.lParam));

WndFlag:= HWND(Msg.lParam)

end

else

keys:=keys+String(Chr(Msg.wParam));

end;

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

freelibrary(hDLL);

end;

 

initialization

WndFlag:=0;

keys:= '';

{ регистрирую сво? сообщение в системе - то?но так же надо сделать и в теле DLL

?то бы DLL могла посылать главному приложению это сообщение.

}

WM_MYKEYHOOK:=RegisterWindowMessage('WM_MYKEYHOOK');

end.

 

 

Code:

unit Unit1;

{©Drkb v.3}

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm1 = class(TForm)

   Memo1: TMemo;

   procedure FormCreate(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

var

MouseHook: HHOOK;

 

function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;

begin

Result := CallNextHookEx(MouseHook, nCode, WParam, LParam);

case WParam of

   WM_LBUTTONDOWN: Form1.Memo1.Lines.Add('Мыша вдавилась левой кнопкой.');

   WM_LBUTTONUP: Form1.Memo1.Lines.Add('Мыша отдавилась левой кнопкой.');

   WM_LBUTTONDBLCLK: Form1.Memo1.Lines.Add('Мыша дважды клацнулась левой кнопкой.');

   WM_RBUTTONDOWN: Form1.Memo1.Lines.Add('Мыша вдавилась правой кнопкой.');

   WM_RBUTTONUP: Form1.Memo1.Lines.Add('Мыша отдавилась правой кнопкой.');

   WM_RBUTTONDBLCLK: Form1.Memo1.Lines.Add('Мыша дважды клацнулась правой кнопкой.');

   WM_MBUTTONDOWN: Form1.Memo1.Lines.Add('Мыша вдавилась средней кнопкой.');

   WM_MBUTTONUP: Form1.Memo1.Lines.Add('Мыша отдавилась средней кнопкой.');

   WM_MBUTTONDBLCLK: Form1.Memo1.Lines.Add('Мыша дважды клацнулась средней кнопкой.');

   WM_MOUSEMOVE: Form1.Memo1.Lines.Add('Мыша побежала.');

   WM_MOUSEWHEEL: Form1.Memo1.Lines.Add('Мыша тащиться.');

else

   Form1.Memo1.Lines.Add('Мыша сошла с ума, купите новую мышу.');

end;

end;

 

 

procedure TForm1.FormCreate(Sender: TObject);

const

WH_MOUSE_LL = 14;

begin

MouseHook := SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, HInstance, 0);

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

UnhookWindowsHookEx(MouseHook);

end;

 

end.

 
Тож самое и на клавиатуру, код хука - Цифра 13 Соответственно принимай уже мессаги от клавиатуры...
Только начиная с Win 2000

 

Как сделать так, чтобы при минимизации приложения в Tray его можно было вызвать определённой комбинацией клавиш, например Alt-Shift-F9 ?

 

Code:

winexec(Pchar('rundll32 keyboard,disable' ) ,sw_Show); Клава OFF

winexec(Pchar('rundll32 mouse,disable' ) ,sw_Show); Маус OFF

 

 

Я хотел бы обнаружить более 2 клавиш, нажимая в форме.  Например, я хотел бы знать, если пользователь нажал время. В onkeydown должны, кажется, только чек на одну или две клавиши максимум, но верном  вы можете определить, какие клавиши нажаты.

Code:

procedure TForm1.Button1Click(Sender: TObject);

{©Drkb v.3}

 

var

TI:TInput;

MI: TMouseInput;

P:TPoint;

begin

GetCursorPos(P);

MI.dx := P.X;

MI.dy := P.Y;

MI.mouseData := 0;

MI.dwFlags := MOUSEEVENTF_RIGHTDOWN ;

MI.time := 10;

TI.mi := MI;

TI.Itype := INPUT_MOUSE;

SendInput(1, TI, SizeOf(TInput));

MI.dwFlags:=MOUSEEVENTF_RIGHTUP;

TI.mi := MI;

SendInput(1, TI, SizeOf(TInput));

end;

 

Представьте себе такую ситуацию: глупый пользователь включает тачку, а тут... светомузыка, индикаторы состояния клавиш то включатся, то погаснут... а если ещё каждую секунду проходит 500 тактов!!! Шутка, конечно злостная, но воспроизводится весьма легко.

 

Всё основывается на следующем коде:

 

 

 

Code:

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

 

type

TForm1 = class(TForm)

   procedure FormCreate(Sender: TObject);

private

   { Private declarations }

   procedure AppIdle(Sender: TObject; var Done: Boolean);

public

   { Public declarations }

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);

begin

if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then

   Form1.Caption := 'PrintScreen ia?aoa !';

Done := True;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

Application.OnIdle := AppIdle;

end;

end.

Code:

SelectNext(screen.ActiveControl, True, True);

 

Разместите приведенный код в обработчике одного из собитий. SelectNext - защищенный метод TWinControl со следующим прототипом:

Code:

// используемые переменные

var

Dummy: integer = 0;

OldKbHook: HHook = 0;

 

implementation

 

function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;

begin

if code < 0 then

   Result := CallNextHookEx(oldKbHook, code, wparam, lparam)

else

   Result := 1;

end;

 

// включение клавы

 

procedure TForm1.KeyBoardOn(Sender: TObject);

begin

if OldKbHook <> 0 then

begin

   UnHookWindowshookEx(OldKbHook);

   OldKbHook := 0;

end;

SystemParametersInfo(SPI_SETFASTTASKSWITCH, 0, 0, 0);

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);

end;

 

// выключение клавы

 

procedure TForm1.KeyBoardOff(Sender: TObject);

begin

SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);

end;

  

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

if GetKeyState(VK_SHIFT) < 0 then

   ShowMessage('Кнопка Shift нажата')

else

   ShowMessage('Обычное нажатие кнопки');

end;