VB 结束进程

<---VB---->

'API函数

Private Declare Function CloseHandle Lib "Kernel32.dll " (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll " (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL " (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL " (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL " (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

 

'''根据进程名获取进程ID

Public Function GetProcessIdFromProcessName(ByVal strExeName As String) As Variant
'    On Error GoTo Err_Handle
        Const clMaxNumProcesses     As Long = 5000
        Const MAX_PATH = 260
        Const PROCESS_QUERY_INFORMATION = 1024
        Const PROCESS_VM_READ = 16
        Dim strModuleName     As String * MAX_PATH
        Dim strProcessNamePath     As String
        Dim strProcessName     As String
        Dim allMatchingProcessIDs()     As Long
        Dim alModules(1 To 400)         As Long
        Dim lBytesReturned     As Long
        Dim lNumMatching     As Long
        Dim lNumProcesses     As Long
        Dim lBytesNeeded     As Long
        Dim alProcIDs()     As Long
        Dim lHwndProcess     As Long
        Dim lThisProcess     As Long
        Dim lRet     As Long
On Error GoTo Err_Handle
        strExeName = UCase$(Trim$(strExeName))
        ReDim alProcIDs(clMaxNumProcesses * 4) As Long
        lRet = EnumProcesses(alProcIDs(1), clMaxNumProcesses * 4, lBytesReturned)
        lNumProcesses = lBytesReturned / 4
        ReDim Preserve alProcIDs(lNumProcesses)
        ReDim allMatchingProcessIDs(1 To lNumProcesses)
        For lThisProcess = 1 To lNumProcesses
                If lHwndProcess > 0 Then lRet = CloseHandle(lHwndProcess)
                lHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, alProcIDs(lThisProcess))
                If lHwndProcess <> 0 Then
                      lRet = EnumProcessModules(lHwndProcess, alModules(1), 200&, lBytesNeeded)
                      If lRet <> 0 Then
                            lRet = GetModuleFileNameExA(lHwndProcess, alModules(1), strModuleName, MAX_PATH)
                            strProcessNamePath = Trim$(UCase$(Left$(strModuleName, lRet)))
                            strProcessName = Mid$(strProcessNamePath, InStrRev(strProcessNamePath, "/") + 1)
                            If strProcessName = strExeName Or strProcessName = UCase(strExeName) Then
                                  lNumMatching = lNumMatching + 1
                                  allMatchingProcessIDs(lNumMatching) = alProcIDs(lThisProcess)
                            End If
                      End If
                      If lHwndProcess > 0 Then lRet = CloseHandle(lHwndProcess)
                End If
        Next
        If lNumMatching Then
              ReDim Preserve allMatchingProcessIDs(1 To lNumMatching)
              GetProcessIdFromProcessName = allMatchingProcessIDs
        Else
              GetProcessIdFromProcessName = Empty
        End If
        Exit Function
       
Err_Handle:
        GetProcessIdFromProcessName = Empty
End Function

 

 

 

Private Sub Form_Load()

    If App.PrevInstance = True Then
    Dim hwndd As Variant
    Dim lngCurrentPid As Long
    lngCurrentPid = GetCurrentProcessId
   
    Dim i As Long
        If MsgBox("既に起動しています、再起動しますか。", vbYesNo, "多重起動禁止") = vbYes Then
            hwndd = GetProcessIdFromProcessName(App.EXEName + ".exe")
           
            For i = 1 To UBound(hwndd)
                If hwndd(i) <> lngCurrentPid Then
'                    Call Shell("ntsd -c q -p " + CStr(hwndd(i)), vbHide)   '''结束单个进程
                    Call Shell("TASKKILL /pid " + CStr(hwndd(i)) + " /T", vbHide) ''结束此进程及相关子进程
                End If
            Next i

        Else
            Unload Me
            Exit Sub
        End If
    End If
End Sub