说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

如何判定VB调用的一个EXE程序已经结束.

HTML文档下载 WORD文档下载 PDF文档下载
如何判定VB调用的一个EXE程序已经结束.
- noname
回答:
新建一个项目,添加命令按钮和标签各一个,加上以下代码,然后运行....
Option Explicit
' Copyright ? 1997 by Desaware Inc. All Rights Reserved
Dim DemoFile$
Private Const NORMAL_PRIORITY_CLASS = &H20 '如果进程位于前台,则基本
值是9;如果在后台,则优先值为7
Private Const INFINITE = &HFFFFFFFF
Private Const WAIT_TIMEOUT = &H102& '对象保持未发出信号的状态,
但等待超时时间已经超过

'说明∶PROCESS_INFORMATION结构由CreateProcess函数将关于新建立的进程和
'主要线索的信息写入其中成员变量
Private Type PROCESS_INFORMATION '
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

'说明∶STARTUPINFO结构用在CreateProcess函数中指定为新进程建立的新窗口的
主要属性。这一
'一信息影响由CreateWindows函数建立的第一个窗口
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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As
Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "
CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine
As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes
As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long,
lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo
As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess
As Long, ByVal dwMilliseconds As Long) As Long




Private Sub command1_Click()
Dim res&
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
sinfo.cb = Len(sinfo)
sinfo.lpReserved = vbNullString
sinfo.lpDesktop = vbNullString
sinfo.lpTitle = vbNullString
sinfo.dwFlags = 0

Label1.Caption = "正在启动程序"
Label1.Refresh
' CreateProcess函数,用于创建一个新的进程
res = CreateProcess(DemoFile, vbNullString, 0, 0, True, _
NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString,
sinfo, pinfo)
If res Then
Label1.Caption = "程序正在运行"
WaitForTerm pinfo
End If
Label1.Caption = "程序已经结束"

End Sub

Private Sub WaitForTerm(pinfo As PROCESS_INFORMATION)
Dim res&
' 等待指定的进程进入空闲状态,,空闲(Idle)指的是进程准备处理
'一条消息、但目前暂时没有消息需要处理的一种状态
Call WaitForInputIdle(pinfo.hProcess, INFINITE)
' 关闭指定进程
Call CloseHandle(pinfo.hThread)
Command1.Enabled = False
Label1.Refresh
Do
'等待发出信号
res = WaitForSingleObject(pinfo.hProcess, 0)
If res <> WAIT_TIMEOUT Then '如果对象发出了信号
Exit Do
End If
DoEvents
Loop While True
Command1.Enabled = True
Call CloseHandle(pinfo.hProcess)
End Sub

Private Sub Form_Load()
DemoFile = InputBox$("请输入需要运行的程序名", , "C:\WINDOWS\notepad.
exe")
End Sub
-星泽(xing) vbxing@990.net

回答二:
例程如下:

Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal
dwDesiredAccess
As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal
hProcess
As Long, _
lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As
Long)
As Long

Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STATUS_PENDING = &H103

Private Sub RunShell(cmdline As String)
Dim hProcess As Long
Dim ProcessId As Long
Dim ExitCode As Long
ProcessId = Shell(cmdline, 1)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId)
Do
Call GetExitCodeProcess(hProcess, ExitCode)
DoEvents
Loop While ExitCode = STATUS_PENDING
Call CloseHandle(hProcess)
MsgBox cmdline & "已经关闭"
End Sub

Private Sub Command1_Click()
RunShell "c:\windows\notepad.exe"
End Sub

备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘