Jump to content


Check out our Community Blogs

Register and join over 40,000 other developers!


Recent Status Updates

View All Updates

Photo
- - - - -

Windows Hooking: Enabling And Disabling Keyboard, With Delphi Code.

delphi

  • Please log in to reply
3 replies to this topic

#1 Luthfi

Luthfi

    CC Leader

  • Expert Member
  • PipPipPipPipPipPipPip
  • 1320 posts
  • Programming Language:PHP, Delphi/Object Pascal, Pascal, Transact-SQL
  • Learning:C, Java, PHP

Posted 14 November 2010 - 06:45 AM

Folks, this tutorial is in the series of Windows hooking tutorial. But this time this will be a short tutorial since it will not explaining no theory. This tutorial simply answer a simple problem. The problem is: how to disable (and of course later to enable) keyboard input.


Please check out the previous Windows Hooking Tutorial (The one about Mouse Hooking) to get a little background on Windows Hooking. For our current problem, we can solve it by installing a hook to keyboard events and in the hook handle we simply drop the event. This way the keyboard event won't reach its intended receiver. Since we will implement our code inside a dll, the keyboard will be disabled for all applications.


However not all keyboard events passed to the hook. Some "important" keyboard combination will bypass our hook handler. But don't worry, all of these bypassers usually could not be handled by ordinary applications. Example of these bypassers: Ctrl+Alt+Del, Alt+Tab, and Ctrl+Esc.


Note that although the technique explained here could be used for keylogger application like for example discussed in here, but this tutorial does not approve or promote writing any application with intentions against law and moral/social norms. This is purely for knowledge sharing and educational purpose.


Now here is the code that should be placed inside a dll. For this demo we name it KBHook.dll.



library KBHook;


uses

  Windows

  ;


var

  Hook: HHOOK;  // variable to store hook handle to be used to unhook later


// routine that handles the keyboard events (when the hook is installed)

function KBHookHandler(ACode: Integer; WParam: WParam;

                          LParam: LParam): LResult; stdcall;

begin

  if ACode < 0 then

    // Immediately pass the event to next hook

    Result := CallNextHookEx(Hook, ACode, WParam, LParam)

  else

    // by setting Result to values other than 0 means we drop/erase the event

    Result := 1;

end;


// This exported routine is the one to call to disable the keyboard.

// It actually installs keyboard hook which handler drops any keyboard event

// it receives

function DisableKeyboard: Boolean; stdcall;

begin

  if Hook = 0 then

    // install the hook

    Hook:= SetWindowsHookEx(WH_KEYBOARD, KBHookHandler, HINSTANCE, 0);

  Result := Hook <> 0;

end;


// This exported routine is the one to call to enable keyboard input.

// It actually just uninstall our keyboard hook, which mean now keyboard 

// events will reach their intended destination (unless there is another

// similar kind of hook installed with another application).

procedure EnableKeyboard;

begin

  if Hook <> 0 then

    UnhookWindowsHookEx(Hook);

  Hook := 0;

end;


exports

  DisableKeyboard

  , EnableKeyboard

  ;


begin

  Hook := 0;

end.

Now for the demo GUI application, you can create a new project and in the main form drop 2 buttons and 1 edit box (TEdit) arrange them like shown in the next image. Give first button title of Disable Keyboard, and Enable Keyboard for the second one. Leave the edit box empty. Now the code for this GUI application.



unit Form_Main;


interface


uses

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

  Dialogs, StdCtrls;


type

  TForm1 = class(TForm)

    btnDisableKB: TButton;

    btnEnableKB: TButton;

    Edit1: TEdit;

    procedure FormDestroy(Sender: TObject);

    procedure btnDisableKBClick(Sender: TObject);

    procedure btnEnableKBClick(Sender: TObject);

  private

  end;


var

  Form1: TForm1;


  function DisableKeyboard: Boolean; stdcall external 'KBHook.dll';

  procedure EnableKeyboard; stdcall external 'KBHook.dll';



implementation


{$R *.dfm}


procedure TForm1.FormDestroy(Sender: TObject);

begin

  EnableKeyboard;

end;


procedure TForm1.btnDisableKBClick(Sender: TObject);

begin

  if DisableKeyboard then

  begin

    ShowMessage('Keyboard disabled');

    Edit1.Text := 'Sorry, now you can''t type in here';

    Edit1.SetFocus;

    Edit1.SelectAll;

  end;

end;


procedure TForm1.btnEnableKBClick(Sender: TObject);

begin

  EnableKeyboard;

  Edit1.Text := 'Okay, now you can type in here';

end;


end.

Testing

Compile both projects (the dll and the exe) and run the exe (the GUI application). Click the "Disable Keyboard" button and if the disabling was succeed you will get a message saying so and you can only close the message dialog using mouse click for your keyboard input will be ignored. Check if you can type in the edit box or in other application (in notepad for example).


KBDisabled001.png


Check that some special keyboard combination is still affecting. Like the Win button, Ctrl+Alt+Del, and Alt+Tab.


After you finished testing that the keyboard really disabled (except for some special key combinations), you can reenable the keyboard by clicking Enabled Keyboard button.


Source Code

Demo projects source code for the dll and the GUI application is attached. Feel free to improve it to your need, but I really appreciate if you could drop me a message if you decide to use the code in your project.

Attached Files


Edited by LuthfiHakim, 12 April 2012 - 01:31 AM.

  • 0

#2 Alexander

Alexander

    YOL9

  • Moderator
  • 3963 posts
  • Location:Vancouver, Eh! Cleverness: 200
  • Programming Language:C, C++, PHP, Assembly

Posted 14 November 2010 - 08:15 PM

An informative tutorial, Good work. This would be nice to implement for something such as a presentation, so it cannot be interrupted unless intended.
  • 0

All new problems require investigation, and so if errors are problems, try to learn as much as you can and report back.


#3 Luthfi

Luthfi

    CC Leader

  • Expert Member
  • PipPipPipPipPipPipPip
  • 1320 posts
  • Programming Language:PHP, Delphi/Object Pascal, Pascal, Transact-SQL
  • Learning:C, Java, PHP

Posted 14 November 2010 - 10:52 PM

Thank you! Yes, actually I used this code a long time ago for similar idea. It was a short training application. When the video is playing I want the users could not type anything. So instead of disabling and reenabling any text-input-capable controls I simply disable the keyboard machine-wide :)
  • 0

#4 teloris

teloris

    CC Lurker

  • Just Joined
  • Pip
  • 1 posts

Posted 08 August 2011 - 11:04 PM

Thank you! Yes, actually I used this code a long time ago for similar idea. It was a short training application. When the video is playing I want the users could not type anything. So instead of disabling and reenabling any text-input-capable controls I simply disable the keyboard machine-wide :)


hi LuthfiHakim,

thanks for your dll. it's work great for me :thumbup:
i add some feature to your program (rebuild it) such as minimize to tray, pop up menu and icon changing.

here's the code

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, Menus, ImgList;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    MATIKANKEYBOARD1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    UTUP1: TMenuItem;
    N3: TMenuItem;
    AMPILKAN1: TMenuItem;
    ImageList1: TImageList;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MATIKANKEYBOARD1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure AMPILKAN1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UTUP1Click(Sender: TObject);
  private
    IconData: TNotifyIconData;
    procedure CreateTrayIcon;
    procedure MinimizeToTray;
    procedure RestoreFromTray;
  public
    procedure WndProc(var Msg : TMessage); override;
  end;

var
  Form1: TForm1;
  Icon: TIcon;

implementation

  function DisableKeyboard: Boolean; stdcall external 'KBHook.dll';
  procedure EnableKeyboard; stdcall external 'KBHook.dll';

{$R *.dfm}

procedure TForm1.WndProc(var Msg : TMessage); // Handle TrayIcon Events
var
  p : TPoint;
begin
  case Msg.Msg of
    WM_USER + 1:       // This is our TrayIcon
    case Msg.lParam of
      WM_RBUTTONDOWN: begin  // User has RightClicked on TrayIcon
         GetCursorPos(p);    // Get Cursor Position
         PopupMenu1.Popup(p.x, p.y);  // Display Menu
      end;
      WM_LBUTTONDBLCLK: RestoreFromTray;  // User has DblClicked on TrayIcon
    end;
  end;
  inherited;  // Continue to do the usual WndProc
end;

procedure TForm1.CreateTrayIcon;
begin
  IconData.cbSize := sizeof(IconData);
  IconData.Wnd := Handle;  // Handle to our Form
  IconData.uID := 100;
  IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  IconData.uCallbackMessage := WM_USER + 1;  // Our Callback ID
  IconData.hIcon := Application.Icon.Handle;  // Use our application Icon
  StrPCopy(IconData.szTip, Application.Title);
end;

procedure TForm1.MinimizeToTray;
begin
  Shell_NotifyIcon(NIM_ADD, @IconData);  // Add Tray Icon here
  Form1.Hide;  // Hide our Form...
  ShowWindow(Application.Handle, SW_HIDE);  // ...and hide application from TaskBar.
end;

procedure TForm1.RestoreFromTray;
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);  // Delete TrayIcon
  ShowWindow(Application.Handle, SW_SHOW);  // Show app on taskbar
  Form1.Show;  // Show Form
  Application.BringToFront;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Button1.Caption = 'DEACTIVATE KEYBOARD' then
  begin
    //deactivate keyboard
    DisableKeyboard;

    //icon changing
    ImageList1.GetIcon(0,Icon);
    IconData.hIcon := Icon.Handle;
    Shell_NotifyIcon(NIM_Modify, @IconData);

    Button1.Caption := 'ACTIVATE KEYBOARD'
  end
  else
  begin
    //activate keyboard
    EnableKeyboard;

    //icon changing
    ImageList1.GetIcon(1,Icon);
    IconData.hIcon := Icon.Handle;
    Shell_NotifyIcon(NIM_Modify, @IconData);
    Button1.Caption := 'DEACTIVATE KEYBOARD'
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //activate keyboard
  EnableKeyboard;

  //delete icon
  Shell_NotifyIcon(NIM_DELETE, @IconData);

  //close program
  Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //form show up in bottom right screen
  Form1.Left := Screen.Width - Form1.Width;
  Form1.Top := Screen.Height - (Form1.Height + 30);
  
  //create systray icon
  createtrayicon;
  Icon := TIcon.Create;
  Shell_NotifyIcon(NIM_ADD, @IconData);
end;

procedure TForm1.MATIKANKEYBOARD1Click(Sender: TObject);
begin
  //disable keyboard
  DisableKeyboard;

  //icon change
  ImageList1.GetIcon(0,Icon);
  IconData.hIcon := Icon.Handle;

  //icon refresh (after changing)
  Shell_NotifyIcon(NIM_Modify, @IconData);

  Button1.Caption := 'ACTIVATE KEYBOARD'
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  //activate keyboard
  EnableKeyboard;

  //icon changing
  ImageList1.GetIcon(1,Icon);
  IconData.hIcon := Icon.Handle;

  //refresh icon
  Shell_NotifyIcon(NIM_Modify, @IconData);

  Button1.Caption := 'DEACTIVATE KEYBOARD'
end;
                                                                     
procedure TForm1.AMPILKAN1Click(Sender: TObject);
begin
  //form show
  RestoreFromTray;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //minimize instead of close
  Action := caNone;
  MinimizeToTray;
end;

procedure TForm1.UTUP1Click(Sender: TObject);
begin
  //goto formdestroy
  FormDestroy(sender);
end;

end.

sorry if my code was messed, i'm a newbie in delphi programming :rolleyes:

reference here, here and of course here :thumbup:

here's the executable file :
[ATTACH]4071[/ATTACH]

and here's the source code
[ATTACH]4072[/ATTACH]
  • 1





Also tagged with one or more of these keywords: delphi

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download