Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年01月24日] [更新 2017年04月21日]　Delphi サンプルプログラム集
   
250_システム関係キーを無効化する
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
250_SystemKeyHook.zip　[2,197 KB]　2017年04月21日版 (EXE 同梱)



  • 2010年08月21日
  • メッセージを表示するサンプルを追加してコード整備
  • 2010年08月24日
  • DLL にしないサンプルコードを追加
  • 2015年09月26日
  • DLL を使用しないローレベルのキーフックのサンプルだけとした
  • Windows 7 U64(SP1) + Delphi XE(UP1) Pro で動作確認



01_システム関係キーを無効化


グローバルキーフックを使用して，システム関係の以下のキー操作を無効にするサンプルです．動作はシステム全体に有効となっていて，実行開始時に無効化するようになっています．
ローカルフックにすると自アプリだけの無効化となります．

  • [ALT] + [TAB]　タスクの切換え
  • [VK_APPS]　　  アプリケーションキー(メニューキー)
  • [VK_LWIN]　　  左のウィンドウズ(スタートメニュー)キー
  • [VK_RWIN]　　  右のウィンドウズ(スタートメニュー)キー

低レベルのキーボードフックである WH_KEYBOARD_LL を使用しています．このフックは DLL にしなくてもグローバルフックを実現できます．

システム関係のキー操作に，[Ctrl] + [Alt] + [Delete] と [Ctrl] + [Shift] + [ESC] がありますが，これらのキー操作はグローバルフックでも無効にはできません．



図1
設計時画面
  • [Stop KeyHook] で通常の動作に戻る

リスト1
グローバルキーフックを使用して，システム関係キーを無効化 
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
 private
   { Private 宣言 }
 public
   { Public 宣言 }
 end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
//  低レベルキーフックのキー情報構造体と定数
//-----------------------------------------------------------------------------
const
  LLKHF_EXTENDED = KF_EXTENDED shr 8;
  LLKHF_INJECTED = $00000010;
  LLKHF_ALTDOWN  = KF_ALTDOWN shr 8;
  LLKHF_UP       = KF_UP shr 8;
  LLMHF_INJECTED = $00000001;

type
  LPKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  tagKBDLLHOOKSTRUCT = record
    vkCode      : DWORD;
    scanCode    : DWORD;
    flags       : DWORD;
    time        : DWORD;
    dwExtraInfo : ULONG_PTR;
  end;
  KBDLLHOOKSTRUCT  = tagKBDLLHOOKSTRUCT;
  TKbDllHookStruct = KBDLLHOOKSTRUCT;
  PKbDllHookStruct = LPKBDLLHOOKSTRUCT;

var
  KeyHookHandle : HHOOK=0;

//-----------------------------------------------------------------------------
//  フックのコールバック関数
//
//  [ALT]+[TAB] タスク切換え
//  [VK_APPS]   アプリケーションキー
//  [VK_LWIN]   左側のウィンドウズ(メニュー)キー
//  [VK_RWIN]   右側のウィンドウズ(メニュー)キー
//
//  の本来動作を無効(Result := 1 0以外)にする
//-----------------------------------------------------------------------------
function LowLevelKeyProc(Code:Integer; wPar:wParam; lPar:LParam): LRESULT; stdcall;
var
  Lkbdll : PKBDLLHOOKSTRUCT;
begin
  Result := 0;

  if Code < 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
    exit;
  end;

  Lkbdll := Pointer(lPar);
  if Code = HC_ACTION then begin

    //キーが[VK_TAB]+[ALT]の時はResult := 1にしてここで処理終了
    if (Lkbdll.vkCode in [VK_TAB]) and
       ((Lkbdll.flags and (LLKHF_ALTDOWN) <> 0)) then begin
      Result := 1;
    end;

    //[VK_XXX]のリストのキーの時はResult := 1にしてメッセージ処理終了
    if (Lkbdll.vkCode in [VK_APPS, VK_LWIN, VK_RWIN]) then begin
      Result := 1;
    end;
  end;

  if Result = 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
  end;
end;

//=============================================================================
//  フック開始
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  終了時にはキーフックを解除
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Button2Click(nil);
end;

//=============================================================================
//  キーフック開始．フック内で指定キーの本来動作を無効にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if KeyHookHandle = 0 then begin
    KeyHookHandle := SetWindowsHookEx(WH_KEYBOARD_LL,
                                      @LowLevelKeyProc,
                                      HInstance,
                                      0);
  end;
end;

//=============================================================================
//  キーフックを解除して通常の動作に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if KeyHookHandle <> 0 then begin
    UnhookWindowsHookEx(KeyHookHandle);
    KeyHookHandle := 0;
  end;
end;

end.



02_システム関係キーを無効化  -  メッセージを表示


上のサンプルでは，無効にしたキーを押すと，もちろん何も起こりません．これは通常のウィンドウズの動作と違っています．ユーザを惑わせないためには，情報表示のダイアログを表示するといい場合もあります．

このサンプルでは，指定した無効キーを押下すると，ダイアログを表示するようにしてみました．
ダイアログを表示すると，フォーカスを持つウインドウが，本サンプルのウィンドウになってしまいます．そこで，ダイアログを閉じたら直前に入力フォーカスがあったウィンドウを最前面に表示するようにしています．この処理に AttachThreadInput 関数を使用した，スレッドアタッチという手法を用いています．



図2
実行時の画面
  • 無効化したキーを押すと，このダイアログを表示する
  • [Stop KeyHook] で通常の動作に戻る

リスト2
グローバルキーフックを使用して，システム関係キーを無効化
無効化したキーを押下したらメッセージを表示 
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
 private
   { Private 宣言 }
   procedure WMAppMessage(var Message: TMessage); message WM_APP+100;
 public
   { Public 宣言 }
 end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
//  低レベルキーフックのキー情報構造体と定数
//-----------------------------------------------------------------------------
const
  LLKHF_EXTENDED = KF_EXTENDED shr 8;
  LLKHF_INJECTED = $00000010;
  LLKHF_ALTDOWN  = KF_ALTDOWN shr 8;
  LLKHF_UP       = KF_UP shr 8;
  LLMHF_INJECTED = $00000001;

type
  LPKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  tagKBDLLHOOKSTRUCT = record
    vkCode      : DWORD;
    scanCode    : DWORD;
    flags       : DWORD;
    time        : DWORD;
    dwExtraInfo : ULONG_PTR;
  end;
  KBDLLHOOKSTRUCT  = tagKBDLLHOOKSTRUCT;
  TKbDllHookStruct = KBDLLHOOKSTRUCT;
  PKbDllHookStruct = LPKBDLLHOOKSTRUCT;

var
  KeyHookHandle : HHOOK=0;

//-----------------------------------------------------------------------------
//  フックのコールバック関数
//
//  [ALT]+[TAB] タスク切換え
//  [VK_APPS]   アプリケーションキー
//  [VK_LWIN]   左側のウィンドウズ(メニュー)キー
//  [VK_RWIN]   右側のウィンドウズ(メニュー)キー
//
//  の本来動作を無効(Result := 1 0以外)にする
//-----------------------------------------------------------------------------
function LowLevelKeyProc(Code:Integer; wPar:wParam; lPar:LParam): LRESULT; stdcall;
var
  Lkbdll : PKBDLLHOOKSTRUCT;
begin
  Result := 0;

  if Code < 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
    exit;
  end;

  Lkbdll := Pointer(lPar);
  if Code = HC_ACTION then begin

    //キーが[VK_TAB]+[ALT]の時はResult := 1にしてここで処理終了
    if (Lkbdll.vkCode in [VK_TAB]) and
       ((Lkbdll.flags and (LLKHF_ALTDOWN) <> 0)) then begin
      Result := 1;
    end;

    //[VK_XXX]のリストのキーの時はResult := 1にしてメッセージ処理終了
    if (Lkbdll.vkCode in [VK_APPS, VK_LWIN, VK_RWIN]) then begin
      Result := 1;
    end;

    if Result = 1 then begin
      PostMessage(Form1.Handle, WM_APP+100, wPar, lPar);
    end;
  end;

  if Result = 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
  end;
end;

//=============================================================================
//  フック開始
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  終了時にはキーフックを解除
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Button2Click(nil);
end;

//=============================================================================
//  キーフック開始．フック内で指定キーの本来動作を無効にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if KeyHookHandle = 0 then begin
    KeyHookHandle := SetWindowsHookEx(WH_KEYBOARD_LL,
                                      @LowLevelKeyProc,
                                      HInstance,
                                      0);
  end;
end;

//=============================================================================
//  キーフックを解除して通常の動作に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if KeyHookHandle <> 0 then begin
    UnhookWindowsHookEx(KeyHookHandle);
    KeyHookHandle := 0;
  end;
end;

{$WRITEABLECONST ON}
//-----------------------------------------------------------------------------
//  フックのコールバック関数から送られてきたメッセージの処理
//
//  AttachThreadInputを使用しているのはグローバルホットキーを押下した時に
//  フォアグランドだったウィンドウをフォアグランドにするため
//-----------------------------------------------------------------------------
procedure TForm1.WMAppMessage(var Message: TMessage);
const
  LShowFlag : Boolean = False;
var
  LForegroundWnd : HWND;
  LThreadForeID  : Cardinal;
  LThreadSelfID  : Cardinal;
  LMsgText       : String;
begin
  //以下の処理実行中はフックからのメッセージ処理はしないためのフラグ
  if LShowFlag = False then begin
    LShowFlag := True;

    //現在の前面ウィンドウのバンドル取得
    LForegroundWnd := GetForegroundWindow;
    if LForegroundWnd <> Handle then begin
      //そのスレッドIDを取得
      LThreadForeID := GetWindowThreadProcessId(LForegroundWnd);
      //前面表示するウィンドウのスレッドIDを取得
      LThreadSelfID := GetCurrentThreadId;
      //スレッドのアタッチ
      AttachThreadInput(LThreadSelfID, LThreadForeID, True);
      //アタッチしたハンドルのウィドウを前面に
      SetForegroundWindow(Handle);
      //終了したらアタッチを切り離す
      AttachThreadInput(LThreadSelfID, LThreadForeID, False);
    end;

    LMsgText := '申し訳ありませんが、'+ sLineBreak
              + 'このキーはご利用になれません．';
    MessageBox(Handle, PChar(LMsgText), '情報', MB_TOPMOST or MB_ICONINFORMATION);

    //直前のアプリにフォーカスを戻す
    SetForegroundWindow(LForegroundWnd);
    LShowFlag := False;
  end;
end;
{$WRITEABLECONST OFF}

end.



03_[ PrintScreen ] と [ Alt ] + [ PrintScreen ] キーを無効にする


スクリーンショットに使用する [PrintScreen] キーと [Alt] + [PrintScreen] キーであれば，グローバルフックを使用しなくても無効にすることができます．
これらのキーを無効にするには，これらのキーをグローバルホットキーとして登録します．そうすると新しいホットキーが有効になり，前のホットキーが無効となります．グローバルホットキーの登録を解除すれば元のホットキーが有効になります．


図3
設計時の画面
図4
[PrintScreen] が無効状態で [PrintScreen] キーを押した場合

リスト3
[PrintScreen] と [Alt] + [PrintScreen] キーを無効にする		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ApplicationEvents1: TApplicationEvents;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Clipbrd;

{$R *.dfm}

const
  FHotKeyID1 : Integer = $0001;
  FHotKeyID2 : Integer = $0002;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Button2Click(nil);
end;

//=============================================================================
//  [PrintScreen]と[Alt]+[PriintScreen]をホットキーとして登録する
//  このキーの押下のメッセージはこのアプリが受け取るようになる
//
//  Application.Handleはこのフォームのハンドルでも動作する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.Clear;

  RegisterHotKey(Application.Handle, FHotKeyID1, 0, VK_SNAPSHOT);
  RegisterHotKey(Application.Handle, FHotKeyID2, MOD_ALT, VK_SNAPSHOT);
end;

//=============================================================================
//  [PrintScreen]と[Alt]+[PriintScreen]のホットキー登録を解除する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  UnregisterHotKey(Application.Handle, FHotKeyID1);
  UnregisterHotKey(Application.Handle, FHotKeyID2);
end;

//=============================================================================
//  ApplicationEvents1コンポのOnMessageイベント処理
//  [PrintScreen]と[Alt]+[PriintScreen]のメッセージを処理する
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  LText : string;
begin
  if (Msg.message = WM_HOTKEY) and (HiWord(Msg.lParam) = VK_SNAPSHOT) then begin
    if (Msg.wParam = FHotKeyID1) or (Msg.wParam = FHotKeyID2) then begin

      LText := 'スクリーンショットの機能は無効です';
      MessageBox(Handle, PChar(LText), '情報', MB_TOPMOST or MB_ICONINFORMATION);
    end;
  end;
end;

end.



04_WM_HOTKEY メッセージでキーの押下を検出する場合


前項のサンプルでは TApplicationEvents.OnMessage でホットキーの押下を検出しています．
TApplicationEvents.OnMessage では，アプリケーションで発生するメッセージのほとんどのメッセージを補足することができますが，前項のサンプルで RegisterHotKey の登録元を自分のフォームにすれば専用のメッセージである WM_HOTKEY でホットキーの押下を検出できます．その例です．

本サンプルでは GlobalAddAtom を使用してグローバルホットキーの ID 値を取得しています． GlobalAddAtom を使用すると，グローバルホットキーの ID を自動的に生成してくれます．実際のアプリケーションでは GlobalAddAtom を使用した方がいいでしょう．


リスト4
[PrintScreen] と [Alt] + [PrintScreen] キーを無効にする
WM_HOTKEY メッセージでキーの押下を検出する例		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    FHotKeyID1 : Integer;
    FHotKeyID2 : Integer;
  protected
    procedure WMHotKey(var Message: TMessage); message WM_HOTKEY;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Button2Click(nil);
end;

//=============================================================================
//  [PrintScreen]と[Alt]+[PriintScreen]をホットキーとして登録する
//  このキーの押下のメッセージはこのフォームが受け取るようになる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.Clear;

  //ホットキーをグローバルアトムのテーブルに追加
  //文字列を識別する一意の値をホットキーIDとして取得
  FHotKeyID1 := GlobalAddAtom('MySnapshotKey1');
  FHotKeyID2 := GlobalAddAtom('MySnapshotKey2');

  RegisterHotKey(Handle, FHotKeyID1, 0, VK_SNAPSHOT);
  RegisterHotKey(Handle, FHotKeyID2, MOD_ALT, VK_SNAPSHOT);
end;

//=============================================================================
//  [PrintScreen]と[Alt]+[PriintScreen]のホットキー登録を解除する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  UnregisterHotKey(Handle, FHotKeyID1);
  UnregisterHotKey(Handle, FHotKeyID2);

  //アトムに関連付けられている文字列を、アトムテーブルから削除
  GlobalDeleteAtom(FHotKeyID1);
  GlobalDeleteAtom(FHotKeyID2);
end;

//-----------------------------------------------------------------------------
//  WM_HOTKEYメッセージ処理
//
//  Messageの型はデフォルトではTWMHotKeyであるがTMessageに変更している
//  TMessageにするとWindows APIの説明がそのまま使用可能
//-----------------------------------------------------------------------------
procedure TForm1.WMHotKey(var Message: TMessage);
var
  LText : string;
begin
  if (Message.WParam = FHotKeyID1) or (Message.WParam = FHotKeyID2) then begin
    LText := 'スクリーンショットの機能は無効です';
    MessageBox(Handle, PChar(LText), '情報', MB_TOPMOST or MB_ICONINFORMATION);
  end;
end;

end.