KeyboardWorker By CorrM

Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Reflection
Imports System.Globalization

Module Module1
    Dim WithEvents kbHook As New KeyboardWorker

    Private Sub kbHook_KeyDown(ByVal xKey As System.Windows.Forms.Keys) Handles kbHook.KeyDown
        ' To Change Current Culture In this program (it's important) (Maybe in console app only :D not tested in forms app)
        InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(KeyboardWorker.GetCurrentCulture())

        ' Just For Test
        Debug.Write(kbHook.ToUnicode(xKey))
    End Sub

    Sub Main()
        ' Start Hook
        kbHook.Start()

        ' Msg Loop Don't Remove, You Can put this code in thread, (Console/Forms app must use this loop)
        Dim msg As KeyboardWorker.WinMSG
        While KeyboardWorker.GetMessage(msg, IntPtr.Zero, 0, 0) <> 0 : End While
    End Sub

End Module

Public Class KeyboardWorker
    Structure WinMSG
        Dim hwnd As Long
        Dim message As Long
        Dim wParam As Long
        Dim lParam As Long
        Dim time As Long
        Dim pt As Point
    End Structure

    Public Enum MapVirtualKeyMapTypes As UInt32
        ''' <summary>uCode is a virtual-key code and is translated into a scan code.
        ''' If it is a virtual-key code that does not distinguish between left- and
        ''' right-hand keys, the left-hand scan code is returned.
        ''' If there is no translation, the function returns 0.
        ''' </summary>
        ''' <remarks></remarks>
        MAPVK_VK_TO_VSC = &H0

        ''' <summary>uCode is a scan code and is translated into a virtual-key code that
        ''' does not distinguish between left- and right-hand keys. If there is no
        ''' translation, the function returns 0.
        ''' </summary>
        ''' <remarks></remarks>
        MAPVK_VSC_TO_VK = &H1

        ''' <summary>uCode is a virtual-key code and is translated into an unshifted
        ''' character value in the low-order word of the return value. Dead keys (diacritics)
        ''' are indicated by setting the top bit of the return value. If there is no
        ''' translation, the function returns 0.
        ''' </summary>
        ''' <remarks></remarks>
        MAPVK_VK_TO_CHAR = &H2

        ''' <summary>Windows NT/2000/XP: uCode is a scan code and is translated into a
        ''' virtual-key code that distinguishes between left- and right-hand keys. If
        ''' there is no translation, the function returns 0.
        ''' </summary>
        ''' <remarks></remarks>
        MAPVK_VSC_TO_VK_EX = &H3

        ''' <summary>Not currently documented
        ''' </summary>
        ''' <remarks></remarks>
        MAPVK_VK_TO_VSC_EX = &H4
    End Enum

    <StructLayout(LayoutKind.Sequential)>
    Private Structure KBDLLHOOKSTRUCT
        Public vkCode As UInt32
        Public scanCode As UInt32
        Public flags As KBDLLHOOKSTRUCTFlags
        Public time As UInt32
        Public dwExtraInfo As UIntPtr
    End Structure

    <Flags()>
    Private Enum KBDLLHOOKSTRUCTFlags As UInt32
        LLKHF_EXTENDED = &H1
        LLKHF_INJECTED = &H10
        LLKHF_ALTDOWN = &H20
        LLKHF_UP = &H80
    End Enum

    Public Shared Event KeyDown(ByVal Key As Keys)
    Public Shared Event KeyUp(ByVal Key As Keys)

    Private Const WH_KEYBOARD_LL As Integer = 13
    Private Const HC_ACTION As Integer = 0
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    Private Const WM_SYSKEYDOWN = &H104
    Private Const WM_SYSKEYUP = &H105

    Private KBDLLHookProcDelegate As KBDLLHookProc = New KBDLLHookProc(AddressOf KeyboardProc)
    Private HHookID As IntPtr = IntPtr.Zero

    Private Delegate Function KBDLLHookProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer


    <DllImport("user32.dll")>
    Public Shared Function DispatchMessage(ByRef lpmsg As WinMSG) As IntPtr
    End Function

    <DllImport("user32.dll")>
    Public Shared Function GetMessage(
     ByRef lpMsg As WinMSG,
     ByVal hWnd As IntPtr,
     ByVal wMsgFilterMin As UInteger,
     ByVal wMsgFilterMax As UInteger) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    <DllImport("user32.dll")>
    Public Shared Function TranslateMessage(ByRef lpMsg As WinMSG) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

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

    <DllImport("kernel32.dll")> _
    Public Shared Function GetCurrentThreadId() As UInteger
    End Function

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

    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Private 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)>
    Private Overloads Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
    End Function

    <DllImport("USER32.DLL", CharSet:=CharSet.Unicode)> _
    Public Shared Function ToUnicode(virtualKey As UInteger, scanCode As UInteger, keyStates As Byte(), <MarshalAs(UnmanagedType.LPArray)> <Out> chars As Char(), charMaxCount As Integer, flags As UInteger) As Integer
    End Function

    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function GetForegroundWindow() As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, ByRef lpdwProcessId As IntPtr) As UInteger
    End Function

    <DllImport("user32.dll")> _
    Private Shared Function GetKeyboardLayout(idThread As UInteger) As IntPtr
    End Function

    <DllImport("User32.dll", SetLastError:=False, CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)> _
    Public Shared Function MapVirtualKey(ByVal uCode As UInt32, ByVal uMapType As MapVirtualKeyMapTypes) As UInt32
    End Function

    Public Function ToUnicode(xKey As Windows.Forms.Keys) As Char
        Dim keyStates(255) As Byte
        Dim chars(1) As Char

        ToUnicode(xKey,
                  MapVirtualKey(xKey, MapVirtualKeyMapTypes.MAPVK_VK_TO_VSC),
                  keyStates,
                  chars,
                  chars.Length,
                  0)

        Return chars(0)
    End Function

    Public Shared Function GetCurrentCulture() As CultureInfo
        Dim hKL As IntPtr = GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow(), IntPtr.Zero))
        Return New System.Globalization.CultureInfo(hKL.ToInt32() And &HFFFF)
    End Function


    Private Function KeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
        If (nCode = HC_ACTION) Then
            Dim struct As KBDLLHOOKSTRUCT
            Select Case wParam
                Case WM_KEYDOWN, WM_SYSKEYDOWN
                    struct = CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT)

                    Dim xKey As Keys = struct.vkCode
                    RaiseEvent KeyDown(xKey)

                    'Case WM_KEYUP, WM_SYSKEYUP
                    '    Dim xKey As Keys = CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT).vkCode
                    '    RaiseEvent KeyUp(xKey)
            End Select
        End If

        Return CallNextHookEx(IntPtr.Zero, nCode, wParam, lParam)
    End Function

    Public Sub Start()
        HHookID = SetWindowsHookEx(WH_KEYBOARD_LL, KBDLLHookProcDelegate, GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)
        If HHookID = IntPtr.Zero Then
            Throw New Exception("Could not set keyboard hook")
        End If
    End Sub

    Protected Overrides Sub Finalize()
        If Not HHookID = IntPtr.Zero Then
            UnhookWindowsHookEx(HHookID)
        End If
        MyBase.Finalize()
    End Sub

End Class