Текущий архив: 2004.12.12;
Скачать: CL | DM;

Вниз

Пример low level хука   Найти похожие ветки 

← →
Сергей К. ©   (2004-10-13 19:14) [0]

У кого-нибудь есть пример low level hook для клавиатуры написанного на Delphi.
Если у кого есть то вышлите пожалуйста на e-mail. Ооочень нужен.

---

← →
TUser ©   (2004-10-14 12:12) [1]

А что такое "low level hook"? Как обычный хук ставить - это много где есть, например у А.Подгорецкого на сайте очень хорошвая статья. Еще програмка такая валяется в сети, snoop2 зовут. Распространяется с исходниками на Delphi - можешь там посмотреть. Да мало ли где ...

---

← →
Сергей К. ©   (2004-10-14 19:42) [2]

Это низко уровневый хук, необходим мне чтобы глушить нажатия клавиши VK_WIN в системе XP.

---

← →
MetalFan ©   (2004-10-14 20:01) [3]

Лови на мыло пример...
там как раз я другу делал блокировку Win Key.

---

← →
Сергей К. ©   (2004-10-14 20:06) [4]

Спасибо за пример,
поиду разбиратся :)

---

← →
Nick Denry ©   (2004-10-14 23:06) [5]

2MetalFan ©   (14.10.04 20:01) [3]

Можно мне тоже пример на мыло?

---

← →
MetalFan ©   (2004-10-15 10:55) [6]

хех) может сразу в faq выложили бы?
счас пришлю

---

← →
Дядя   (2004-10-15 12:52) [7]

2MetalFan выложи в форуме, plz

---

← →
MetalFan ©   (2004-10-15 16:55) [8]

код DLL
unit KBDHookInt;

interface

uses
  Windows, Messages, SysUtils;

function SetHook(LockWin, LockCaps, LockACD: boolean): Boolean; stdcall;export;
function FreeHook: Boolean; stdcall; export;
function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcall; export;

implementation

 function DoWriteLog(aLogString: String): boolean; overload;
 var
   lFile: TextFile;
   lFN: string;
 begin
   exit;
   lFN := "c:\KBDHOOKlog.txt";
   AssignFile(lFile, lFN);
   try
     if FileExists(lFN) then
       Append(lFile)
     else
       Rewrite(lFile);
     Writeln(lfile, Format("[%s] %s",[DateTimeToStr(now),aLogString]));
   finally
     CloseFile(lFile);
   end;
   result := true;
 end;

 function DoWriteLog(FormatStr: string; Params: array of const): boolean; overload;
 begin
   DoWriteLog(  Format( FormatStr, Params )  );
   result := true;
 end;

function CreateMMF(Name: string; Size: Integer): THandle;
begin
  Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(Name));
  if Result <> 0 then
  begin
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      CloseHandle(Result);
      Result := 0;
    end;
  end;
end;

{ The OpenFileMapping function opens a named file-mapping object. }

function OpenMMF(Name: string): THandle;
begin
  Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  // The return value is an open handle to the specified file-mapping object.
end;

{
The MapViewOfFile function maps a view of a file into
the address space of the calling process.
}

function MapMMF(MMFHandle: THandle): Pointer;
begin
  Result := MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
end;

{
 The UnmapViewOfFile function unmaps a mapped view of a file
 from the calling process"s address space.
}

function UnMapMMF(P: Pointer): Boolean;
begin
  Result := UnmapViewOfFile(P);
end;

function CloseMMF(MMFHandle: THandle): Boolean;
begin
  Result := CloseHandle(MMFHandle);
end;

// Actual hook stuff

const
  MMFName = "KBDFilterHookF068DFB2CEC2";
  LLKHF_ALTDOWN = $20;

type
  PMMFData = ^TMMFData;
  TMMFData = record
    NextHook: HHOOK;
    LockWIN,
    LockCaps,
    LockACD,
    APrsd,
    CPrsd,
    DPrsd: boolean;
  end;

  // global variables, only valid in the process which installs the hook.
var
  MMFHandle: THandle;
  MMFData: PMMFData;
//   SetOfACDPressed: set of char;

function UnMapAndCloseMMF: Boolean;
begin
  Result := False;
  if UnMapMMF(MMFData) then
  begin
    MMFData := nil;
    if CloseMMF(MMFHandle) then
    begin
      MMFHandle := 0;
      Result := True;
    end;
  end;
end;

function SetHook(LockWin, LockCaps, lockACD: boolean): Boolean; stdcall;
begin
  Result := LockWin or LockCaps or LockACD;
  if not result then
    exit;
  if (MMFData = nil) and (MMFHandle = 0) then
  begin
    MMFHandle := CreateMMF(MMFName, SizeOf(TMMFData));
    if MMFHandle <> 0 then
    begin
      MMFData := MapMMF(MMFHandle);
      if MMFData <> nil then
      begin
        MMFData^.LockWIN := LockWin;
        MMFData^.LockCaps := LockCaps;
        MMFData^.LockACD := LockACD;
        MMFData^.APrsd := false;
        MMFData^.CPrsd := false;
        MMFData^.DPrsd := false;
        MMFData^.NextHook := SetWindowsHookEx(13 {WH_KEYBOARD_LL}, MsgFilterFunc, HInstance, 0);

        if MMFData^.NextHook = 0 then
          UnMapAndCloseMMF
        else
          Result := True;
      end
      else
      begin
        CloseMMF(MMFHandle);
        MMFHandle := 0;
      end;
    end;
  end;
end;

function FreeHook: Boolean; stdcall;
begin
  Result := False;
  if (MMFData <> nil) and (MMFHandle <> 0) then
    if UnHookWindowsHookEx(MMFData^.NextHook) then
      Result := UnMapAndCloseMMF;
//   SetOfACDPressed := [];
end;

type
  PKeybdHookStruct = ^TKeybdHookStruct;
  TKeybdHookStruct = record
     vkCode: DWORD;
     scanCode: DWORD;
     flags: DWORD;
     time: DWORD;
     dwExtraInfo: PULONG;
  end;
const
  CAltSet  : set of byte = [164,165];
  CCtrlSet : set of byte = [162,163];
  CDelSet  : set of byte = [46,110];

function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint;
var
  MMFHandle: THandle;
  MMFData: PMMFData;
  Kill: boolean;
  BlockSet: Set Of byte;
  lHkStruct: PKeybdHookStruct;
  lPressedCount: integer;
begin
  Result := 0;
  lPressedCount := 0;
  MMFHandle := OpenMMF(MMFName);
  if MMFHandle <> 0 then
  begin
    MMFData := MapMMF(MMFHandle);
    if MMFData <> nil then
    begin
      if (Code < 0) or (wParam = PM_NOREMOVE) then
        Result := CallNextHookEx(MMFData^.NextHook, Code, wParam, lParam)
      else
      if Code = HC_ACTION then
      begin
        Kill := False;
        lHkStruct := Pointer(lParam);
        BlockSet := [];
        if MMFData^.LockWIN then
          BlockSet := BlockSet + [91,92];
        if MMFData^.LockCaps then
          BlockSet := BlockSet + [20];
        KILL := lHkStruct^.vkCode in BlockSet;
        DoWriteLog("wPar: $%s, %S;  KK: $%s, %s",
         [IntToHex(wParam, 2),IntToStr(wParam), IntToHex(lHkStruct^.vkCode, 8), IntToStr(lHkStruct^.vkCode)]);
        if kill then
          result := 1
        else
          Result := CallNextHookEx(MMFData^.NextHook, Code, wParam, lParam);
      end;
      UnMapMMF(MMFData);
    end;
    CloseMMF(MMFHandle);
  end;
end;

initialization
    MMFHandle := 0;
    MMFData   := nil;

 finalization
    FreeHook;
end.


---

← →
MetalFan ©   (2004-10-15 16:56) [9]

как пользоваться надеюсь объяснять не надо?
з.ы. LockACD не работает...

---

← →
Сергей К. ©   (2004-10-18 18:25) [10]

написал клавиатурный хук под Win 98/me/xp.
Кому нужен могу поделиться :)

---

← →
Nick Denry ©   (2004-10-18 20:16) [11]

Сергей К. ©   (18.10.04 18:25) [10]

Мне мыль.

---

← →
Сергей К. ©   (2004-10-18 20:45) [12]

лови

---

← →
Nick Denry ©   (2004-10-18 23:35) [13]

Сергей К. ©   (18.10.04 20:45) [12]

Чегой-то не пришло. отправь еще плиз на Nick_Denry@Mail.ru

---

← →
Сергей К. ©   (2004-10-19 13:36) [14]

> Nick Denry ©  

зы, e-mail не тот был :)

---

← →
Aprell   (2004-10-28 06:25) [15]

Блин, ну что за тайны????... кину на мыло.....
выкладывай в форум.... что бы кому надо взял и посмотрел как умные людь делают.

---

← →
Сергей К. ©   (2004-10-29 10:05) [16]

вот код хука :

{KALMYKOV SERGEY 2004.
KEYBOARD HOOK DLL
Version : 0.1

Control state result :

1 - Ctrl
2 - Alt
3 - Win
4 - Ctrl+Alt
5 - Ctrl+Win
6 - Ctrl+Shift
7 - Alt+Win
8 - Ctrl+Shift+Alt
9 - Ctrl+Win+Alt

}
library hook;

uses
 Windows,
 SySUtils,
 Messages;
Const
MMF1 = "MMF_LISTHOTKEYS001"; //Список блокируемых комбинаций
MMF2 = "MMF_GLOBALHOOKDATA";
//структура, поля которой будут отображены в файл подкачки
Type
PGlobalData = ^TGlobalData;
TGlobalData = Packed Record
SysHook: HWND; // дескриптор установленной ловушки
MyAppWnd: HWND; // Дескриптор нашего приложения
End;

PList = ^TList;
TList = Packed Record
List : String[255]; // Список сочетаний ползволяет вместить около 50 комбинаций
End;

var
GlobalData :PGlobalData;
MMFHandle1, MMFHandle2, MMFHandle3 : THandle;
WM_HOOK_KEYPRESSED, WM_HOOK_KEYBLOCK, WM_HOOK_KEYALLBLOCK : Cardinal;

//HOOK
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; export; stdcall;

function ControlKeyState :Byte;
function KeyState(VirtualKeyCode :Byte) : Boolean;
var
 State : TKeyboardState;
begin
 GetKeyboardState(State);
 Result := ((State[VirtualKeyCode] And 128) <> 0);
end;
begin
Result := 0;
if KeyState(VK_CONTROL) then result := 1;
if KeyState(VK_MENU) then result := 2;
if KeyState(VK_RWIN) or KeyState(VK_LWIN) then result := 3;
if KeyState(VK_CONTROL) and KeyState(VK_MENU) then result := 4;
if KeyState(VK_CONTROL) then  if KeyState(VK_RWIN) or KeyState(VK_LWIN) then result := 5;
if KeyState(VK_CONTROL) and KeyState(VK_SHIFT) then result := 6;
if KeyState(VK_MENU) then if KeyState(VK_RWIN) or KeyState(VK_LWIN) then result := 7;
if KeyState(VK_CONTROL) and KeyState(VK_SHIFT) and KeyState(VK_MENU) then result := 8;
if KeyState(VK_CONTROL) and KeyState(VK_MENU) then if KeyState(VK_RWIN) or KeyState(VK_LWIN) then result := 9;
end;
var
Str :PList;
begin
Result := CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
MMFHandle3 := OpenFileMapping(PAGE_READWRITE ,FALSE , MMF1);
if MMFHandle3 = 0 then Exit;
Str := MapViewOfFile(MMFHandle3, FILE_MAP_READ, 0, 0, SizeOf(TList));
if Str = nil then begin CloseHandle(MMFHandle3); exit; end;
if (code = HC_ACTION) and (lParam <> lParam or $8000 shl 16) and (lParam <> lParam or $8000 shl 15) then
if (wParam <> VK_RWIN) and (wParam <> VK_LWIN) and (wParam <> VK_SHIFT) and (wParam <> VK_CONTROL) and (wParam <> VK_MENU) Then Begin
SendMessage(GlobalData^.MyAppWnd,WM_HOOK_KEYPRESSED,ControlKeyState,wParam);
//Блокировать все клавиши
If UpperCase(Str^.List) <> "ALL" Then begin
//format example 0+32 - нажат пробел
If Pos(IntToStr(ControlKeyState)+"+"+IntToStr(wParam),Str^.List) <> 0 Then begin
SendMessage(GlobalData^.MyAppWnd,WM_HOOK_KEYBLOCK,ControlKeyState,wParam);
Result := 1;
end;
end else begin
SendMessage(GlobalData^.MyAppWnd,WM_HOOK_KEYALLBLOCK,ControlKeyState,wParam);
result := 1;
end;
End;
UnmapViewOfFile(Str);
CloseHandle(MMFHandle3);
end;


---

← →
Сергей К. ©   (2004-10-29 10:12) [17]


function SetHook(Const Hook : Boolean = false; hMainProg: HWND = 0; HotKeyList :String = "") : Boolean; export; stdcall;
var
Str :PList;
begin
Result := False;
If hook then begin
MMFHandle1 := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TList), MMF1);
if MMFHandle1 = 0 then Exit;
Str := MapViewOfFile(MMFHandle1, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TList));
if Str = nil then Begin CloseHandle(MMFHandle1); exit; end;
Str^.List := HotKeyList;
GlobalData^.MyAppWnd:= hMainProg;
GlobalData^.SysHook := SetWindowsHookEx(WH_KEYBOARD, @SysMsgProc, HInstance, 0);
if GlobalData^.SysHook <> 0 then Result := True;
end else begin
CloseHandle(MMFHandle1);
if UnhookWindowsHookEx(GlobalData^.SysHook) then Result := True;
end;
end;

procedure OpenGlobalData(); stdcall;
begin
MMFHandle2 := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalData), MMF2);
If MMFHandle2 = 0 then Exit;
GlobalData := MapViewOfFile(MMFHandle2, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalData));
if GlobalData = nil then begin CloseHandle(MMFHandle2); Exit; end;
end;

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

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

exports
 Sethook;

begin
 // нажата комбинация
 WM_HOOK_KEYPRESSED := RegisterWindowMessage("WM_HOOK_KEYPRESSED");
 // заблокирована комбинация
 WM_HOOK_KEYBLOCK := RegisterWindowMessage("WM_HOOK_KEYBLOCK");
 // режим блокировки всх комбинаций
 WM_HOOK_KEYALLBLOCK := RegisterWindowMessage("WM_HOOK_KEYALLBLOCK");
 // назначим поцедуру переменной DLLProc
 DLLProc:= @DLLEntryPoint;
 // вызываем назначенную процедуру для отражения факта присоединения данной библиотеки к процессу
 DLLEntryPoint(DLL_PROCESS_ATTACH);
end.


---

← →
Сергей К. ©   (2004-10-29 10:35) [18]

качайте исходник здесь
www.delphisourses.narod.ru/hook_v0.2.rar
там хук для клавы под 98/ME/XP

---

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

Текущий архив: 2004.12.12;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.025 c