怎样判断用Shell调用的Dos的命令还在运行？

Question

程序中用Shell调用一个Dos的命令，过一段时间后，需要再次调用该Dos命令。我想在第二次调用前，判断Dos命令的运行状态，如果它还在运行，就不再调用，否则再次调用。

Answer 1

'=================================================================================
'多媒体程序操作API申明及常量、变量申明
Public lpDxrHandle, hDxrProcess, lpDxrExitCode As Long
        '多媒体（start.exe）句柄、进程、状况
Global Const Process_info = &H400       '
Global Const still_active = &H103       '进程处于Active状态
'获取进程句柄、销毁进程、获取进程状态
Public Declare Function OpenProcess Lib "KERNEL32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function TerminateProcess Lib "KERNEL32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function GetExitCodeProcess Lib "KERNEL32" (ByVal hProcess As Long, lpExitCode As Long) As Long'==========================================================================================================
'检测多媒体程序是否仍活动
'参数       lProcess:多媒体程序进程ID
'返回值     True:成功
Public Function dxrActive(ByVal lProcess As Long) As Boolean
    GetExitCodeProcess lProcess, lpDxrExitCode
    If lpDxrExitCode = still_active Then dxrActive = True
    Else: dxrActive = False
End Function'==========================================================================================================
'调用播放多媒体程序（start.exe）
'lpDxrHandle句柄
'hDxrProcess进程ID
'lpDxrExitlCode
'返回值     多媒体程序进程ID:不等于0成功
Public Function playDxr() As Long
Dim hProcess As Long
On Error GoTo err_check:
    If (dxrActive(hDxrProcess)) Then   '已存在
        Exit Function
    Else
        lpDxrHandle = Shell(App.Path & "\includes\多媒体\start.exe")    '取得句柄
        hProcess = OpenProcess(Process_info, False, lpDxrHandle)     '取得进程ID
    End If
    playDxr = hProcess
    Exit Function
err_check:
    Err.Clear
End Function'==========================================================================================================
'销毁多媒体程序
'参数       lProcess:多媒体程序进程ID
'返回值     True:成功
Public Function terminateDxr(ByVal lProcess As Long) As Boolean
On Error Resume Next
    If (dxrActive(lProcess)) Then      '
        terminateDxr = TerminateProcess(lProcess, 0&)
        lpDxrHandle = 0
    Else
        terminateDxr = True
    End If
End Function

Answer 2

判断一个被Shell的程序进程是否结束
http://wlbookwl.myrice.com/jck/1027shell.htm

Answer 3

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 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 Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFF      '  Infinite timeout
Private Sub Command1_Click()
    Dim pId As Long, pHnd As Long
    
    pId = Shell("notepad", vbHide)
    
    pHnd = OpenProcess(SYNCHRONIZE, 0, pId)
    
    If pHnd <> 0 Then    '程序未结束
        '无限等待,知道程序结束
        Call WaitForSingleObject(pHnd, INFINITE)
        Call CloseHandle(pHnd)
    End If
End Sub