读取外部程序运行窗口的内容

[追风少年杨德明]

我调用外部程序程序，运行时会出现这个界面，我想读取运行界面里面的计算进度和时间，不知道该怎么读取，其次是假如VB 在调用时，程序运行一般崩溃了，想在VB中出现提示框如“你输出的数据有误请重新计算”，最后在返回到主界面form2重新输入数据在调用程序计算。如果完美解决可有偿或者追加积分。

[东方之珠]

你上面那个界面是不是CMD运行窗口，如果是可采用管道通信技术。

[东方之珠]

参考一下我用的这个：https://bbs.csdn.net/topics/396125019

[追风少年杨德明]

引用 2 楼 东方之珠 的回复：

参考一下我用的这个：https://bbs.csdn.net/topics/396125019

我现在读出来了，但是整个屏幕的内容都出现了，我只想读进度和时间，不知道可不可以

[东方之珠]

引用 3 楼 追风少年杨德明 的回复:

引用 2 楼 东方之珠 的回复：

参考一下我用的这个：https://bbs.csdn.net/topics/396125019

我现在读出来了，但是整个屏幕的内容都出现了，我只想读进度和时间，不知道可不可以

可以的，截取时间和进度，其他的不要。

[追风少年杨德明]

Option Explicit
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, 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 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 CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As SECURITY_ATTRIBUTES, ByVal lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, ByVal lpStartupInfo As STARTUPINFO, ByVal lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const STARTF_USESTDHANDLES = &H100
Private Const STARTF_USESHOWWINDOW = &H1

Private Function ExecuteCommandLineOutput(commandline As String, Optional BufferSize As Long = 256, Optional TimeOut As Long) As String

Dim Proc As PROCESS_INFORMATION
Dim Start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long
Dim hWritePipe As Long
Dim lBytesRead As Long
Dim sBuffer As String

If VBA.Len(commandline) > 0 Then
sa.nLength = Len(sa)

'sa.nLength = vba.Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
If CreatePipe(hReadPipe, hWritePipe, sa, 0) > 0 Then
Start.cb = Len(Start)
Start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
Start.hStdOutput = hWritePipe
Start.hStdError = hWritePipe
If CreateProcessA(0&, commandline, sa, sa, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, Proc) = 1 Then
CloseHandle hWritePipe
sBuffer = VBA.String(BufferSize, VBA.Chr(0))
If TimeOut > 0 Then
Dim BeginTime As Date
BeginTime = VBA.Now
End If

Do Until ReadFile(hReadPipe, sBuffer, BufferSize, lBytesRead, 0&) = 0
DoEvents
If TimeOut < 0 Then
If DateDiff("s", BeginTime, VBA.Now) > TimeOut Then
ExecuteCommandLineOutput = "Timeout"
Exit Do
End If
End If
ExecuteCommandLineOutput = ExecuteCommandLineOutput & VBA.Trim(Replace(Left(sBuffer, lBytesRead), VBA.Chr(0), ""))
Text1.Text = ExecuteCommandLineOutput

Loop

CloseHandle Proc.hProcess
CloseHandle Proc.hThread
CloseHandle hReadPipe
Else
ExecuteCommandLineOutput = "File or command not found"
Text1.Text = ExecuteCommandLineOutput

End If
Else
ExecuteCommandLineOutput = "CreatePipe failed.Error:" & Err.LastDllError & "."
Text1.Text = ExecuteCommandLineOutput
End If
End If
End Function
Private Sub Command1_Click()
ExecuteCommandLineOutput "C:\Users\Administrator\Documents\Visual Studio 2010\Projects\Console12\Console12\Debug\Console12.exe"

End Sub



Private Sub Command2_Click()
Open "C:\GuangXiGuanQu\jieguo.txt" For Output As #1
Print #1, Text1.Text
Close #1
End Sub

Private Sub Form_Load()

End Sub

Private Sub Text1_Change()
Text1.SelStart = Len(Text1.Text)

End Sub

我是照着别人这样写的，但是把全部内容都读出来了，不知道怎么改才能只读进度和时间

[追风少年杨德明]

引用 5 楼 追风少年杨德明 的回复：

Option Explicit
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, 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 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 CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As SECURITY_ATTRIBUTES, ByVal lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, ByVal lpStartupInfo As STARTUPINFO, ByVal lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const STARTF_USESTDHANDLES = &H100
Private Const STARTF_USESHOWWINDOW = &H1

Private Function ExecuteCommandLineOutput(commandline As String, Optional BufferSize As Long = 256, Optional TimeOut As Long) As String

Dim Proc As PROCESS_INFORMATION
Dim Start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long
Dim hWritePipe As Long
Dim lBytesRead As Long
Dim sBuffer As String

If VBA.Len(commandline) > 0 Then
sa.nLength = Len(sa)

'sa.nLength = vba.Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
If CreatePipe(hReadPipe, hWritePipe, sa, 0) > 0 Then
Start.cb = Len(Start)
Start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
Start.hStdOutput = hWritePipe
Start.hStdError = hWritePipe
If CreateProcessA(0&, commandline, sa, sa, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, Proc) = 1 Then
CloseHandle hWritePipe
sBuffer = VBA.String(BufferSize, VBA.Chr(0))
If TimeOut > 0 Then
Dim BeginTime As Date
BeginTime = VBA.Now
End If

Do Until ReadFile(hReadPipe, sBuffer, BufferSize, lBytesRead, 0&) = 0
DoEvents
If TimeOut < 0 Then
If DateDiff("s", BeginTime, VBA.Now) > TimeOut Then
ExecuteCommandLineOutput = "Timeout"
Exit Do
End If
End If
ExecuteCommandLineOutput = ExecuteCommandLineOutput & VBA.Trim(Replace(Left(sBuffer, lBytesRead), VBA.Chr(0), ""))
Text1.Text = ExecuteCommandLineOutput

Loop

CloseHandle Proc.hProcess
CloseHandle Proc.hThread
CloseHandle hReadPipe
Else
ExecuteCommandLineOutput = "File or command not found"
Text1.Text = ExecuteCommandLineOutput

End If
Else
ExecuteCommandLineOutput = "CreatePipe failed.Error:" & Err.LastDllError & "."
Text1.Text = ExecuteCommandLineOutput
End If
End If
End Function
Private Sub Command1_Click()
ExecuteCommandLineOutput "C:\Users\Administrator\Documents\Visual Studio 2010\Projects\Console12\Console12\Debug\Console12.exe"

End Sub



Private Sub Command2_Click()
Open "C:\GuangXiGuanQu\jieguo.txt" For Output As #1
Print #1, Text1.Text
Close #1
End Sub

Private Sub Form_Load()

End Sub

Private Sub Text1_Change()
Text1.SelStart = Len(Text1.Text)

End Sub

我是照着别人这样写的，但是把全部内容都读出来了，不知道怎么改才能只读进度和时间

哥们有好的方法吗

[追风少年杨德明]

引用 4 楼 东方之珠 的回复：

引用 3 楼 追风少年杨德明 的回复:

[quote=引用 2 楼 东方之珠 的回复：]参考一下我用的这个：https://bbs.csdn.net/topics/396125019

我现在读出来了，但是整个屏幕的内容都出现了，我只想读进度和时间，不知道可不可以

可以的，截取时间和进度，其他的不要。[/quote]哥们有好的方法吗

[舉杯邀明月]

能读取到内容，那就从读取到的内容中把“需要的”那些文本分离出来不就行了？