问杀死VB6中其他用户拥有的进程

EN

Const MAX_PATH& = 260


Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    LuidUDT As LUID
    Attributes As Long
End Type

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const PROCESS_ALL_ACCESS = &H1F0FFF

Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As Any, ReturnLength As Any) 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 * MAX_PATH
End Type

     Public Function KillApp(myName As String) As Boolean
    On Error GoTo HandleError

    Const TH32CS_SNAPPROCESS As Long = 2&
    Const PROCESS_ALL_ACCESS = 0
    Dim uProcess As PROCESSENTRY32
    Dim rProcessFound As Long
    Dim hSnapshot As Long
    Dim szExename As String
    Dim ExitCode As Long
    Dim myProcess As Long
    Dim AppKill As Boolean
    Dim appCount As Integer
    Dim i As Integer
    Dim processKilled As Boolean
    Dim WMI, QRY, ListOfProcesses, Item, ProcessUserName, colProperties

    appCount = 0

    uProcess.dwSize = Len(uProcess)
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    rProcessFound = ProcessFirst(hSnapshot, uProcess)

    Do While rProcessFound
        i = InStr(1, uProcess.szexeFile, Chr(0))
        szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
        If Right$(szExename, Len(myName)) = LCase$(myName) Then
            'set the queryfor the process object for this process
            QRY = "SELECT * FROM Win32_Process WHERE Name = '" + myName + "'"

            'Set up the Windows Management Instrumentation object
            Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}\\.\root\cimv2")

            Set ListOfProcesses = WMI.ExecQuery(QRY)

            For Each Item In ListOfProcesses
            'Get the user name
            colProperties = Item.GetOwner(ProcessUserName)
            'Only kill the processes if its not your user name
                If Not ProcessUserName = Environ("USERNAME") Then
                    KillApp = True
                    appCount = appCount + 1
                    myProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
                    processKilled = KillProcess(uProcess.th32ProcessID, 0)
                End If
            Next
        End If
    rProcessFound = ProcessNext(hSnapshot, uProcess)
    Loop

    Call CloseHandle(hSnapshot)

    Exit Function
    HandleError:
        bErrorHandler.Error_Handler_Debug Err.Number, "We have encountered an error while starting CAD. This is usually because there is another user logged on to this machine with CAD or Dispatch running and we could not close out there session. Please log off all other users and try to start CAD again. The following is an error message generated by the system: " + Err.Description, "frmCADMainMDI.KillApp"
    End Function

    Function KillProcess(ByVal hProcessID As Long, Optional ByVal ExitCode As Long) As Boolean
    On Error GoTo HandleError
    Dim htoken As Long
    Dim hProcess As Long
    Dim tp As TOKEN_PRIVILEGES


    If GetVersion() >= 0 Then

        If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, htoken) = 0 Then
            GoTo CleanUp
        End If

        If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
            GoTo CleanUp
        End If

        tp.PrivilegeCount = 1
        tp.Attributes = SE_PRIVILEGE_ENABLED

        If AdjustTokenPrivileges(htoken, False, tp, 0, ByVal 0&, ByVal 0&) = 0 Then
            GoTo CleanUp
        End If
    End If

    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
    If hProcess Then
        KillProcess = (TerminateProcess(hProcess, ExitCode) <> 0)
        ' close the process handle
        CloseHandle hProcess
    End If

    If GetVersion() >= 0 Then
        ' under NT restore original privileges
        tp.Attributes = 0
        AdjustTokenPrivileges htoken, False, tp, 0, ByVal 0&, ByVal 0&
    End If

    CleanUp:
    If htoken Then
        CloseHandle htoken
    End If

    Exit Function
    HandleError:
        bErrorHandler.Error_Handler_Debug Err.Number, Err.Description, "frmCADMainMDI.KillProcess"
    End Function