VB.NET HOOK示例

Imports System.Runtime.InteropServices
Imports System.Text
Module Module1

    '定义HOOKPROC委托
    Private Delegate Function HookProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer

    '定义Win32 API函数
    <DllImport("User32.dll", SetLastError:=True)>
    Private Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As HookProc, ByVal hInstance As IntPtr, ByVal threadId As UInteger) As IntPtr
    End Function

    <DllImport("User32.dll")>
    Private Function CallNextHookEx(ByVal hHook As IntPtr, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    End Function

    <DllImport("User32.dll", SetLastError:=True)>
    Private Function UnhookWindowsHookEx(ByVal hHook As IntPtr) As Boolean
    End Function

    <DllImport("Kernel32.dll", SetLastError:=True)>
    Private Function ReadProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal dwSize As Integer, ByRef lpNumberOfBytesRead As Integer) As Boolean
    End Function

    <DllImport("Kernel32.dll", SetLastError:=True)>
    Private Function WriteProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal dwSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Boolean
    End Function

    <DllImport("User32.dll", SetLastError:=True)>
    Private Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
    End Function

    <DllImport("User32.dll", SetLastError:=True)>
    Private Function GetWindowThreadProcessId(ByVal hWnd As IntPtr, ByRef lpdwProcessId As UInteger) As Integer
    End Function

    Private Const WH_KEYBOARD_LL As Integer = 13
    Private Const WM_KEYDOWN As Integer = &H100

    Private hHook As IntPtr
    Private key As Integer
    Private buffer As Byte()
    Private hwnd As IntPtr
    Private processId As UInteger
    Private hProcess As IntPtr
    Private address As IntPtr
    Private value As Byte()
    Sub Main()
        '找到记事本窗口句柄
        hwnd = FindWindow("Notepad", Nothing)
        If hwnd = IntPtr.Zero Then
            Console.WriteLine("Notepad not found.")
            Console.ReadLine()
            Return
        End If
        '获取记事本进程ID
        GetWindowThreadProcessId(hwnd, processId)

        '打开记事本进程
        hProcess = Process.GetProcessById(processId).Handle
        Console.WriteLine(hProcess)
        If hProcess = IntPtr.Zero Then
            Console.WriteLine("Failed to open process.")
            Console.ReadLine()
            Return
        End If

        '创建HookProc实例
        Dim proc As HookProc = New HookProc(AddressOf KeyboardHookCallback)

        '设置Hook
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, proc, IntPtr.Zero, 0)
        If hHook = IntPtr.Zero Then
            Console.WriteLine("Failed to set Hook.")
            Return
        Else
            Console.WriteLine("Hook set.")
        End If

        '循环等待按键
        Do
            Threading.Thread.Sleep(100)
        Loop While key <> 27 '按下ESC键退出循环

        '卸载Hook
        If UnhookWindowsHookEx(hHook) Then
            Console.WriteLine("Hook removed.")
            Console.ReadLine()
        Else
            Console.WriteLine("Failed to remove Hook.")
            Console.ReadLine()
        End If
    End Sub
    'Hook回调函数
    Private Function KeyboardHookCallback(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer

        If nCode = 0 And wParam = WM_KEYDOWN Then '按下按键

            '获取按键值
            key = Marshal.ReadInt32(lParam)

            '读取当前行的内容
            buffer = New Byte(255) {}
            ReadProcessMemory(hProcess, address, buffer, buffer.Length, 0)
            Dim s As String = Encoding.Unicode.GetString(buffer)

            '在新行中输入按键值
            s = s & vbCrLf & key
            value = Encoding.Unicode.GetBytes(s)
            WriteProcessMemory(hProcess, address, value, value.Length, 0)

        End If

        Return CallNextHookEx(hHook, nCode, wParam, lParam)

    End Function
End Module