7,765
社区成员
发帖
与我相关
我的任务
分享如何用VB执行DOS的命令,并取得DOS窗口的显示内容?
如题
想用VB来执行一些行命令,但执行会的,SHELL, 但无法取得返回的信息内容,哪位可告诉一个方法
想用VB来执行一些行命令,但执行会的,SHELL, 但无法取得返回的信息内容,哪位可告诉一个方法
...全文
请发表友善的回复…
发表回复
hxy2003 2005-01-12
- 打赏
- 举报
UP
dreamtou 2004-07-07
- 打赏
- 举报
gdami(糖米) ( ) 的方法可行，我试过，不过，如果要终止这次运行，还要在里面加点控制代码
fxy_2002 2004-07-07
- 打赏
- 举报
******
上面的方法,我试过了,不过主要问题是,重定向无法把stdout,stderr同时输出到一个文件.
******
gdami(糖米) 的方法应该没试过，如果可行就最好了。
如果不行，不妨再研究一下重定向功能。
重定向命令可以向已存在的文件追加内容，只需要将定向符号“>”改成“>>”
pigpag 2004-07-06
- 打赏
- 举报
FAQ
ryuginka 2004-07-06
- 打赏
- 举报
up
fxy_2002 2004-07-06
- 打赏
- 举报
高级的方法偶不知道，但偶有个笨办法：用输出重定向！
例如执行 DIR 命令(for XP/2000)：
Shell "cmd /c dir > c:\dir.txt", vbHide
其中 c:\dir.txt 的内容就是屏幕的输出结果了，再打开分析就能做一些需要的工作。其它 dos 命令都可以照此办理。
如果是在98 中，改成 Shell "command /c dir > c:\dir.txt", vbHide
例如执行 DIR 命令(for XP/2000)：
Shell "cmd /c dir > c:\dir.txt", vbHide
其中 c:\dir.txt 的内容就是屏幕的输出结果了，再打开分析就能做一些需要的工作。其它 dos 命令都可以照此办理。
如果是在98 中，改成 Shell "command /c dir > c:\dir.txt", vbHide
AKillGodKillBuddha 2004-07-06
- 打赏
- 举报
学习一下
gdami 2004-07-06
- 打赏
- 举报
这是另外一个例子,即时获取信息的.
Option Explicit
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const SW_HIDE = 0
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_SHOWNORMAL = 1
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
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 Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal _
lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" Alias _
"FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, _
ByVal lpResult As String) 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 ReadFile Lib "kernel32" (ByVal HFile As Long, ByVal _
lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead _
As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal HFile As Long, _
lpFileSizeHigh As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles _
As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal _
lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As _
Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As _
Long, ByVal uExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function GetDriveLetter(ByVal PathString As String) As String
Dim DriveStr As String
DriveStr = Trim$(PathString)
If InStr(DriveStr, ":") = 2 Then
GetDriveLetter = Left$(DriveStr, 2)
Else
GetDriveLetter = "C:"
End If
End Function
Public Sub StartProcess(BatchFile As String, InitialPath As String, strOutput As _
String, strError As String)
Dim ProcInfo As PROCESS_INFORMATION
Dim ret As Long
Dim lSuccess As Long
Dim StartInfo As STARTUPINFO
Dim SecAttr As SECURITY_ATTRIBUTES
Dim hReadPipe1 As Long
Dim hWritePipe1 As Long
Dim hReadPipe2 As Long
Dim hWritePipe2 As Long
Dim BytesRead As Long
Dim stdoutBuff As String
Dim stderrBuff As String
Dim BytesLeft As Long
Dim CurrFolder As String
Dim StdOutCharCount As Integer
Dim StdErrCharCount As Integer
Dim ShowPipeError As Boolean
Dim fName As String
strOutput = ""
strError = ""
ShowPipeError = False
On Error Resume Next
SecAttr.nLength = Len(SecAttr)
SecAttr.bInheritHandle = 1&
SecAttr.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe1, hWritePipe1, SecAttr, 0)
If ret = 0 Then Exit Sub
ret = CreatePipe(hReadPipe2, hWritePipe2, SecAttr, 0)
If ret = 0 Then
CloseHandle (hReadPipe1)
CloseHandle (hWritePipe1)
Exit Sub
End If
StartInfo.cb = Len(StartInfo)
StartInfo.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
StartInfo.hStdOutput = hWritePipe1
StartInfo.hStdError = hWritePipe2
StartInfo.wShowWindow = SW_HIDE
If InitialPath <> "" Then
CurrFolder = CurDir
ChDrive GetDriveLetter(InitialPath)
ChDir (InitialPath)
End If
strOutput = strOutput & "Running command : " & BatchFile & vbCrLf & vbCrLf
ret = CreateProcessA(0&, "" & BatchFile$, SecAttr, SecAttr, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, StartInfo, ProcInfo)
If ret <> 1 Then
CloseHandle (hReadPipe1)
CloseHandle (hWritePipe1)
CloseHandle (hReadPipe2)
CloseHandle (hWritePipe2)
Exit Sub
End If
StdOutCharCount = 0
StdErrCharCount = 0
Do
Do
BytesLeft = GetFileSize(hReadPipe1, 0&)
If BytesLeft = -1 Then ShowPipeError = True
If BytesLeft > 0 Then
stdoutBuff = String(BytesLeft, " ")
lSuccess = ReadFile(hReadPipe1, stdoutBuff, BytesLeft, BytesRead, 0&)
DoEvents
If lSuccess = 1 Then
StdOutCharCount = StdOutCharCount + Len(Left(stdoutBuff, BytesRead))
strOutput = strOutput + Left(stdoutBuff, BytesRead)
'strOutput.SelStart = Len(strOutput)
'strOutput.Refresh
DoEvents
End If
End If
Loop Until BytesLeft <= 0
Do
BytesLeft = GetFileSize(hReadPipe2, 0&)
If BytesLeft = -1 Then ShowPipeError = True
If BytesLeft > 0 Then
stderrBuff = String(BytesLeft, " ")
lSuccess = ReadFile(hReadPipe2, stderrBuff, BytesLeft, BytesRead, 0&)
DoEvents
If lSuccess = 1 Then
StdErrCharCount = StdErrCharCount + Len(Left(stderrBuff, BytesRead))
strError = strError + Left(stderrBuff, BytesRead)
'strError.SelStart = Len(strOutput)
'strError.Refresh
DoEvents
End If
End If
Loop Until BytesLeft <= 0
lSuccess = WaitForSingleObject(ProcInfo.hProcess, 1)
BytesLeft = GetFileSize(hReadPipe1, 0&) + GetFileSize(hReadPipe2, 0&)
Loop Until lSuccess = 0 And BytesLeft <= 0
CloseHandle (ProcInfo.hProcess)
CloseHandle (ProcInfo.hThread)
CloseHandle (hReadPipe1)
CloseHandle (hWritePipe1)
CloseHandle (hReadPipe2)
CloseHandle (hWritePipe2)
If CurrFolder <> "" Then
ChDrive GetDriveLetter(CurrFolder)
ChDir (CurrFolder)
End If
End Sub
Private Sub Command1_Click()
Dim strError As String
Dim strOutput As String
StartProcess "MyDosProgram.exe", App.Path, strOutput, strError
Text1 = strOutput
End Sub
要获得即时的DOS输出的内容（而不需等到程序结束），只需要在
strOutput = strOutput + Left(stdoutBuff, BytesRead)
上面这一行的后面加入：
Text1.SelText = Left(stdoutBuff, BytesRead)
即可。
Option Explicit
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const SW_HIDE = 0
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_SHOWNORMAL = 1
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
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 Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal _
lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" Alias _
"FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, _
ByVal lpResult As String) 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 ReadFile Lib "kernel32" (ByVal HFile As Long, ByVal _
lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead _
As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal HFile As Long, _
lpFileSizeHigh As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles _
As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal _
lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As _
Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As _
Long, ByVal uExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function GetDriveLetter(ByVal PathString As String) As String
Dim DriveStr As String
DriveStr = Trim$(PathString)
If InStr(DriveStr, ":") = 2 Then
GetDriveLetter = Left$(DriveStr, 2)
Else
GetDriveLetter = "C:"
End If
End Function
Public Sub StartProcess(BatchFile As String, InitialPath As String, strOutput As _
String, strError As String)
Dim ProcInfo As PROCESS_INFORMATION
Dim ret As Long
Dim lSuccess As Long
Dim StartInfo As STARTUPINFO
Dim SecAttr As SECURITY_ATTRIBUTES
Dim hReadPipe1 As Long
Dim hWritePipe1 As Long
Dim hReadPipe2 As Long
Dim hWritePipe2 As Long
Dim BytesRead As Long
Dim stdoutBuff As String
Dim stderrBuff As String
Dim BytesLeft As Long
Dim CurrFolder As String
Dim StdOutCharCount As Integer
Dim StdErrCharCount As Integer
Dim ShowPipeError As Boolean
Dim fName As String
strOutput = ""
strError = ""
ShowPipeError = False
On Error Resume Next
SecAttr.nLength = Len(SecAttr)
SecAttr.bInheritHandle = 1&
SecAttr.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe1, hWritePipe1, SecAttr, 0)
If ret = 0 Then Exit Sub
ret = CreatePipe(hReadPipe2, hWritePipe2, SecAttr, 0)
If ret = 0 Then
CloseHandle (hReadPipe1)
CloseHandle (hWritePipe1)
Exit Sub
End If
StartInfo.cb = Len(StartInfo)
StartInfo.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
StartInfo.hStdOutput = hWritePipe1
StartInfo.hStdError = hWritePipe2
StartInfo.wShowWindow = SW_HIDE
If InitialPath <> "" Then
CurrFolder = CurDir
ChDrive GetDriveLetter(InitialPath)
ChDir (InitialPath)
End If
strOutput = strOutput & "Running command : " & BatchFile & vbCrLf & vbCrLf
ret = CreateProcessA(0&, "" & BatchFile$, SecAttr, SecAttr, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, StartInfo, ProcInfo)
If ret <> 1 Then
CloseHandle (hReadPipe1)
CloseHandle (hWritePipe1)
CloseHandle (hReadPipe2)
CloseHandle (hWritePipe2)
Exit Sub
End If
StdOutCharCount = 0
StdErrCharCount = 0
Do
Do
BytesLeft = GetFileSize(hReadPipe1, 0&)
If BytesLeft = -1 Then ShowPipeError = True
If BytesLeft > 0 Then
stdoutBuff = String(BytesLeft, " ")
lSuccess = ReadFile(hReadPipe1, stdoutBuff, BytesLeft, BytesRead, 0&)
DoEvents
If lSuccess = 1 Then
StdOutCharCount = StdOutCharCount + Len(Left(stdoutBuff, BytesRead))
strOutput = strOutput + Left(stdoutBuff, BytesRead)
'strOutput.SelStart = Len(strOutput)
'strOutput.Refresh
DoEvents
End If
End If
Loop Until BytesLeft <= 0
Do
BytesLeft = GetFileSize(hReadPipe2, 0&)
If BytesLeft = -1 Then ShowPipeError = True
If BytesLeft > 0 Then
stderrBuff = String(BytesLeft, " ")
lSuccess = ReadFile(hReadPipe2, stderrBuff, BytesLeft, BytesRead, 0&)
DoEvents
If lSuccess = 1 Then
StdErrCharCount = StdErrCharCount + Len(Left(stderrBuff, BytesRead))
strError = strError + Left(stderrBuff, BytesRead)
'strError.SelStart = Len(strOutput)
'strError.Refresh
DoEvents
End If
End If
Loop Until BytesLeft <= 0
lSuccess = WaitForSingleObject(ProcInfo.hProcess, 1)
BytesLeft = GetFileSize(hReadPipe1, 0&) + GetFileSize(hReadPipe2, 0&)
Loop Until lSuccess = 0 And BytesLeft <= 0
CloseHandle (ProcInfo.hProcess)
CloseHandle (ProcInfo.hThread)
CloseHandle (hReadPipe1)
CloseHandle (hWritePipe1)
CloseHandle (hReadPipe2)
CloseHandle (hWritePipe2)
If CurrFolder <> "" Then
ChDrive GetDriveLetter(CurrFolder)
ChDir (CurrFolder)
End If
End Sub
Private Sub Command1_Click()
Dim strError As String
Dim strOutput As String
StartProcess "MyDosProgram.exe", App.Path, strOutput, strError
Text1 = strOutput
End Sub
要获得即时的DOS输出的内容（而不需等到程序结束），只需要在
strOutput = strOutput + Left(stdoutBuff, BytesRead)
上面这一行的后面加入：
Text1.SelText = Left(stdoutBuff, BytesRead)
即可。
gdami 2004-07-06
- 打赏
- 举报
个可以运行DOS程序（正确的说法应该是Windows下的控制台程序）并且捕捉程序输出的源程序。推荐下载。
我看过不少例子了,大同小异.都是用createprocess开启一个匿名管道获取的.微软msdn网站上面就有一篇文章.
这是一个例子:
http://www.applevb.com/sourcecode/Capture DOS Output.zip
我看过不少例子了,大同小异.都是用createprocess开启一个匿名管道获取的.微软msdn网站上面就有一篇文章.
这是一个例子:
http://www.applevb.com/sourcecode/Capture DOS Output.zip
gdami 2004-07-06
- 打赏
- 举报
可以建立一个命名的pipe吗?
我看到的例子都是匿名的pipe.但是一用createprocess开始运行dos命令,匿名管道就同时打开了.
可以在dos程序运行一段时间后,用别的方法连接一个pipe上去获取信息吗?
我看到的例子都是匿名的pipe.但是一用createprocess开始运行dos命令,匿名管道就同时打开了.
可以在dos程序运行一段时间后,用别的方法连接一个pipe上去获取信息吗?
蒋晟 2004-07-06
- 打赏
- 举报
MSKB Q173085 HOWTO: Create a Process for Reading and Writing to a Pipe
This example illustrates a Visual Basic application starting another process with the purpose of redirecting that process's standard IO handles. The Visual Basic application redirects the created process's standard output handle to an anonymous pipe, then proceeds to read the output through the pipe. This sample just redirects STDOUT of the new process. To redirect other handles (STDIN and STDERR), create a pipe for each handle for which redirection is desired. The Visual Basic application would read from the read ends of the pipes for the redirected STDOUT and STDERR. If STDIN redirection was desired, the Visual Basic application would write to the write end of the appropriate pipe.
This example illustrates a Visual Basic application starting another process with the purpose of redirecting that process's standard IO handles. The Visual Basic application redirects the created process's standard output handle to an anonymous pipe, then proceeds to read the output through the pipe. This sample just redirects STDOUT of the new process. To redirect other handles (STDIN and STDERR), create a pipe for each handle for which redirection is desired. The Visual Basic application would read from the read ends of the pipes for the redirected STDOUT and STDERR. If STDIN redirection was desired, the Visual Basic application would write to the write end of the appropriate pipe.
daisy8675 2004-07-06
- 打赏
- 举报
mark
liuyann 2004-07-06
- 打赏
- 举报
上面的方法,我试过了,不过主要问题是,重定向无法把stdout,stderr同时输出到一个文件.
