敬请问各们高手。在VB中如何关闭由ShellExecute开打的外部程序?
非常感谢!!

解决方案 »

  1.   

    Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
    Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
    Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
        ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As LongPrivate Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, _
        ByVal uExitCode As Long) As Long
    Private Type PROCESSENTRY32
        dwSize As Long
        cntUsage As Long
        th32ProcessID As Long
        th32DefaultHeapID As Long
        th32ModuleID As Long
        cntThreads As Long
        th32ParentProcessID As Long
        pcPriClassBase As Long
        dwFlags As Long
        szExeFile As String * 1024
    End TypeConst TH32CS_SNAPHEAPLIST = &H1
    Const TH32CS_SNAPPROCESS = &H2
    Const TH32CS_SNAPTHREAD = &H4
    Const TH32CS_SNAPMODULE = &H8
    Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
    Const TH32CS_INHERIT = &H80000000Dim pid As Long
    Private Sub Command1_Click()
      Dim my As PROCESSENTRY32
      Dim l As Long
      Dim l1 As Long
      Dim mName As String
      Dim i As Integer  l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
      If l Then
        my.dwSize = 1060
        If (Process32First(l, my)) Then '遍历第一个进程
          Do
                 i = InStr(1, my.szExeFile, Chr(0))
                 mName = LCase(Left(my.szExeFile, i - 1))
            If Trim(mName) = "XXX.exe" Then                    '这里填你调用的程序进程名
                 pid = my.th32ProcessID
                Dim mProcID As Long
                mProcID = OpenProcess(1&, -1&, pid)
                TerminateProcess mProcID, 0&
                Exit Sub
            End If
          Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False
        End If
        l1 = CloseHandle(l)
      End If
    End Sub
      

  2.   

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
    Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) 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
    Const GW_HWNDNEXT = 2
    Dim mWnd As Long
    Function InstanceToWnd(ByVal target_pid As Long) As Long
        Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
        'Find the first window
        test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
        Do While test_hwnd <> 0
            'Check if the window isn't a child
            If GetParent(test_hwnd) = 0 Then
                'Get the window's thread
                test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
                If test_pid = target_pid Then
                    InstanceToWnd = test_hwnd
                    Exit Do
                End If
            End If
            'retrieve the next window
            test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
        Loop
    End Function
    Private Sub Form_Load()
        Dim Pid As Long
        'Execute notepad.Exe
        Pid = Shell("c:\win\notepad.exe", vbNormalFocus)
        If Pid = 0 Then MsgBox "Error starting the app"
        'retrieve the handle of the window
        mWnd = InstanceToWnd(Pid)
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
        'Unload notepad
        DestroyWindow mWnd
        'End this program
        TerminateProcess GetCurrentProcess, 0
    End Subprivate sub command1_click()
        postMessage mwnd,WM_CLOSE,byval 0,byval 0
    end sub
      

  3.   

    ShellExecute 可能返回的是打开进程的句柄
    如果在98的话, terminateprocess 返回值,0
    尝试下