text 執行DOS

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