【问】如何取得实时的DOS输出屏幕内容？

运行一个命令行的程序，它在DOS屏幕上有一个字符组成的进度条
并在DOS屏幕固定位置实时显示当前进度的文本内容，及一个滚动的文本信息栏

请问，如何让其输出到我的程序里的TextBox，如何感应到它的内容改变了？
网上大部分的例子都是当它运行完成后打开一个文件去读取输出内容，
但那样只能取到最后输出的屏幕。

现在要取的是运行实时的进度信息，并加以控制，比如达到％多少，就发送一个键

中止等等，不知道该如何做？

还请各位大虾们指教，俺只有VB5，谢谢！

22 个解决方案

#1

下面是我收藏的一个示例，没研究过，你看看有没有帮助

Option Explicit
Option Base 0

Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
    ByVal lpApplicationName As String, _
    ByVal lpCommandLine As String, _
    lpProcessAttributes As SECURITY_ATTRIBUTES, _
    lpThreadAttributes As SECURITY_ATTRIBUTES, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    lpEnvironment As Any, _
    ByVal lpCurrentDirectory As String, _
    lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION _
) As Long

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Declare Function ReadFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    lpOverlapped As Long _
) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long _
) As Long

Private Declare Function CreatePipe Lib "kernel32" ( _
    phReadPipe As Long, _
    phWritePipe As Long, _
    lpPipeAttributes As SECURITY_ATTRIBUTES, _
    ByVal nSize As Long _
) As Long

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const STARTF_USESTDHANDLES As Long = &H100&
Private Const STARTF_USESHOWWINDOW As Long = &H1&
Private Const SW_HIDE As Long = 0&
Private Const INFINITE As Long = &HFFFF&

Public Function RunCommand(CommandLine As String) As String
    Dim si As STARTUPINFO 'used to send info the CreateProcess
    Dim pi As PROCESS_INFORMATION 'used to receive info about the created process
    Dim retval As Long 'return value
    Dim hRead As Long 'the handle to the read end of the pipe
    Dim hWrite As Long 'the handle to the write end of the pipe
    Dim sBuffer(0 To 63) As Byte 'the buffer to store data as we read it from the pipe
    Dim lgSize As Long 'returned number of bytes read by readfile
    Dim sa As SECURITY_ATTRIBUTES
    Dim strResult As String 'returned results of the command line

     'set up security attributes structure
    With sa
        .nLength = Len(sa)
        .bInheritHandle = 1& 'inherit, needed for this to work
        .lpSecurityDescriptor = 0&
    End With

     'create our anonymous pipe an check for success
     ' note we use the default buffer size
     ' this could cause problems if the process tries to write more than this buffer size
    retval = CreatePipe(hRead, hWrite, sa, 0&)
    If retval = 0 Then
        Debug.Print "CreatePipe Failed"
        RunCommand = ""
        Exit Function
    End If

     'set up startup info
    With si
        .cb = Len(si)
        .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW 'tell it to use (not ignore) the values below
        .wShowWindow = SW_HIDE
    ' .hStdInput = GetStdHandle(STD_INPUT_HANDLE)
        .hStdOutput = hWrite 'pass the write end of the pipe as the processes standard output
    ' .hStdError = GetStdHandle(STD_ERROR_HANDLE)
    End With

     'run the command line and check for success
    retval = CreateProcess(vbNullString, _
        CommandLine & vbNullChar, _
        sa, _
        sa, _
        1&, _
        NORMAL_PRIORITY_CLASS, _
        ByVal 0&, _
        vbNullString, _
        si, _
        pi)
    If retval Then
     'wait until the command line finishes
     ' trouble if the app doesn't end, or waits for user input, etc
        WaitForSingleObject pi.hProcess, INFINITE

     'read from the pipe until there's no more (bytes actually read is less than what we told it to)
        Do While ReadFile(hRead, sBuffer(0), 64, lgSize, ByVal 0&)
     'convert byte array to string and append to our result
            strResult = strResult & StrConv(sBuffer(), vbUnicode)
     'TODO = what's in the tail end of the byte array when lgSize is less than 64???
            Erase sBuffer()
            If lgSize <> 64 Then Exit Do
        Loop

     'close the handles of the process
        CloseHandle pi.hProcess
        CloseHandle pi.hThread
    Else
        Debug.Print "CreateProcess Failed" & vbCrLf
    End If

     'close pipe handles
    CloseHandle hRead
    CloseHandle hWrite

     'return the command line output
    RunCommand = Replace(strResult, vbNullChar, "")
End Function

Private Sub Command1_Click()
    Text1.Text = RunCommand("ipconfig")
End Sub

#2

谢谢楼上兄弟！
可惜这达不到本主题的要求：实时捕获输出。（因为要根据运行过程中输出的信息进行交互）

If retval Then
'wait until the command line finishes

#3

用通道來做。

#4

Sorry，使用 Delphi 倒是做过， VB 没有尝试过。

#5

To vansoft(Vansoft Workroom) ：
请问如何做？

#6

前几天看到过问这个的

搜索一下，管道

#7

他的问题实际上也就和我一样，
If retval Then
'wait until the command line finishes

#8

#9

用重定向管道来做。。。
在google用“如何在VB中截获shell程序的输出 ”会有收获。。。

#10

但即使能实时捕获了输出，但要进行信息交互可能还要费很大功夫。。。
如果有其他途径解决就最好用其他方法。。。。

#11

不是要交互，只要能实时取得当前进度就行

#12

转帖（原始出处已不可考，原作者也不知道。。。）：

如何在VB中截获shell程序的输出
发布时间：2004-8-26
     在Windows环境下的所谓shell程序就是dos命令行程序，比如VC的CL.exe命令行编译器，JDK的javac编译器，启动java程序用的java.exe都是标准的shell程序。

    截获一个shell程序的输出是很有用的，比如说您可以自己编写一个IDE(集成开发环境)，当用户发出编译指令时候，你可以在后台启动shell 调用编译器并截获它们的输出，对这些输出信息进行分析后在更为友好的用户界面上显示出来。

    为了方便起见，我们用VB作为本文的演示语言。

    通常，系统启动Shell程序时缺省给定了3个I/O信道，标准输入(stdin), 标准输出stdout, 标准错误输出stderr。

    之所以这么区分是因为在早期的计算机系统如PDP-11的一些限制。那时没有GUI，将输出分为tdout,stderr可以避免程序的调试信息和正常输出的信息混杂在一起。

    通常， shell程序把它们的输出写入标准输出管道(stdout)、把出错信息写入标准错误管道(stderr)。缺省情况下，系统将管道的输出直接送到屏幕，这样一来我们就能看到应用程序运行结果了。

    为了捕获一个标准控制台应用程序的输出，我们必须把standOutput和standError管道输出重定向到我们自定义的管道。

    下面的代码可以启动一个shell程序,并将其输出截获。

    ’执行并返回一个命令行程序(shell程序)的标准输出和标准错误输出

    ’通常命令行程序的所有输出都直接送到屏幕上

    Private Function ExecuteApp(sCmdline As String) As String

    Dim proc As PROCESS_INFORMATION, ret As Long

    Dim start As STARTUPINFO

    Dim sa As SECURITY_ATTRIBUTES

    Dim hReadPipe As Long ’负责读取的管

    Dim hWritePipe As Long ’负责Shell程序的标准输出和标准错误输出的管道

    Dim sOutput As String ’放返回的数据

    Dim lngBytesRead As Long, sBuffer As String * 256

    sa.nLength = Len(sa)

    sa.bInheritHandle = True

    ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)

    If ret = 0 Then

    MsgBox "CreatePipe failed. Error: " & Err.LastDllError

    Exit Function

    End If

    start.cb = Len(start)

    start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW

    ’把标准输出和标准错误输出重定向到同一个管道中去

    start.hStdOutput = hWritePipe

    start.hStdError = hWritePipe

    start.wShowWindow = SW_HIDE ’隐含shell程序窗口

    ’启动shell程序, sCmdLine指明执行的路径

    ret = CreateProcessA(0&, sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, _

    0&, 0&, start, proc)

    If ret = 0 Then

    MsgBox "无法建立新进程，错误码：" & Err.LastDllError

    Exit Function

    End If

    ’本例中不必向shell程序送信息，因此可以先关闭

    hWritePipe

    CloseHandle

    hWritePipe

    ’循环读取shell程序的输出，每次读取256个字节。

    Do

    ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)

    sOutput = sOutput & Left$(sBuffer, lngBytesRead)

    Loop While ret <> 0 ’如果ret=0代表没有更多的信息需要读取了

    ’释放相关资源

    CloseHandle

    proc.hProcess

    CloseHandle

    proc.hThread

    CloseHandle

    hReadPipe

    ExecuteApp = sOutput ’输出结果

    End Function

    我对这个程序进行一些解释。

    ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)

    大家可以看到，首先我们建立一个匿名管道。该匿名管道稍候将用来取得与被截获的应用程序的联系。其中hReadPipe用来获取shell程序的输出，而hWritePipe可以用来向应用程序发送信息。

    如同现实世界中的水管一样，水从管道的一端流进从另一端流出。您把水想象为信息，水管就是匿名管道,这样一来就很好理解这段程序了。

    然后就是设置shell应用程序的初始属性。

    Dwflags可以指示系统在创建新进程时新进程使用了自定义的ShowWindow, hStdInput,hStdOutput和hStdError。（windows显示属性，标准输入，标准输出，标准错误输出。）

    再把shell应用程序的标准输出和标准错误输出都定向到我们预先建好的管道中。

    代码如下:

    start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW

    start.hStdOutput = hWritePipe

    start.hStdError = hWritePipe

    好，现在可以调用建立新进程的函数了：

    ret = CreateProcessA(0&, sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

    然后，循环读管道里的数据直到无数据可读为止。

    Do

    ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&) ’每次读256字节

    sOutput = sOutput & Left$(sBuffer, lngBytesRead) ’送入一个字符串中

    Loop While ret <> 0 ’若 ret = 0 表明没有数据等待读取。

    然后，释放不用的资源。

    用法很简单：比如：

    MsgBox ExecuteApp("c:\windows\command\mem.exe")

    是很方便吧？

    不过，这些程序是在NT下的，如果要在95下实现还需要一点点改动。因为如果该函数调用一个纯win32的程序，没问题。可是95是16,win32混合的系统，当你试图调用一个16位的DOS应用程序那么，那么这个办法会导致相关进程挂起。因为这涉及到WindowsNT和Windows 95对shell的不同实现。

    在win95中，16位shell程序关闭时并不保证重定向的管道也关闭，这样，当你的程序试图读取一个已经关闭的shell程序的重定向管道时，你的程序就挂了。

    那么，有解决办法吗？回答是肯定的。

    解决办法就是用一个win32的应用程序作为您的应用程序和shell程序的中间人。中间人程序继承并重定向了主程序的输入输出，然后中间人程序启动指定的shell程序。该shell程序也就继承并重定向了主程序的输入输出。中间人程序一直等到shell程序结束才结束。

    当shell程序结束时，中间人程序也结束，同时因为中间人程序是一个win32程序，那么它就会关闭相应的重定向了管道。这样，你的程序可以发现管道已经关闭，便可以跳出循环。你的程序就不会挂起了。

    下面是相关的中间人程序C代码的实现：

    #include void main (int argc, char *argv[]){

    BOOL bRet = FALSE; STARTUPINFO si = {0};

    PROCESS_INFORMATION pi = {0}; // Make child process use this app’s

    standard files. si.cb = sizeof(si);

    si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = GetStdHandle (STD_INPUT_HANDLE);

    si.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);

    si.hStdError = GetStdHandle (STD_ERROR_HANDLE);

    bRet = CreateProcess (NULL, argv[1], NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi );

    if (bRet) {

    WaitForSingleObject (pi.hProcess, INFINITE);

    CloseHandle (pi.hProcess);

    CloseHandle (pi.hThread);

    }

    }

    把该程序编译为conspawn.exe并放在系统可以调用到的路径目录中。然后把文章开头提到的代码中的CreateProcessA语句改为：

    ret = CreateProcessA(0&, "conspawn """ & sCmdline & """", sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

    好，这样一来，我们这个函数可以同时很好的支持WindowsNT和Windows95/98了。

#13

http://www.applevb.com/sourcecode/Capture%20DOS%20Output.zip

一个可以运行DOS程序（正确的说法应该是Windows下的控制台程序）并且捕捉程序输出的源程序
楼主看看

#14

对于自己创建的控制台窗口（CreateProcess），可以使用楼上的“重定向管道”来做

但是对于其他程序启动的控制台窗口，那没有办法监控（只能截屏）

#15

谢谢大家的关注！

但请注意顶楼和1楼的内容，
retval = CreateProcess(vbNullString, _
If retval Then
'wait until the command line finishes

我想要的是过程中的屏幕，而不是结束后的屏幕。
打个比方说吧，一个QBasic编的游戏，在运行过程中显示字符界面的运行屏幕，在结束后，总是清屏后输出Game Over ，如果用上面的办法，那只能取得Game Over，而不是运行中的屏幕

这可不是想要的结果：（

而现在要取得的是一个实时的进度值（在屏幕的某个固定地方显示 1％一直到100％）
当达到50％时向此DOS窗口发送一个^C键，
如果一直要等到它100％结束，那还有什么用？

#16

//打个比方说吧，一个QBasic编的游戏，在运行过程中显示字符界面的运行屏幕，在结束后，总是清屏后输出Game Over ，如果用上面的办法，那只能取得Game Over，而不是运行中的屏幕
//而现在要取得的是一个实时的进度值（在屏幕的某个固定地方显示 1％一直到100％）
//当达到50％时向此DOS窗口发送一个^C键，
//如果一直要等到它100％结束，那还有什么用？

那是直接写显存（DOS程序最流行这样写）
而不是调用DOS的标准输入输出接口（如那个“Game Over”）
这种功能是无法办到的（也许些驱动程序有办法办到）

只能用一些偏招，如截屏分析
但是编码复杂、效率低，成功率更低

所以建议搂主还是放弃这种功能吧

#17

刚刚测试了一下
发现可以得到DOS窗口程序的显存
用ReadProcessMemory读取进程内存就行

A0000 ~ AFFFF：图形显存
B0000 ~ B7FFF：VGA文本显存
B8000 ~ BFFFF：EGA文本显存

但是存在众多的显示模式
不同显示模式的显存数据存放格式完全不同
（特别是VGA 12h这一类使用位平面的显示模式，显存地址空间中存放的不是真实的像素值）
所以用判断显存的办法也是很麻烦的

#18

//发现可以得到DOS窗口程序的显存
用ReadProcessMemory读取进程内存就行

这是因为是控制台的缘故吧

#19

看来ＶＢ真的没戏唱了：（

只剩下一个终极办法了：

用另一台电脑的摄像头对准屏幕固定位置，当它的数字变动时，将触发摄像头所在的游戏软件（比如说敲榔头吧），当数字变动到某一时刻时（也就是敲到某个次数时）触发预先已Hook这个游戏的软件。然后，拨号上网，找到这台接受电脑的IP，绕过防火墙，激发预设的一个木马。找到屏幕上的DOS窗口句柄，向其发送^C键。然后，启动QQ短信，发到俺的手机一个确认短信。

OK，终于大功告成：）

#20

呵呵,绕过防火墙不容易啊

#21

那还不容易啊？
只要马路上随便找个“工程队”拆了它不就得了：）

#22

添加引用 windows script host object model
然后:
Sub main()
Dim ws As New WshShell
MsgBox ws.Exec("net user").StdOut.ReadAll
End Sub

#1

#2