• R/O
  • SSH
  • HTTPS

Tags
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#windowsobjective-ccocoa誰得qtpythonphprubygameguibathyscaphec計画中(planning stage)翻訳omegatframeworktwitterdomtestvb.netdirectxゲームエンジンbtronarduinopreviewer

テンキー押下でWin32アプリのウインドウをキャプチャする。ただしUWPアプリはキャプチャできない。


File Info

Rev. 21
Size 3,590 bytes
Time 2017-11-06 23:30:19
Author hor931101jp
Log Message

(empty log message)

Content

Imports System.Runtime.InteropServices
Public Class KeyboardHooker

    Const WM_KEYDOWN As Integer = &H100
    Const WM_KEYUP As Integer = &H101

    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)
        Dim vkCode As Integer = hookStruct.vkCode

        If wParam = New IntPtr(WM_KEYDOWN) Then
            vkCode = hookStruct.vkCode
            If vkCode >= 96 And 111 >= vkCode Then
                If FormMain.CaptureProcess = False Then
                    FormMain.CaptureProcess = True
                    ClassMyCommon.KeyCode = vkCode
                    '最初は RaiseEvent を使ってコーティングしてたがここのスループットが遅くなるのでワンショットタイマにした
                    FormMain.Timer1.Enabled = True
                End If
                Return 1
            End If
        End If

        If wParam = New IntPtr(WM_KEYUP) Then
            vkCode = hookStruct.vkCode
            If vkCode >= 96 And 111 >= vkCode Then
                Return 1
            End If
        End If

        Return CallNextHookEx(hHook, nCode, wParam, lParam)
    End Function

    Public Sub Dispose()
        Dim ret As Boolean = UnhookWindowsHookEx(hHook)
        If ret.Equals(False) Then
        End If
    End Sub
End Class