我曾被别人要求做了这件事情.而且居然要我用VB做.很痛苦. 要创建线程.利用管道技术. 你把它改改即可. 下面就是该函数.cmdLine 就是16位程序(可以写全路径),objTarget 是一个对象(如textbox) 用来显示该DOS 程序运行时显示信息.祝福你. ====================================================== Sub Redirect(cmdLine As String, objTarget As Object) Dim i%, t$ Dim pa As SECURITY_ATTRIBUTES Dim pra As SECURITY_ATTRIBUTES Dim tra As SECURITY_ATTRIBUTES Dim pi As PROCESS_INFORMATION Dim sui As STARTUPINFO Dim hRead As Long Dim hWrite As Long Dim bRead As Long Dim bLeft As Long Dim bTotal As Long Dim lpBuffer(1024) As Byte pa.nLength = Len(pa) pa.lpSecurityDescriptor = 0 pa.bInheritHandle = True pra.nLength = Len(pra) tra.nLength = Len(tra)
pra.nLength = Len(pra) tra.nLength = Len(tra) If CreatePipe(hRead, hWrite, pa, 0) <> 0 Then sui.cb = Len(sui) GetStartupInfo sui sui.hStdOutput = hWrite sui.hStdError = hWrite sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES sui.wShowWindow = SW_HIDE If CreateProcess(vbNullString, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) <> 0 Then 'SetWindowText objTarget.hwnd, "" Do hao: DoEvents If WaitForSingleObject(pi.hProcess, 0) = 0 Then Exit Do End If DoEvents If PeekNamedPipe(hRead, lpBuffer(0), 1023, bRead, bTotal, bLeft) Then If bRead = 0 Then GoTo hao Else Erase lpBuffer() If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0&) Then SendMessage objTarget.hwnd, EM_SETSEL, -1, 0 SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0) DoEvents End If End If End If Loop If TerminateProcess(pi.hProcess, 0) = False Then End If CloseHandle pi.hProcess CloseHandle hWrite CloseHandle hRead End If End If End Sub
ShellExecuteEx()
要创建线程.利用管道技术.
你把它改改即可.
下面就是该函数.cmdLine 就是16位程序(可以写全路径),objTarget 是一个对象(如textbox)
用来显示该DOS 程序运行时显示信息.祝福你.
======================================================
Sub Redirect(cmdLine As String, objTarget As Object)
Dim i%, t$
Dim pa As SECURITY_ATTRIBUTES
Dim pra As SECURITY_ATTRIBUTES
Dim tra As SECURITY_ATTRIBUTES
Dim pi As PROCESS_INFORMATION
Dim sui As STARTUPINFO
Dim hRead As Long
Dim hWrite As Long
Dim bRead As Long
Dim bLeft As Long
Dim bTotal As Long
Dim lpBuffer(1024) As Byte
pa.nLength = Len(pa)
pa.lpSecurityDescriptor = 0
pa.bInheritHandle = True
pra.nLength = Len(pra)
tra.nLength = Len(tra)
pra.nLength = Len(pra)
tra.nLength = Len(tra) If CreatePipe(hRead, hWrite, pa, 0) <> 0 Then
sui.cb = Len(sui)
GetStartupInfo sui
sui.hStdOutput = hWrite
sui.hStdError = hWrite
sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
sui.wShowWindow = SW_HIDE
If CreateProcess(vbNullString, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) <> 0 Then
'SetWindowText objTarget.hwnd, "" Do
hao:
DoEvents
If WaitForSingleObject(pi.hProcess, 0) = 0 Then
Exit Do
End If
DoEvents
If PeekNamedPipe(hRead, lpBuffer(0), 1023, bRead, bTotal, bLeft) Then
If bRead = 0 Then
GoTo hao
Else
Erase lpBuffer()
If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0&) Then
SendMessage objTarget.hwnd, EM_SETSEL, -1, 0
SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0)
DoEvents
End If
End If
End If
Loop
If TerminateProcess(pi.hProcess, 0) = False Then
End If
CloseHandle pi.hProcess
CloseHandle hWrite
CloseHandle hRead
End If
End If
End Sub
如:
cmd/c dir