VB.NET捕获已运行CMD窗口中显示的文本

我太懂这种尴尬了——手里有个全天跑的CMD程序，没法重启它来搞输出重定向，用SendKeys全选复制虽然能凑活，但要么容易掉链子，要么还得处理剪贴板的问题。下面给你两个靠谱的VB实现方案，按需选就行：

方案一：改进版SendKeys（简单易上手） #

这个方案是在你现有思路上优化，先确保CMD窗口被激活，再执行全选复制，最后从剪贴板取内容。优点是代码少，容易理解，适合对稳定性要求不是特别高的场景。

Imports System.Windows.Forms
Imports System.Diagnostics

' 引入Windows API用于查找和激活窗口
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As IntPtr) As Boolean

Sub CaptureCmdTextWithSendKeys()
    ' 找到目标CMD窗口：ConsoleWindowClass是CMD窗口的类名，第二个参数可以填窗口标题（不确定就传vbNullString）
    Dim cmdHandle As IntPtr = FindWindow("ConsoleWindowClass", vbNullString)
    
    If cmdHandle <> IntPtr.Zero Then
        ' 先把CMD窗口调到前台激活
        SetForegroundWindow(cmdHandle)
        ' 执行全选（Ctrl+A）+ 复制（Ctrl+C），加个小延迟确保操作完成
        SendKeys.SendWait("^a")
        System.Threading.Thread.Sleep(100)
        SendKeys.SendWait("^c")
        System.Threading.Thread.Sleep(100)
        
        ' 从剪贴板读取内容
        Dim cmdContent As String = Clipboard.GetText()
        
        ' 这里可以把内容存文件或者做其他处理
        My.Computer.FileSystem.WriteAllText("C:\cmd_capture.txt", cmdContent, False)
        MsgBox("捕获完成！内容已保存到C:\cmd_capture.txt")
    Else
        MsgBox("没找到运行中的CMD窗口哦！")
    End If
End Sub

注意点：

• 如果有多个CMD窗口在跑，最好指定窗口标题来精准定位，避免抓错
• 这个方法依赖窗口焦点，如果CMD窗口被最小化或者被其他窗口完全遮挡，可能会失效
• 会覆盖剪贴板原有内容，要是在意这个，可以先备份剪贴板内容，用完再恢复

方案二：用Windows API直接读取控制台缓冲区（稳定无干扰） #

这个方案是硬核操作——直接读取CMD进程的控制台缓冲区，完全不需要激活窗口，也不碰剪贴板，稳定性拉满，适合需要长期自动捕获的场景。

完整VB代码实现： #

Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Diagnostics

' 定义需要用到的Windows API和结构体
Private Const STD_OUTPUT_HANDLE As Integer = -11
Private Const PROCESS_QUERY_INFORMATION As Integer = &H400
Private Const PROCESS_DUP_HANDLE As Integer = &H10
Private Const DUPLICATE_SAME_ACCESS As Integer = &H2

Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Integer) As IntPtr
Private Declare Function GetConsoleScreenBufferInfo Lib "kernel32" (ByVal hConsoleOutput As IntPtr, ByRef lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Boolean
Private Declare Function ReadConsoleOutputCharacter Lib "kernel32" Alias "ReadConsoleOutputCharacterA" (ByVal hConsoleOutput As IntPtr, ByVal lpCharacter As StringBuilder, ByVal nLength As Integer, ByVal dwReadCoord As COORD, ByRef lpNumberOfCharsRead As Integer) As Boolean
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Boolean, ByVal dwProcessId As Integer) As IntPtr
Private Declare Function DuplicateHandle Lib "kernel32" (ByVal hSourceProcessHandle As IntPtr, ByVal hSourceHandle As IntPtr, ByVal hTargetProcessHandle As IntPtr, ByRef lpTargetHandle As IntPtr, ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Boolean, ByVal dwOptions As Integer) As Boolean
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As IntPtr) As Boolean

<StructLayout(LayoutKind.Sequential)>
Private Structure COORD
    Public X As Short
    Public Y As Short
End Structure

<StructLayout(LayoutKind.Sequential)>
Private Structure CONSOLE_SCREEN_BUFFER_INFO
    Public dwSize As COORD
    Public dwCursorPosition As COORD
    Public wAttributes As Integer
    Public srWindow As SMALL_RECT
    Public dwMaximumWindowSize As COORD
End Structure

<StructLayout(LayoutKind.Sequential)>
Private Structure SMALL_RECT
    Public Left As Short
    Public Top As Short
    Public Right As Short
    Public Bottom As Short
End Structure

Sub CaptureCmdBufferDirectly()
    ' 找到目标CMD进程（这里取第一个，你可以根据进程ID或标题筛选）
    Dim cmdProcesses As Process() = Process.GetProcessesByName("cmd")
    If cmdProcesses.Length = 0 Then
        MsgBox("未找到运行中的CMD进程！")
        Return
    End If
    
    Dim targetProcess As Process = cmdProcesses(0)
    Dim hSourceProcess As IntPtr = IntPtr.Zero
    Dim hTargetConsole As IntPtr = IntPtr.Zero
    
    Try
        ' 打开目标进程，获取必要权限
        hSourceProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_DUP_HANDLE, False, targetProcess.Id)
        If hSourceProcess = IntPtr.Zero Then
            MsgBox("无法打开目标进程，权限不足！")
            Return
        End If
        
        ' 复制目标进程的标准输出句柄到当前进程
        Dim success As Boolean = DuplicateHandle(hSourceProcess, targetProcess.Handle, Process.GetCurrentProcess().Handle, hTargetConsole, 0, False, DUPLICATE_SAME_ACCESS)
        If Not success Then
            MsgBox("无法复制控制台句柄！")
            Return
        End If
        
        ' 获取控制台缓冲区信息
        Dim csbi As CONSOLE_SCREEN_BUFFER_INFO = New CONSOLE_SCREEN_BUFFER_INFO()
        GetConsoleScreenBufferInfo(hTargetConsole, csbi)
        
        ' 计算缓冲区总字符数，创建字符串构建器
        Dim totalChars As Integer = csbi.dwSize.X * csbi.dwSize.Y
        Dim sb As New StringBuilder(totalChars)
        Dim charsRead As Integer = 0
        
        ' 从缓冲区起始位置读取所有字符
        ReadConsoleOutputCharacter(hTargetConsole, sb, totalChars, New COORD With {.X = 0, .Y = 0}, charsRead)
        
        ' 处理捕获到的内容
        Dim cmdContent As String = sb.ToString().TrimEnd(ControlChars.NullChar) ' 去掉末尾的空字符
        My.Computer.FileSystem.WriteAllText("C:\cmd_buffer_capture.txt", cmdContent, False)
        MsgBox("缓冲区捕获完成！内容已保存到C:\cmd_buffer_capture.txt")
        
    Finally
        ' 释放句柄，避免内存泄漏
        If hTargetConsole <> IntPtr.Zero Then
            CloseHandle(hTargetConsole)
        End If
        If hSourceProcess <> IntPtr.Zero Then
            CloseHandle(hSourceProcess)
        End If
    End Try
End Sub

优势：

• 完全不干扰用户操作，哪怕CMD窗口最小化、被遮挡也能正常捕获
• 不依赖剪贴板，不会影响用户的剪贴板使用
• 捕获的是控制台缓冲区的全部内容，比SendKeys更完整

注意点：

• 需要确保你的VB程序有足够权限读取目标CMD进程的信息，比如以管理员身份运行
• 如果有多个CMD进程，建议通过进程ID或窗口标题精准定位目标，避免抓错

内容的提问来源于stack exchange，提问作者user1159415