text 执行DOS

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 LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As LongPrivate Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As LongPrivate Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As LongPrivate Declare Function SetHandleInformation Lib "kernel32" (ByVal hObject As Long, ByVal dwMask As Long, ByVal dwFlags As Long) As LongPrivate Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As LongPrivate 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 LongEnd TypePrivate Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As LongEnd TypePrivate Const STARTF_USESTDHANDLES = &H100Private Const HANDLE_FLAG_INHERIT = 1Private Const DETACHED_PROCESS = &H8Private Const PIPE_NOWAIT = &H1Dim hReadPipe As LongDim hWritePipe As LongDim hChildReadPipe As LongDim 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 ReadFromChildPipeEnd SubPrivate Sub Form_Unload(Cancel As Integer) CloseHandle hReadPipe CloseHandle hWritePipe CloseHandle hChildReadPipe CloseHandle hChildWritePipeEnd 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 IfEnd 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 LoopEnd Sub