vb6:如何从 vb6 运行程序并在完成后关闭它? [英] vb6: how to run a program from vb6 and close it once it finishes?

问题描述

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

basically vb6 launches a process but the problem is closing it when it finishes.

shell "something.exe"

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

when the external program displays msgbox saying "finished", it can be closed. however when it displays the msgbox, the process is still running in taskmgr.

如何检测msgbox并杀死程序?

how to detect the msgbox and killing the program ?

推荐答案

试试这个

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

这篇关于vb6:如何从 vb6 运行程序并在完成后关闭它?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！