Code:
Option Explicit
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_INHERIT = &H80000000
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1&
Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const THREAD_SUSPEND_RESUME = &H2
Private Const TOKEN_QUERY = &H8
Private Const TokenUser = 1
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
Private Type THREADENTRY32
dwSize As Long
cntUsage As Long
th32ThreadID As Long
rh32OwnerProcessID As Long
tpBasePri As Long
tpDeltaPri As Long
dwFlags As Long
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, sPE32 As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, sPE32 As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Boolean, ByVal dwProcId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function Thread32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As THREADENTRY32) As Long
Private Declare Function Thread32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As THREADENTRY32) As Long
Private Declare Function OpenThread Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Boolean, ByVal dwThreadId As Long) As Long
Private Declare Function SuspendThread Lib "kernel32.dll" (ByVal hThread As Long) As Integer
Private Declare Function ResumeThread Lib "kernel32.dll" (ByVal hThread As Long) As Integer
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ByRef ReturnLength As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pTo As Any, ByRef uFrom As Any, ByVal lSize As Long)
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Function GetProcessOwner(ByVal lProcessID As Long) As String
Dim hProcess As Long
Dim hToken As Long
Dim lNeeded As Long
Dim abBuffer() As Byte
Dim lpSid As Long
Dim lpString As Long
Dim strAccountName As String
Dim lAccountName As Long
Dim strDomainName As String
Dim lDomainName As Long
Dim peUse As Long
GetProcessOwner = "Unknown"
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lProcessID)
If hProcess <> 0 Then
If OpenProcessToken(hProcess, TOKEN_QUERY, hToken) <> 0 Then
GetTokenInformation hToken, TokenUser, 0, 0, lNeeded
ReDim abBuffer(0 To lNeeded)
If GetTokenInformation(hToken, TokenUser, abBuffer(0), UBound(abBuffer), lNeeded) = 1 Then
CopyMemory lpSid, abBuffer(0), 4
strAccountName = Space(MAX_PATH)
strDomainName = Space(MAX_PATH)
lAccountName = MAX_PATH
lDomainName = MAX_PATH
If LookupAccountSid(vbNullString, lpSid, strAccountName, lAccountName, strDomainName, lDomainName, peUse) <> 0 Then
If strDomainName = "" Then
GetProcessOwner = Left(strAccountName, lAccountName)
Else
GetProcessOwner = Left(strDomainName, lDomainName) & "\" & Left(strAccountName, lAccountName)
End If
End If
End If
Call CloseHandle(hToken)
End If
CloseHandle hProcess
End If
End Function
Private Sub ProcessListToSheet(oCell)
Dim hSnapshot As Long
Dim sPE32 As PROCESSENTRY32
Dim lRet As Long
Dim strProcess As String
Dim iIter As Integer
Dim iColumn As Integer
Dim iPositionNull As Integer
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapshot <> INVALID_HANDLE_VALUE Then
sPE32.dwSize = Len(sPE32)
lRet = Process32First(hSnapshot, sPE32)
iIter = oCell.Row
iColumn = oCell.Column
Do While lRet
iPositionNull = InStr(1, sPE32.szExeFile, Chr(0))
If iPositionNull > 0 Then
strProcess = Left(sPE32.szExeFile, iPositionNull - 1)
Else
strProcess = ""
End If
Cells(iIter, iColumn).Value = strProcess
Cells(iIter, iColumn + 1).Value = sPE32.th32ProcessID
Cells(iIter, iColumn + 2).Value = GetProcessOwner(sPE32.th32ProcessID)
iIter = iIter + 1
lRet = Process32Next(hSnapshot, sPE32)
Loop
CloseHandle hSnapshot
End If
End Sub
Private Sub SuspendProcessByID(ByVal lProcessID As Long, ByVal bSuspend As Boolean)
Dim hSnapshot As Long
Dim sTE32 As THREADENTRY32
Dim hThread As Long
Dim lRet As Long
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0&)
If hSnapshot <> INVALID_HANDLE_VALUE Then
sTE32.dwSize = Len(sTE32)
lRet = Thread32First(hSnapshot, sTE32)
Do While lRet
If sTE32.rh32OwnerProcessID = lProcessID Then
hThread = OpenThread(THREAD_SUSPEND_RESUME, False, sTE32.th32ThreadID)
If hThread <> 0 Then
If bSuspend Then
SuspendThread hThread
Else
ResumeThread hThread
End If
CloseHandle hThread
End If
End If
lRet = Thread32Next(hSnapshot, sTE32)
Loop
CloseHandle hSnapshot
End If
End Sub
Private Sub TerminateProcessByID(ByVal lProcessID As Long)
Dim hProcess As Long
hProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)
If hProcess <> 0 Then
TerminateProcess hProcess, 0
CloseHandle hProcess
End If
End Sub
Private Sub ExecuteCommands(oCell)
Dim iIter As Integer
Dim iColumn As Integer
iIter = oCell.Row
iColumn = oCell.Column
Do While Cells(iIter, iColumn + 1).Value <> ""
Select Case LCase(Cells(iIter, iColumn).Value)
Case "t":
TerminateProcessByID Cells(iIter, iColumn + 2).Value
Case "s":
SuspendProcessByID Cells(iIter, iColumn + 2).Value, True
Case "r":
SuspendProcessByID Cells(iIter, iColumn + 2).Value, False
End Select
iIter = iIter + 1
Loop
End Sub
Sub MacroProcessList()
Range("A7:D65000").ClearContents
ProcessListToSheet Range("B7")
Range("A6:D65000").Sort "Process executable", xlAscending, header:=xlYes
End Sub
Sub MacroExecuteCommands()
ExecuteCommands Range("A7")
End Sub