昨天xingnup (黑猫)发了个贴子问关于如何取得进程句柄的问题。
http://community.csdn.net/Expert/topic/4351/4351488.xml?temp=.4895746
后来讨论讨论着演化出一个新的问题:如何对CMD窗口进行输入输出重定向?这个问题我记得很久以前就有人讨论过,在原贴中我也说了,最好的办法是用管道。
说实话,这东西确实用VC做起来比较舒服,启一个线程不断从管道中读取CMD窗口的输出,然后再进行处理就OK了。但VB做起来就得有些变通的地方,不过还好,代码没有我想象中的那么别扭。xingnup(黑猫)如果需要的话可以实行“拿来主义”,当然也希望我的代码对大家都有帮助。
有什么不妥当的地方还希望大家提出宝贵意见。  :)下面进入正题:
两个TextBox,txtCommand用于输入命令,txtMessage用于获得CMD窗口输出的内容。Option ExplicitPrivate Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SetHandleInformation Lib "kernel32" (ByVal hObject As Long, ByVal dwMask As Long, ByVal dwFlags As Long) As Long
Private Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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 TypePrivate Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End TypePrivate Const STARTF_USESTDHANDLES = &H100
Private Const HANDLE_FLAG_INHERIT = 1
Private Const DETACHED_PROCESS = &H8
Private Const PIPE_NOWAIT = &H1Dim hReadPipe As Long
Dim hWritePipe As Long
Dim hChildReadPipe As Long
Dim hChildWritePipe As LongPrivate Sub Form_Load()
    txtCommand.Text = ""
    txtMessage.Text = ""
    txtMessage.Locked = True
    
    ' 创建管道
    CreatePipe hReadPipe, hWritePipe, ByVal 0, ByVal 0
    CreatePipe hChildReadPipe, hChildWritePipe, ByVal 0, ByVal 0
    SetHandleInformation hWritePipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT
    SetHandleInformation hChildReadPipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT
    Dim dwMode As Long
    dwMode = PIPE_NOWAIT
    SetNamedPipeHandleState hReadPipe, dwMode, ByVal 0, ByVal 0
    
    ' 创建CMD进程
    Dim stProcessInfo As PROCESS_INFORMATION
    Dim stStartInfo As STARTUPINFO
    stStartInfo.cb = LenB(stStartInfo)
    stStartInfo.dwFlags = STARTF_USESTDHANDLES
    stStartInfo.hStdError = hWritePipe
    stStartInfo.hStdOutput = hWritePipe
    stStartInfo.hStdInput = hChildReadPipe
    
    Dim strExe As String
    strExe = "cmd"
    If False = CreateProcess(ByVal vbNullString, ByVal strExe, ByVal 0, ByVal 0, ByVal True, ByVal DETACHED_PROCESS, ByVal 0, ByVal vbNullString, stStartInfo, stProcessInfo) Then
        MsgBox "启动进程失败!"
        Exit Sub
    Else
        CloseHandle stProcessInfo.hThread
        CloseHandle stProcessInfo.hProcess
    End If
    ReadFromChildPipe
End SubPrivate Sub Form_Unload(Cancel As Integer)
    CloseHandle hReadPipe
    CloseHandle hWritePipe
    CloseHandle hChildReadPipe
    CloseHandle hChildWritePipe
End SubPrivate Sub txtCommand_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Dim nWrite As Long
        Dim strBuffer As String
        strBuffer = txtCommand.Text & vbCrLf
        Dim bResult As Boolean
        bResult = WriteFile(ByVal hChildWritePipe, ByVal strBuffer, ByVal Len(strBuffer), nWrite, ByVal 0)
        If bResult = True Then
            ReadFromChildPipe
        Else
            MsgBox "写入失败."
        End If
        txtCommand.Text = ""
    End If
End SubPrivate Sub ReadFromChildPipe()
    Dim nRead As Long
    Dim strBuffer As String
    Dim nBufferLen As Long
    nRead = -1
    Do While nRead <> 0
        nBufferLen = 65536
        strBuffer = String(nBufferLen, Chr(0))
        Sleep 10
        ReadFile hReadPipe, ByVal strBuffer, ByVal nBufferLen, nRead, ByVal 0
        Sleep 10
        If nRead <> 0 Then
            strBuffer = Left(strBuffer, nRead)
            txtMessage.Text = txtMessage.Text & strBuffer
            txtMessage.SelStart = Len(txtMessage.Text)
        End If
    Loop
End Sub

解决方案 »

  1.   

    好象楼主最近又出山了。
    看到这个 goodname008 (卢培培,充电中......)   名字
    就想起来哪个超酷的右键菜单,可惜不支持多级菜单。呵呵。
      

  2.   

    出山谈不上。
    很长时间不发贴到是真的,呵呵。那个右键菜单,只要改改就可以支持多级菜单的,以前一直想改,但拖的时间越来越长,就有点懒得改了。本来打算用VC写一个更好的类,但一直没有时间和机会,哎......
    以后自己用到再说吧。  :D
      

  3.   

    to 楼上:
    也不一定非要看VC,其实把win32 sdk掌握好了就行。
    不过要想掌握好win32 sdk,懂C/C++/VC会对win32 sdk有更深的认识。
      

  4.   

    呵呵,很不错的代码啊,自己也研究过但是太菜,所以自己用了BT的方法,这下好了,有正招了,呵呵,代码收了,谢谢楼主啊 ^_^,下面我把自己的办法也帖出来,大家不要笑话啊,我的方法也根本就不算什么CMD截取,而且很不好用啊,所以贴出来只是希望大家别把我骂的找不到北哦(找到南就行,呵呵),下面看俺的BT方法:::::)
    一个Text1,一个RichTextBox1,一个Timer1
    Private Sub Form_Load()
    Timer1.Interval = 500
    Timer1.Enabled = False
    RichTextBox1.Text = ""
    End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim Command As String
    Command = "cmd /c " + Text1 + " >C:\command.txt"
    If KeyCode = 13 Then
        Shell Command, vbHide
        Timer1.Enabled = True
    End If
    End SubPrivate Sub Timer1_Timer()
    Open "C:\command.txt" For Input As #1
    Do While Not EOF(1)
        Line Input #1, LinShi$
        RichTextBox1.Text = RichTextBox1.Text + LinShi$ + Chr(10) + Chr(13)
    Loop
    Close #1
    Timer1.Enabled = False
    Kill "C:\command.txt"'消灭证据,呵呵
    End Sub
      

  5.   

    这程序做出来有什么用途可以说一下吗?
    就是把CMD里面的内容显示出来而以吗?
      

  6.   

    to 楼上:
    没什么实际用处,只是个例程,演示如何实现这个功能。
    一方面对xingnup (黑猫)的回答完整一些,另一方面是对这类问题提供一种解决的思路,供大家讨论。这个例程本身没什么实用价值,但这种技术本身是非常有用的。发贴分数和用户等级有关。