Отключить клавиши при системном Hooke

Code:

{

** Hook Dll - WINHOOK.dll **

WINHOOK.dpr

      |-----WHookInt.pas

** Interface unit ** WHookDef.dpr

 }

{********** Begin WHookDef.dpr **************}

{ Interface unit for use with WINHOOK.DLL }

unit WHookDef;

interface

uses

  Windows;

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

function FreeHook: Boolean; stdcall;

implementation

function SetHook; external 'WINHOOK.DLL' Index 1;

function FreeHook; external 'WINHOOK.DLL' Index 2;

end.

{********** End WHookDef.dpr **************}

Code:

{********** Begin Winhook.dpr **************}

{ The project file }

{ WINHOOK.dll }

library Winhook;

uses

  WHookInt in 'Whookint.pas';

exports

  SetHook index 1,

  FreeHook index 2;

end.

{********** End Winhook.dpr **************}

Code:

{********** Begin WHookInt.pas **************}

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.

{********** End WHookInt.pas **************}

Code:

{ *******************************************}

{ ***************** Demo   ******************}

{ *******************************************}

{

** HostApp.Exe **

HostApp.dpr

      |-----FrmMainU.pas

}

{********** Begin HostApp.dpr **************}

{ Project file }

program HostApp;

uses

  Forms,

  FrmMainU in 'FrmMainU.pas' {FrmMain};

{$R *.RES}

begin

  Application.Initialize;

  Application.CreateForm(TFrmMain, FrmMain);

  Application.Run;

end.

{********** End HostApp.dpr **************}

Code:

{********** Begin FrmMainU.pas **************}

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);

  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;

end.

{********** End FrmMainU.pas **************}