将CMD的输入输出重定向到自己的进程

    前段时间，CSDN VB版的一个网友问了一个如何取得进程句柄的问题，后来贴子中又引出另一个问题：如何将CMD的输入输出重定向到自己的进程？由于楼主提前结了贴子，所以我另开了一个贴子对这个问题作出了回答，两个原贴均可以在CSDN的VB版搜索到。现在我把代码记录在此，以飨更多的朋友。

    对于CMD窗口的输入输出重定向，我采用的是匿名管道。关于管道的相关技术和知识，可以参阅网上的其他相关文章或者MSDN，这里不在赘述。

    在窗体中放两个TextBox：txtCommand用于输入命令；txtMessage的MultiLine属性为True，ScrollBars属性为vbVertical，用于获得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         ' 从管道中读出数据, 该数据通常为CMD的版本及版权信息     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()     ' 读取管道中所有可读取的数据并写入到txtMessage中     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 30         ReadFile hReadPipe, ByVal strBuffer, ByVal nBufferLen, nRead, ByVal 0         If nRead <> 0 Then             strBuffer = Left(strBuffer, nRead)             txtMessage.Text = txtMessage.Text & strBuffer             txtMessage.SelStart = Len(txtMessage.Text)         End If     Loop End Sub

 

     源代码下载地址：http://csdngoodname008.51.net/CMDRedirect.zip

 

*-------------------------------------------*

*  转载请通知作者并注明出处，CSDN欢迎您！   *

*  作者：卢培培（goodname008）              *

*  邮箱：[email protected]                *

*  专栏：http://blog.csdn.net/goodname008   *

*-------------------------------------------*