vb6：如何从vb6运行一个程序并在完成后关闭它？

Question

基本上vb6启动一个进程，但问题是它完成时关闭它。

shell "something.exe" 

当外部程序显示msgbox说“已完成”时，它可以关闭。但是当它显示msgbox时，该进程仍在taskmgr中运行。

如何检测msgbox并查杀程序？

Answer 1

试试这个

Option Explicit 

'--- for CreateProcess 
Private Const NORMAL_PRIORITY_CLASS   As Long = &H20& 
Private Const STARTF_USESHOWWINDOW   As Long = 1 
Private Const SW_HIDE      As Long = 0 
Private Const SW_SHOWDEFAULT    As Long = 10 
Private Const ERROR_ELEVATION_REQUIRED  As Long = 740 
'--- for WaitForXxx 
Private Const INFINITE      As Long = &HFFFFFFFF 
'--- for ShellExecuteEx 
Private Const SEE_MASK_NOCLOSEPROCESS  As Long = &H40 

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, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long 
Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpExecInfo As SHELLEXECUTEINFO) As Long 
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds 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 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 Type SHELLEXECUTEINFO 
    cbSize    As Long 
    fMask    As Long 
    hWnd    As Long 
    lpVerb    As String 
    lpFile    As String 
    lpParameters  As String 
    lpDirectory   As Long 
    nShow    As Long 
    hInstApp   As Long 
    ' Optional fields 
    lpIDList   As Long 
    lpClass    As Long 
    hkeyClass   As Long 
    dwHotKey   As Long 
    hIcon    As Long 
    hProcess   As Long 
End Type 

Private Const MSG_ELEVATION_REQUIRED  As String = "To run %1 as administrator please confirm next elevation of rights" 

Public Function ShellWait(_ 
      ByVal sFile As String, _ 
      Optional sParams As String, _ 
      Optional ByVal bStartHidden As Boolean, _ 
      Optional oOwnerForm As VB.Form) As Long 
    Const FUNC_NAME  As String = "ShellWait" 
    Dim sCommandLine As String 
    Dim uInfo   As PROCESS_INFORMATION 
    Dim uStart   As STARTUPINFO 
    Dim lExitCode  As Long 
    Dim uShell   As SHELLEXECUTEINFO 
    Dim sFileName  As String 

    On Error GoTo EH 
    '--- win9x: fix spaces or not working on 9x 
    If InStr(sFile, " ") > 0 Then 
     sCommandLine = """" & sFile & """" & " " & sParams 
    Else 
     sCommandLine = sFile & " " & sParams 
    End If 
    uStart.cb = Len(uStart) 
    If bStartHidden Then 
     uStart.dwFlags = STARTF_USESHOWWINDOW 
     uStart.wShowWindow = SW_HIDE 
    End If 
    If CreateProcess(vbNullString, sCommandLine, 0, 0, 1, NORMAL_PRIORITY_CLASS, 0, vbNullString, uStart, uInfo) <> 0 Then 
     Call WaitForSingleObject(uInfo.hProcess, INFINITE) 
     If GetExitCodeProcess(uInfo.hProcess, lExitCode) <> 0 Then 
      ShellWait = lExitCode 
     End If 
     Call CloseHandle(uInfo.hThread) 
     Call CloseHandle(uInfo.hProcess) 
    Else 
     If Err.LastDllError = ERROR_ELEVATION_REQUIRED Then 
      If Not oOwnerForm Is Nothing Then 
       If InStrRev(sFile, "\") > 0 Then 
        sFileName = Mid(sFile, InStrRev(sFile, "\") + 1) 
       Else 
        sFileName = sFile 
       End If 
       MsgBox Replace(MSG_ELEVATION_REQUIRED, "%1", sFileName), vbExclamation 
       uShell.hWnd = oOwnerForm.hWnd 
      End If 
      With uShell 
       .cbSize = Len(uShell) 
       .fMask = SEE_MASK_NOCLOSEPROCESS 
       .lpVerb = "runas" 
       .lpFile = sFile 
       .lpParameters = sParams 
       .nShow = IIf(bStartHidden, SW_HIDE, SW_SHOWDEFAULT) 
      End With 
      If ShellExecuteEx(uShell) Then 
       Call WaitForSingleObject(uShell.hProcess, INFINITE) 
       If GetExitCodeProcess(uShell.hProcess, lExitCode) <> 0 Then 
        ShellWait = lExitCode 
       End If 
       Call CloseHandle(uShell.hProcess) 
      End If 
     End If 
    End If 
    Exit Function 
EH: 
    Debug.Print FUNC_NAME; ": "; Error 
    Resume Next 
End Function 

Private Sub Command1_Click() 
    MsgBox "Exit code = " & ShellWait("cmd"), vbExclamation 
End Sub 

Answer 2

如果您知道程序的标题或类名称，则可以使用FindWindow和PostMessage API调用关闭它。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Private Const WM_CLOSE = &H10 

Dim hwnd As Long 
hwnd = FindWindow(vbNullString, "WINDOW CAPTION HERE") 
PostMessage hwnd, WM_CLOSE, CLng(0), CLng(0)