VB.NETでキーフック

デザインパターンの学習は順調である。

いまのところそれについては語るネタがないので、今回は以前よく作っていたVB.NETのネタ。
バージョンはWindows 7標準の.Net 3.5.1以上をターゲットにしている。
Excel VBAに貼り付けても動かないので注意。
C#のサンプルを探している人は、SharpDevelopを使うとConvertできる。(Visual Studioは詳しくないので不明)

これは半年ほど前に作っていたツールでKey hookが必要になり作成したクラス。
普通はアクティブなアプリだけがキー入力を受け取るが、これを使うと自作アプリでいつでもキー入力を受け取ることができる。

悪用すればキーロガーになるし、善用すれば非常に便利なことができる。
たとえば以前作成したソフトで、Ctrlキーを3回押すとメイン画面を表示させるランチャー的な使い方をした。また、Ctrl+CやCtrl+Vを読み取り、メモ帳などでコピーした内容を順番にキューにため込んで順番に貼り付けするようなアプリも作成した。
これでウインドウ間の往復が無くなるので当時の業務にはすこぶる便利だった。

さて、コードを紹介しておく。
これがKeyboardHooker.vbのコード。
使う方は深く考えなくて良い。ただKeyboardHooker.vbを作ってそこに貼り付ければ動くはず。

Imports System.Runtime.InteropServices
Public Class KeyboardHooker
	
	Const WM_KEYDOWN As Integer = &H0100
	Const WM_KEYUP As Integer = &H0101
	
    Public Sub New()
        hookproc = AddressOf KeybordHookProc
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, hookproc, GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)
        If hHook.Equals(0) Then
            MsgBox("SetWindowsHookEx Failed")
        End If
    End Sub
    
    Dim WH_KEYBOARD_LL As Integer = 13
    Shared hHook As Integer = 0

    Private hookproc As CallBack

    Public Delegate Function CallBack( _
        ByVal nCode As Integer, _
        ByVal wParam As IntPtr, _
        ByVal lParam As IntPtr) As Integer

    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
     Public Overloads Shared Function SetWindowsHookEx _
          (ByVal idHook As Integer, ByVal HookProc As CallBack, _
    ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
     Public Overloads Shared Function GetModuleHandle _
    (ByVal lpModuleName As String) As IntPtr
    End Function

    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
     Public Overloads Shared Function CallNextHookEx _
          (ByVal idHook As Integer, ByVal nCode As Integer, _
    ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    End Function

    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
         Public Overloads Shared Function UnhookWindowsHookEx _
    (ByVal idHook As Integer) As Boolean
    End Function

    <StructLayout(LayoutKind.Sequential)> Public Structure KeyboardLLHookStruct
        Public vkCode As Integer
        Public scanCode As Integer
        Public flags As Integer
        Public time As Integer
        Public dwExtraInfo As Integer
    End Structure
    
    
    Public Function KeybordHookProc( _
        ByVal nCode As Integer, _
        ByVal wParam As IntPtr, _
        ByVal lParam As IntPtr) As Integer

        If (nCode < 0) Then
            Return CallNextHookEx(hHook, nCode, wParam, lParam)
        End If

        Dim hookStruct As New KeyboardLLHookStruct()
        hookStruct = CType(Marshal.PtrToStructure(lParam, hookStruct.GetType()), KeyboardLLHookStruct)
        
        If wParam = New IntPtr(WM_KEYDOWN) Then
        	Dim e As New KeyBoardHookerEventArgs
        	e.vkCode = hookStruct.vkCode
        	RaiseEvent KeyDown(Me, e)
	        Return 0
        End If
        
        If wParam = New IntPtr(WM_KEYUP) Then
        	Dim e As New KeyBoardHookerEventArgs
        	e.vkCode = hookStruct.vkCode
        	RaiseEvent KeyUp(Me, e)
	        Return 0
		End If

        Return CallNextHookEx(hHook, nCode, wParam, lParam)
    End Function
    
    Public Event KeyDown(ByVal sender As Object,ByVal EventArgs As KeyBoardHookerEventArgs)
    Public Event KeyUp(ByVal sender As Object,ByVal EventArgs As KeyBoardHookerEventArgs)
    
    Public Sub Dispose()
		Dim ret As Boolean = UnhookWindowsHookEx(hHook)
        If ret.Equals(False) Then
        End If
    End Sub
End Class


Public Class KeyBoardHookerEventArgs
	Inherits EventArgs
	
    Dim _vkCode As Integer
    
    Public Property vkCode() As Integer
        Get
            Return _vkCode
        End Get
        Set(ByVal value As Integer)
            _vkCode = value
        End Set
    End Property

End Class

そして、これがMainForm.vbのサンプルコード。
こちらはlabel1がフォームに貼り付けられている前提である。
また、これはそのまま貼り付けではなく、KeyboardHookerが使われている部分だけを参考にして欲しい。

Public Partial Class MainForm
    Public Sub New()
        ' The Me.InitializeComponent call is required for Windows Forms designer support.
        Me.InitializeComponent()
        
        '
        ' TODO : Add constructor code after InitializeComponents
        '
    End Sub
    
	WithEvents KeyboardHooker1 As New KeyboardHooker
	Sub KeybordHooker1_KeyDown(sender As Object, e As KeyBoardHookerEventArgs) Handles KeyboardHooker1.KeyDown	
	    label1.Text = CStr(e.vkCode)
	    Select Case Control.ModifierKeys
			Case Keys.Control
				Select Case e.vkCode
					Case Keys.Insert, Keys.C
						label1.Text = "Copy"
					Case Keys.V
						label1.Text = "Paste"
					Case Keys.X
						label1.Text = "Cut"
				    Case Else
						
				End Select	
			Case Keys.Shift
				If e.vkCode = Keys.Insert Then
					label1.Text = "Paste"
				End If
		    Case Else
		End Select
	End Sub
End Class

まぁ、よく分からないけど貼り付けて動かしてみるというのも、一つの学習法ではあるので、止めはしないが、たぶんエラーがでる。