Search code examples
recursionf#background-processkeystroke

How to keep recording key strokes while program not in focus (in background) in F#?


The code below is part of a bigger ML project, but I want it to run while it's minimised too. How can I do this? I think I need to run it as a windows process to achieve this, but there isn't much information on how to do that in F#. Or is there another way?

let rec f() =
    let c = System.Console.ReadKey().KeyChar
    printfn "%c" c
    f()
f()

Solution

  • From the link in Aaron's comment I decided to give the port a try. This works for me. Note that this could definitely be cleaned up a bit more. I placed the following in a file called NativeHooks.fs

    namespace Native
    
    open System
    
    type HookProc = delegate of int * nativeint * nativeint -> nativeint
    
    module User32 =
        open System.Runtime.InteropServices
    
        [<DllImport("user32.dll", CharSet = CharSet.Auto, SetLastError = true)>]
        extern nativeint SetWindowsHookEx(int idHook, HookProc lpfn, nativeint hMod, uint32 dwThreadId)
    
    
        [<DllImport("user32.dll", CharSet = CharSet.Auto, SetLastError = true)>]
        [<MarshalAs(UnmanagedType.Bool)>]
        extern bool UnhookWindowsHookEx(IntPtr hhk)
    
        [<DllImport("user32.dll", CharSet = CharSet.Auto, SetLastError = true)>]
        extern nativeint CallNextHookEx(nativeint hhk, int nCode, nativeint wParam, nativeint lParam)
    
    module Kernal32 =
        open System.Runtime.InteropServices
    
        [<DllImport("kernel32.dll", CharSet = CharSet.Auto, SetLastError = true)>]
        extern nativeint GetModuleHandle(string lpModuleName)
    

    My Program.fs then looks like so:

    open System
    open System.Runtime.InteropServices
    open System.Windows.Forms
    open System.Diagnostics
    open Native
    
    // Credit: https://blogs.msdn.microsoft.com/toub/2006/05/03/low-level-keyboard-hook-in-c/
    [<Literal>]
    let WH_KEYBOARD_LL = 13
    [<Literal>]
    let WM_KEYDOWN = 0x0100
    let mutable hookId = IntPtr.Zero
    
    [<EntryPoint>]
    let main argv =
    
        let sprintKey k = KeysConverter().ConvertToString(k)
    
        // installs a hook from WH_KEYBOARD_LL events to callback. 
        // See: https://msdn.microsoft.com/en-us/library/windows/desktop/ms644990(v=vs.85).aspx
        let setHook hookProc : nativeint =
            using (Process.GetCurrentProcess()) (fun curProcess ->
            using (curProcess.MainModule) ( fun curModule ->
                let handle = Kernal32.GetModuleHandle(curModule.ModuleName)
                User32.SetWindowsHookEx(WH_KEYBOARD_LL, hookProc, handle, (0 |> uint32))
            ))
    
        let callback = fun nCode wParam lParam ->
            if (nCode >= 0 && wParam = (WM_KEYDOWN |> nativeint)) then
                let vkCode = Marshal.ReadInt32(lParam)
                printfn "%s" (sprintKey vkCode)
            User32.CallNextHookEx(hookId, nCode, wParam, lParam)
    
        hookId <- setHook(new HookProc(callback))
        Application.Run()
        User32.UnhookWindowsHookEx(hookId) |> ignore    
        0
    

    My fsproj file:

    <Project Sdk="Microsoft.NET.Sdk">
    
      <PropertyGroup>
        <OutputType>Exe</OutputType>
        <TargetFramework>net461</TargetFramework>
      </PropertyGroup>
    
      <ItemGroup>
        <Compile Include="NativeHooks.fs" />
        <Compile Include="Program.fs" />
      </ItemGroup>
    
      <ItemGroup>
        <PackageReference Update="System.ValueTuple" Version="4.5.0" />
      </ItemGroup>
    
      <ItemGroup>
        <Reference Include="System.Windows.Forms" />
      </ItemGroup>
    
    </Project>
    

    Original solution in C#

    Windows Hook documentation