如何对CMD窗口进行输入输出重定向

昨天xingnup (黑猫)发了个贴子问关于如何取得进程句柄的问题。
http://community.csdn.net/Expert/topic/4351/4351488.xml?temp=.4895746
后来讨论讨论着演化出一个新的问题:如何对CMD窗口进行输入输出重定向?

这个问题我记得很久以前就有人讨论过,在原贴中我也说了,最好的办法是用管道。
说实话,这东西确实用VC做起来比较舒服,启一个线程不断从管道中读取CMD窗口的输出,然后再进行处理就OK了。但VB做起来就得有些变通的地方,不过还好,代码没有我想象中的那么别扭。

xingnup(黑猫)如果需要的话可以实行“拿来主义”,当然也希望我的代码对大家都有帮助。
有什么不妥当的地方还希望大家提出宝贵意见。  :)

下面进入正题:
两个TextBox,txtCommand用于输入命令,txtMessage用于获得CMD窗口输出的内容。

Option Explicit

Private 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 Type

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

Private Const STARTF_USESTDHANDLES = &H100
Private Const HANDLE_FLAG_INHERIT = 1
Private Const DETACHED_PROCESS = &H8
Private Const PIPE_NOWAIT = &H1

Dim hReadPipe As Long
Dim hWritePipe As Long
Dim hChildReadPipe As Long
Dim hChildWritePipe As Long

Private 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 Sub

Private Sub Form_Unload(Cancel As Integer)
    CloseHandle hReadPipe
    CloseHandle hWritePipe
    CloseHandle hChildReadPipe
    CloseHandle hChildWritePipe
End Sub

Private 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 Sub

Private 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

阅读更多
换一批

[结论]如何CMD窗口进行输入输出重定向

10-27

昨天xingnup (黑猫)发了个贴子问关于如何取得进程句柄的问题。rnhttp://community.csdn.net/Expert/topic/4351/4351488.xml?temp=.4895746rn后来讨论讨论着演化出一个新的问题:如何对CMD窗口进行输入输出重定向?rnrn这个问题我记得很久以前就有人讨论过,在原贴中我也说了,最好的办法是用管道。rn说实话,这东西确实用VC做起来比较舒服,启一个线程不断从管道中读取CMD窗口的输出,然后再进行处理就OK了。但VB做起来就得有些变通的地方,不过还好,代码没有我想象中的那么别扭。rnrnxingnup(黑猫)如果需要的话可以实行“拿来主义”,当然也希望我的代码对大家都有帮助。rn有什么不妥当的地方还希望大家提出宝贵意见。 :)rnrn下面进入正题:rn两个TextBox,txtCommand用于输入命令,txtMessage用于获得CMD窗口输出的内容。rnrnOption ExplicitrnrnPrivate 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 LongrnPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongrnPrivate Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As LongrnPrivate Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As LongrnPrivate Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As LongrnPrivate Declare Function SetHandleInformation Lib "kernel32" (ByVal hObject As Long, ByVal dwMask As Long, ByVal dwFlags As Long) As LongrnPrivate Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As LongrnPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)rnrnPrivate Type STARTUPINFOrn cb As Longrn lpReserved As Stringrn lpDesktop As Stringrn lpTitle As Stringrn dwX As Longrn dwY As Longrn dwXSize As Longrn dwYSize As Longrn dwXCountChars As Longrn dwYCountChars As Longrn dwFillAttribute As Longrn dwFlags As Longrn wShowWindow As Integerrn cbReserved2 As Integerrn lpReserved2 As Longrn hStdInput As Longrn hStdOutput As Longrn hStdError As LongrnEnd TypernrnPrivate Type PROCESS_INFORMATIONrn hProcess As Longrn hThread As Longrn dwProcessId As Longrn dwThreadId As LongrnEnd TypernrnPrivate Const STARTF_USESTDHANDLES = &H100rnPrivate Const HANDLE_FLAG_INHERIT = 1rnPrivate Const DETACHED_PROCESS = &H8rnPrivate Const PIPE_NOWAIT = &H1rnrnDim hReadPipe As LongrnDim hWritePipe As LongrnDim hChildReadPipe As LongrnDim hChildWritePipe As LongrnrnPrivate Sub Form_Load()rn txtCommand.Text = ""rn txtMessage.Text = ""rn txtMessage.Locked = Truern rn ' 创建管道rn CreatePipe hReadPipe, hWritePipe, ByVal 0, ByVal 0rn CreatePipe hChildReadPipe, hChildWritePipe, ByVal 0, ByVal 0rn SetHandleInformation hWritePipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERITrn SetHandleInformation hChildReadPipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERITrn Dim dwMode As Longrn dwMode = PIPE_NOWAITrn SetNamedPipeHandleState hReadPipe, dwMode, ByVal 0, ByVal 0rn rn ' 创建CMD进程rn Dim stProcessInfo As PROCESS_INFORMATIONrn Dim stStartInfo As STARTUPINFOrn stStartInfo.cb = LenB(stStartInfo)rn stStartInfo.dwFlags = STARTF_USESTDHANDLESrn stStartInfo.hStdError = hWritePipern stStartInfo.hStdOutput = hWritePipern stStartInfo.hStdInput = hChildReadPipern rn Dim strExe As Stringrn strExe = "cmd"rn If False = CreateProcess(ByVal vbNullString, ByVal strExe, ByVal 0, ByVal 0, ByVal True, ByVal DETACHED_PROCESS, ByVal 0, ByVal vbNullString, stStartInfo, stProcessInfo) Thenrn MsgBox "启动进程失败!"rn Exit Subrn Elsern CloseHandle stProcessInfo.hThreadrn CloseHandle stProcessInfo.hProcessrn End Ifrn ReadFromChildPipernEnd SubrnrnPrivate Sub Form_Unload(Cancel As Integer)rn CloseHandle hReadPipern CloseHandle hWritePipern CloseHandle hChildReadPipern CloseHandle hChildWritePipernEnd SubrnrnPrivate Sub txtCommand_KeyPress(KeyAscii As Integer)rn If KeyAscii = vbKeyReturn Thenrn Dim nWrite As Longrn Dim strBuffer As Stringrn strBuffer = txtCommand.Text & vbCrLfrn Dim bResult As Booleanrn bResult = WriteFile(ByVal hChildWritePipe, ByVal strBuffer, ByVal Len(strBuffer), nWrite, ByVal 0)rn If bResult = True Thenrn ReadFromChildPipern Elsern MsgBox "写入失败."rn End Ifrn txtCommand.Text = ""rn End IfrnEnd SubrnrnPrivate Sub ReadFromChildPipe()rn Dim nRead As Longrn Dim strBuffer As Stringrn Dim nBufferLen As Longrn nRead = -1rn Do While nRead <> 0rn nBufferLen = 65536rn strBuffer = String(nBufferLen, Chr(0))rn Sleep 10rn ReadFile hReadPipe, ByVal strBuffer, ByVal nBufferLen, nRead, ByVal 0rn Sleep 10rn If nRead <> 0 Thenrn strBuffer = Left(strBuffer, nRead)rn txtMessage.Text = txtMessage.Text & strBufferrn txtMessage.SelStart = Len(txtMessage.Text)rn End Ifrn LooprnEnd Subrn

没有更多推荐了,返回首页