Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Keyboard hook help??

[es] :: Pascal / Delphi / Kylix :: Keyboard hook help??

Strane: 1 2

[ Pregleda: 5866 | Odgovora: 22 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

borovac
127.0.0.1

Član broj: 29278
Poruke: 220
*.dlp210.bih.net.ba.



Profil

icon Keyboard hook help??05.07.2005. u 18:01 - pre 228 meseci
Code:

library HookLib;

uses
  Windows,
  Messages,
  SysUtils;

type
  PHookRec = ^THookRec;
  THookRec = record
    AppHnd: Integer;
    MemoHnd: Integer;
  end;

var
  Hooked: Boolean;
  hKeyHook, hMemFile: HWND;
  PHookRec1: PHookRec;

function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): LRESULT; stdcall;
var
  KeyState1: TKeyBoardState;
  AryChar: array[0..1] of Char;
  Count: Integer;
begin
  Result := 0;
  if Code = HC_NOREMOVE then Exit;
  Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);
  if Code < 0 then
    Exit;

  if Code = HC_ACTION then
  begin
    if ((KeyStroke and (1 shl 30)) <> 0) then
    begin
       if VirtualKey=VK_TAB then ....
    end;
  end;
end;


function StartHook(MemoHandle, AppHandle: HWND): Byte; export;
begin
  Result := 0;
  if Hooked then
  begin
    Result := 1;
    Exit;
  end;
  hKeyHook := SetWindowsHookEx(WH_KEYBOARD, KeyHookFunc, hInstance, 0);
  if hKeyHook > 0 then
  begin
{you need to use a mapped file because this DLL attatches to every app
that gets windows messages when it's hooked, and you can't get info except
through a Globally avaiable Mapped file}
    hMemFile := CreateFileMapping($FFFFFFFF, // $FFFFFFFF gets a page memory file
      nil,                // no security attributes
      PAGE_READWRITE,      // read/write access
      0,                   // size: high 32-bits
      SizeOf(THookRec),           // size: low 32-bits
      //SizeOf(Integer),
      'Global7v9k');    // name of map object
    PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
    {set the Memo and App handles to the mapped file}
    Hooked := True;
  end 
  else
    Result := 2;
end;

function StopHook: Boolean; export;
begin
  if PHookRec1 <> nil then
  begin
    UnmapViewOfFile(PHookRec1);
    CloseHandle(hMemFile);
    PHookRec1 := nil;
  end;
  if Hooked then
    Result := UnhookWindowsHookEx(hKeyHook) 
  else
    Result := True;
  Hooked := False;
end;

procedure EntryProc(dwReason: DWORD);
begin
  if (dwReason = Dll_Process_Detach) then
  begin
    if PHookRec1 <> nil then
    begin
      UnmapViewOfFile(PHookRec1);
      CloseHandle(hMemFile);
    end;
    UnhookWindowsHookEx(hKeyHook);
  end;
end;

exports
  StartHook,
  StopHook;

begin
  PHookRec1 := nil;
  Hooked := False;
  hKeyHook := 0;
  hMemo := 0;
  DLLProc := @EntryProc;
  EntryProc(Dll_Process_Attach);
end.


kao što vidite ovaj dll obrađuje sve što dolazi sa tastature.
Kako sada to što dolazi sa tastature ne proslijediti dalje, tamo gdje treba da ide?
Znači kako da onemogućim neki pritisnut taster?
Gore kod linije
Code:
 if VirtualKey=VK_TAB then

šta treba uraditi pa da onemogućimo Tab??


[Ovu poruku je menjao borovac dana 05.07.2005. u 19:01 GMT+1]
 
Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
82.208.201.*

ICQ: 246436949


+10 Profil

icon Re: Keyboard hook help??05.07.2005. u 18:46 - pre 228 meseci
Ako ti je Result <> 0 taj key event nece doci do prozora, a ako je Result = 0 onda hoce.
 
Odgovor na temu

borovac
127.0.0.1

Član broj: 29278
Poruke: 220
*.dlp263.bih.net.ba.



Profil

icon Re: Keyboard hook help??05.07.2005. u 22:30 - pre 228 meseci
znači da umjesto
Code:
Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);

trebam staviti
Code:
Result := 1
 
Odgovor na temu

borovac
127.0.0.1

Član broj: 29278
Poruke: 220
*.dlp448.bih.net.ba.



Profil

icon Re: Keyboard hook help??06.07.2005. u 11:28 - pre 228 meseci
Ovo sam uradio. I recimo otvorim notepad i pišem nešto bezveze. Moj program pamti to, dok se u notepad-u ne pojavljuje ništa. Znači te tipke su spriječene. Međutim kada pritisnem Alt+Tab ili Ctrl+Esc ili Ctrl+Alt+Del odgovarajuće stvari se izvrše. Znači ove windows kombinacije ne može spriječiti samo tako.
Kako njih da spriječim???
Please help
 
Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
*.smin.sezampro.yu.

ICQ: 246436949


+10 Profil

icon Re: Keyboard hook help??06.07.2005. u 13:43 - pre 228 meseci
Za to ti treba hook na WH_SYSMSGFILTER, a ne na WH_KEYBOARD.
 
Odgovor na temu

borovac
127.0.0.1

Član broj: 29278
Poruke: 220
*.dlp427.bih.net.ba.



Profil

icon Re: Keyboard hook help??06.07.2005. u 14:29 - pre 228 meseci
Našao sam bio neki primjer koji tako onemogućava tipke, i koristi WH_GETMESSAGE.
Probat ću nešto skontat.
hvala svima.
 
Odgovor na temu

obucina

Član broj: 38191
Poruke: 723

Jabber: obucina


+7 Profil

icon Re: Keyboard hook help??06.07.2005. u 14:54 - pre 228 meseci
Citat:
borovac: Našao sam bio neki primjer koji tako onemogućava tipke, i koristi WH_GETMESSAGE.

Hoces li podeliti taj primer sa nama?
 
Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
82.208.201.*

ICQ: 246436949


+10 Profil

icon Re: Keyboard hook help??06.07.2005. u 16:08 - pre 228 meseci
Pardon... ipak treba da se koristi WH_KEYBOARD_LL, ali koliko znam to ne postoji u Delphi 7 (mislim... nije deklarisana konstanta za to... mozda bih mogao malo da pronjuskam po C++ kodu i probam da je nadjem kao i prototip funkcije za LowLevel Keyboard Hook). Ovaj hook hvata svaki taster pre sistema tako da efikasno mozes da blokiras totalno tastaturu.
Videcu da prevedem sa C++ na Delphi sve sto je potrebno da bi ovo radilo... ako se razumes u C onda ce ti ovo pomoci
Code:
LRESULT CALLBACK LowLevelKeyboardProc (INT nCode, WPARAM wParam, LPARAM lParam)
{
    // By returning a non-zero value from the hook procedure, the
    // message does not get passed to the target window
    KBDLLHOOKSTRUCT *pkbhs = (KBDLLHOOKSTRUCT *) lParam;
    BOOL bControlKeyDown = 0;

    switch (nCode)
    {
        case HC_ACTION:
        {
            // Check to see if the CTRL key is pressed
            bControlKeyDown = GetAsyncKeyState (VK_CONTROL) >> ((sizeof(SHORT) * 8) - 1);

            // Disable CTRL+ESC
            if (pkbhs->vkCode == VK_ESCAPE && bControlKeyDown)
                return 1;

            // Disable ALT+TAB
            if (pkbhs->vkCode == VK_TAB && pkbhs->flags & LLKHF_ALTDOWN)
                return 1;

            // Disable ALT+ESC
            if (pkbhs->vkCode == VK_ESCAPE && pkbhs->flags & LLKHF_ALTDOWN)
                return 1;

            break;
        }

        default:
            break;
    }
    return CallNextHookEx (hHook, nCode, wParam, lParam);
}


Ovo je skinuto sa Microsoft Support sajta.
 
Odgovor na temu

Nemanja Avramović
Engineering Manager
MENU Technologies
Beograd, Srbija

Član broj: 32202
Poruke: 4391
*.yu1.net.

Sajt: https://avramovic.info


+46 Profil

icon Re: Keyboard hook help??06.07.2005. u 16:41 - pre 228 meseci
prevedi ti to u Delphi :)
Laravel Srbija.

[NE PRUŽAM PODRŠKU ZA PHP PREKO PRIVATNIH PORUKA!]
 
Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
82.208.201.*

ICQ: 246436949


+10 Profil

icon Re: Keyboard hook help??06.07.2005. u 16:56 - pre 228 meseci
A tako me mrzi da instaliram MS Visual Studio
 
Odgovor na temu

borovac
127.0.0.1

Član broj: 29278
Poruke: 220
*.dlp307.bih.net.ba.



Profil

icon Re: Keyboard hook help??06.07.2005. u 17:23 - pre 228 meseci
Svaka čast majstore, baš kad sam izgubio nadu.
Razumijem se ja u C++. Ali ipak ti to prevedi. U delphi-u nema LowLevelKeyboardProc niti WH_KEYBOARD_LL.
To je samo kod Microsoftovih alata, majka im stara!

Evo onog primjera!
DLL file:
Code:

unit WHookInt;

interface

uses
  Windows, Messages, SysUtils;

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall; export;
function FreeHook: Boolean; stdcall; export;
function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcall; export;

implementation


// Memory map file stuff

{
  The CreateFileMapping function creates unnamed file-mapping object
  for the specified file.
}

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

type
  TPMsg = ^TMsg;

const
  VK_D = $44;
  VK_E = $45;
  VK_F = $46;
  VK_M = $4D;
  VK_R = $52;

  MMFName = 'MsgFilterHookDemo';

type
  PMMFData = ^TMMFData;
  TMMFData = record
    NextHook: HHOOK;
    WinHandle: HWND;
    MsgToSend: Integer;
  end;

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

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;

{
  The SetWindowsHookEx function installs an application-defined
  hook procedure into a hook chain.

  WH_GETMESSAGE Installs a hook procedure that monitors messages
  posted to a message queue.
  For more information, see the GetMsgProc hook procedure.
}

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
begin
  Result := False;
  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.WinHandle := WinHandle;
        MMFData.MsgToSend := MsgToSend;
        MMFData.NextHook := SetWindowsHookEx(WH_GETMESSAGE, MsgFilterFunc, HInstance, 0);

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


{
  The UnhookWindowsHookEx function removes the hook procedure installed
  in a hook chain by the SetWindowsHookEx function.
}

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



(*
    GetMsgProc(
    nCode: Integer;  {the hook code}
    wParam: WPARAM;  {message removal flag}
    lParam: LPARAM  {a pointer to a TMsg structure}
    ): LRESULT;  {this function should always return zero}

    { See help on ==> GetMsgProc}
*)

function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint;
var
  MMFHandle: THandle;
  MMFData: PMMFData;
  Kill: boolean;
begin
  Result := 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
        {
          The CallNextHookEx function passes the hook information to the
          next hook procedure in the current hook chain.
        }
        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
      else
      begin
        Kill := False;

        { Examples }
        with TMsg(Pointer(lParam)^) do
        begin
          // Kill Numbers
          if (wParam >= 48) and (wParam <= 57) then Kill := True;
          // Kill Tabulator
          if (wParam = VK_TAB) then Kill := True;
        end;

        { Example to disable all the start-Key combinations }
        case TPMsg(lParam)^.message of
          WM_SYSCOMMAND: // The Win Start Key (or Ctrl+ESC)
            if TPMsg(lParam)^.wParam = SC_TASKLIST then Kill := True;

          WM_HOTKEY:
            case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
              VK_D,      // Win+D        ==> Desktop
              VK_E,      // Win+E        ==> Explorer
              VK_F,      // Win+F+(Ctrl) ==> Find:All (and Find: Computer)
              VK_M,      // Win+M        ==> Minimize all
              VK_R,      // Win+R        ==> Run program.
              VK_F1,     // Win+F1       ==> Windows Help
              VK_PAUSE:  // Win+Pause    ==> Windows system properties
                Kill := True;
            end;
        end;
        if Kill then TPMsg(lParam)^.message := WM_NULL;
        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
      end;
      UnMapMMF(MMFData);
    end;
    CloseMMF(MMFHandle);
  end;
end;


initialization
  begin
    MMFHandle := 0;
    MMFData   := nil;
  end;

finalization
  FreeHook;
end.


glavni program glasi ovako

Code:

unit FrmMainU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

const
  HookDemo = 'WINHOOK.dll';

const
  WM_HOOKCREATE = WM_USER + 300;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    BtnSetHook: TButton;
    BtnClearHook: TButton;
    procedure BtnSetHookClick(Sender: TObject);
    procedure BtnClearHookClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FHookSet: Boolean;
    procedure EnableButtons;
  public

  end;

var
  FrmMain: TFrmMain;

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
  external HookDemo;

function FreeHook: Boolean; stdcall; external HookDemo;

implementation

{$R *.DFM}

procedure TFrmMain.EnableButtons;
begin
  BtnSetHook.Enabled   := not FHookSet;
  BtnClearHook.Enabled := FHookSet;
end;

// Start the Hook
procedure TFrmMain.BtnSetHookClick(Sender: TObject);
begin
  FHookSet := LongBool(SetHook(Handle, WM_HOOKCREATE));
  EnableButtons;
end;

// Stop the Hook
procedure TFrmMain.BtnClearHookClick(Sender: TObject);
begin
  FHookSet := FreeHook;
  EnableButtons;
  BtnClearHook.Enabled := False;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  EnableButtons;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  BtnClearHook.Click;
end;

end.


Ali bih višeo volio Keyboard Hook!
Hvala
 
Odgovor na temu

borovac
127.0.0.1

Član broj: 29278
Poruke: 220
*.dlp307.bih.net.ba.



Profil

icon Re: Keyboard hook help??06.07.2005. u 17:52 - pre 228 meseci
Našo sam odličan paket komponenti za različite hookove. Svi koriste jedan dll file. Za source tog dll-a treba platiti, a meni se baš i ne plaća!
Više bih volio source. Nadam se da će Srki_82 uspjeti u svojoj misiji.

Možda bi mogao i ovaj moj primjer proći, ali ne nešto ne radi kakda pokušam obraditi poruku, tj. pretvoriti poruku u tipke!
 
Odgovor na temu

Nemanja Avramović
Engineering Manager
MENU Technologies
Beograd, Srbija

Član broj: 32202
Poruke: 4391
*.yu1.net.

Sajt: https://avramovic.info


+46 Profil

icon Re: Keyboard hook help??06.07.2005. u 18:56 - pre 228 meseci
Citat:
borovac: Našo sam odličan paket komponenti za različite hookove. Svi koriste jedan dll file. Za source tog dll-a treba platiti, a meni se baš i ne plaća!


daj napisi koji je to DLL i gde ga mozemo skinuti?
Laravel Srbija.

[NE PRUŽAM PODRŠKU ZA PHP PREKO PRIVATNIH PORUKA!]
 
Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
82.208.201.*

ICQ: 246436949


+10 Profil

icon Re: Keyboard hook help??06.07.2005. u 21:34 - pre 228 meseci
Smilovao sam se i evo instaliram Visual Studio. Za par dana cu verovatno pronaci sve sto mi treba da dodal u Delphi WH_KEYBOARD_LL... pozelite mi srecu
 
Odgovor na temu

Passwd

Član broj: 54624
Poruke: 640
*.adsl.net.t-com.hr.



Profil

icon Re: Keyboard hook help??06.07.2005. u 21:46 - pre 228 meseci
Citat:
Srki_82: ........pozelite mi srecu


Sretno

[Ovu poruku je menjao Passwd dana 06.07.2005. u 22:46 GMT+1]
 
Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
82.208.201.*

ICQ: 246436949


+10 Profil

icon Re: Keyboard hook help??07.07.2005. u 21:07 - pre 228 meseci
Evo unita koji ce vam omoguciti da koristite LowLevel Hooks u Delphiu.
Ako me ne bude mrzelo prevescu i onu hook funkciju sa C na Delphi, a mogao bi to i neko drugi da uradi
Prikačeni fajlovi
 
Odgovor na temu

Nemanja Avramović
Engineering Manager
MENU Technologies
Beograd, Srbija

Član broj: 32202
Poruke: 4391
*.yu1.net.

Sajt: https://avramovic.info


+46 Profil

icon Re: Keyboard hook help??08.07.2005. u 01:50 - pre 228 meseci
objasni kako koristiti to?
Laravel Srbija.

[NE PRUŽAM PODRŠKU ZA PHP PREKO PRIVATNIH PORUKA!]
 
Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
82.208.201.*

ICQ: 246436949


+10 Profil

icon Re: Keyboard hook help??08.07.2005. u 06:41 - pre 228 meseci
Pa isto kao i bilo koji drugi hook :)

Kad pozivas SetWindowsHookEx postavis tip hook-a na WH_KEYBOARD_LL, LParam (poslednji parametar u hook funkciji) je pointer na strukturu tipa KBDLLHOOKSTRUCT pa radi sa tim podacima sta zelis :)

Tako isto je i sa WH_MOUSE_LL samo sto je LParam pointer na strukturu tipa MSLLHOOKSTRUCT.
 
Odgovor na temu

Nemanja Avramović
Engineering Manager
MENU Technologies
Beograd, Srbija

Član broj: 32202
Poruke: 4391
*.yu1.net.

Sajt: https://avramovic.info


+46 Profil

icon Re: Keyboard hook help??08.07.2005. u 12:05 - pre 228 meseci
e pa ja nikad nisam hookovao do sad tako da nem' pojma sta ti pricas ovde :D
ali snaci cu se (kao i uvek :P)
Laravel Srbija.

[NE PRUŽAM PODRŠKU ZA PHP PREKO PRIVATNIH PORUKA!]
 
Odgovor na temu

borovac
127.0.0.1

Član broj: 29278
Poruke: 220
*.dlp442.bih.net.ba.



Profil

icon Re: Keyboard hook help??09.07.2005. u 12:56 - pre 228 meseci
Evo ba onaj primjer za deaktiviranje nekih windows ključeva.
A evo link za onaj HookPack
[url]http://www.bitlogic.co.uk/downloads/hookpack.zip[/url]
Prikačeni fajlovi
 
Odgovor na temu

[es] :: Pascal / Delphi / Kylix :: Keyboard hook help??

Strane: 1 2

[ Pregleda: 5866 | Odgovora: 22 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.