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

独自空忆成欢 提交于 2020-01-06 07:10:34

问题


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()

回答1:


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



来源:https://stackoverflow.com/questions/51621568/how-to-keep-recording-key-strokes-while-program-not-in-focus-in-background-in

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!