Rem Attribute VBA_ModuleType=VBADocumentModule

Option VBASupport 1
' TaskManager.xls v0.1.0
' Non-exhaustive list of sources:
' http://www.ex-designz.net/apidetail.asp?api_id=351
' http://www.xtremevbtalk.com/archive/index.php/t-248755.html
' http://msdn.microsoft.com/en-us/library/ms684335%28v=vs.85%29.aspx
'
' http://didierstevens.com
' Use at your own risk
'
' Shortcommings, or todo's ;-)
'
' History:
' 2011/02/02: start
' 2011/02/04: v0.0.2 added GetTimes
' 2011/02/21: v0.0.3 added GetType
' 2011/02/22: added GetProcessFilename
' 2011/02/23: added AdjustTokenForDebug
' 2011/10/09: v0.1.0 added support for 64-bit Excel

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 PROCESS_VM_READ = &H10
Private Const THREAD_SUSPEND_RESUME = &H2
Private Const TOKEN_QUERY = &H8
Private Const TokenUser = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const SE_PRIVILEGE_ENABLED = &H2

#If Win64 Then

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32DefaultHeapIDB As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
pcPriClassBaseB As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
#Else
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
#End If

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 Type FILETIME

dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type SYSTEMTIME

wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

#If Win64 Then

Private Type SYSTEM_INFO
wProcessorArchitecture As Integer
wReserved As Integer
lpMinimumApplicationAddress As LongPtr
lpMaximumApplicationAddress As LongPtr
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Long
wProcessorRevision As Long
End Type
#Else
Private Type SYSTEM_INFO
wProcessorArchitecture As Integer
wReserved As Integer
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Long
wProcessorRevision As Long
End Type
#End If

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

#If Win64 Then

Private Declare PtrSafe Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As LongLong,
ByVal lProcessID As LongLong) As LongPtr
Private Declare PtrSafe Sub CloseHandle Lib "kernel32" (ByVal hPass As LongPtr)
Private Declare PtrSafe Function Process32First Lib "kernel32" (ByVal hSnapshot As LongPtr, sPE32 As
PROCESSENTRY32) As Long
Private Declare PtrSafe Function Process32Next Lib "kernel32" (ByVal hSnapshot As LongPtr, sPE32 As
PROCESSENTRY32) As Long
Private Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long,
ByVal bInheritHandle As Boolean, ByVal dwProcId As Long) As LongPtr
Private Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As LongPtr, ByVal
uExitCode As Long) As Long
Private Declare PtrSafe Function Thread32First Lib "kernel32" (ByVal hSnapshot As LongPtr, uProcess
As THREADENTRY32) As Long
Private Declare PtrSafe Function Thread32Next Lib "kernel32" (ByVal hSnapshot As LongPtr, uProcess
As THREADENTRY32) As Long
Private Declare PtrSafe Function OpenThread Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal
bInheritHandle As Boolean, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function SuspendThread Lib "kernel32.dll" (ByVal hThread As LongPtr) As
Integer
Private Declare PtrSafe Function ResumeThread Lib "kernel32.dll" (ByVal hThread As LongPtr) As
Integer
Private Declare PtrSafe Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As
LongPtr, ByVal DesiredAccess As Long, ByRef TokenHandle As LongPtr) As Long
Private Declare PtrSafe Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As
LongPtr, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength
As Long, ByRef ReturnLength As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pTo As Any,
ByRef uFrom As Any, ByVal lSize As LongLong)
Private Declare PtrSafe 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 Declare PtrSafe Function GetProcessTimes Lib "kernel32" (ByVal hProcess As LongPtr,
lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME)
As Long
Private Declare PtrSafe Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME,
lpLocalFileTime As FILETIME) As Long
Private Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME,
lpSystemTime As SYSTEMTIME) As Long
Private Declare PtrSafe Function IsWow64Process Lib "kernel32" (ByVal hProcess As LongPtr, ByRef
Wow64Process As Long) As Long
Private Declare PtrSafe Sub GetNativeSystemInfo Lib "kernel32" (ByRef lpSystemInfo As SYSTEM_INFO)
Private Declare PtrSafe Function GetProcessImageFileName Lib "psapi" Alias
"GetProcessImageFileNameA" (ByVal hProcess As LongPtr, ByVal lpFilename As String, ByVal nSize As
LongLong) As Long
Private Declare PtrSafe Function K32GetProcessImageFileName Lib "kernel32" Alias
"K32GetProcessImageFileNameA" (ByVal hProcess As LongPtr, ByVal lpFilename As String, ByVal nSize As
LongLong) As Long
Private Declare PtrSafe Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal
lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr
Private Declare PtrSafe Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA"
(ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare PtrSafe Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As LongPtr,
ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long,
PreviousState As Any, ReturnLength As Any) As Long
#Else
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 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 Declare Function GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, lpCreationTime As
FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME,
lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime
As SYSTEMTIME) As Long
Private Declare Function IsWow64Process Lib "kernel32" (ByVal hProcess As Long, ByRef
Wow64Process As Long) As Long
Private Declare Sub GetNativeSystemInfo Lib "kernel32" (ByRef lpSystemInfo As SYSTEM_INFO)
Private Declare Function GetProcessImageFileName Lib "psapi" Alias "GetProcessImageFileNameA"
(ByVal hProcess As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function K32GetProcessImageFileName Lib "kernel32" Alias
"K32GetProcessImageFileNameA" (ByVal hProcess As Long, ByVal lpFilename As String, ByVal nSize As
Long) As Long
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal
lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () 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
#End If

Private dicDevices As Dictionary

Private Function StartsWith(ByVal strValue As String, ByVal strStartingValue As String) As Boolean

StartsWith = Left(strValue, Len(strStartingValue)) = strStartingValue
End Function

Private Function EndsWith(ByVal strValue As String, ByVal strEndingValue As String) As Boolean

EndsWith = Right(strValue, Len(strEndingValue)) = strEndingValue
End Function

Private Function GetProcessOwner(ByVal lProcessID As Long) As String

#If Win64 Then
Dim hProcess As LongPtr
Dim hToken As LongPtr
#Else
Dim hProcess As Long
Dim hToken As Long
#End If
Dim lAccountName As Long
Dim lDomainName As Long
 Dim peUse As Long
Dim lNeeded As Long
Dim abBuffer() As Byte
Dim lpSid As Long
Dim lpString As Long
Dim strAccountName As String
Dim strDomainName As String

GetProcessOwner = ""
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 CLng(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, CLng(lAccountName))
Else
GetProcessOwner = Left(strDomainName, CLng(lDomainName)) & "\" &
Left(strAccountName, CLng(lAccountName))
End If
End If
End If
Call CloseHandle(hToken)
End If
CloseHandle hProcess
End If
End Function

Private Function GetTimes(ByVal lProcessID As Long)

#If Win64 Then
Dim hProcess As LongPtr
#Else
Dim hProcess As Long
#End If
Dim sFTCreation As FILETIME
Dim sFTDummy As FILETIME
Dim sFTCreationLocal As FILETIME
Dim sSTCreation As SYSTEMTIME

GetTimes = ""
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lProcessID)
If hProcess <> 0 Then
If GetProcessTimes(hProcess, sFTCreation, sFTDummy, sFTDummy, sFTDummy) <> 0 Then
If FileTimeToLocalFileTime(sFTCreation, sFTCreationLocal) <> 0 Then
If FileTimeToSystemTime(sFTCreationLocal, sSTCreation) <> 0 Then
GetTimes = CStr(sSTCreation.wYear) + "/" + CStr(sSTCreation.wMonth) + "/" +
CStr(sSTCreation.wDay) + " " + CStr(sSTCreation.wHour) + ":" + CStr(sSTCreation.wMinute) + ":" +
CStr(sSTCreation.wSecond)
End If
End If
End If
CloseHandle hProcess
End If
End Function

Private Function GetType(ByVal lProcessID As Long)

#If Win64 Then
Dim hProcess As LongPtr
#Else
Dim hProcess As Long
#End If
Dim lWoW64 As Long
Dim sSI As SYSTEM_INFO

GetType = ""
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lProcessID)
If hProcess <> 0 Then
If IsWow64Process(hProcess, lWoW64) Then
GetNativeSystemInfo sSI
GetType = IIf(sSI.wProcessorArchitecture > 0 And lWoW64 = 0, "64", "32")
End If
CloseHandle hProcess
End If
End Function

Private Function Device2DriveFilename(ByVal strFilename As String) As String

Dim varKeyDevice As Variant

Device2DriveFilename = strFilename
For Each varKeyDevice In dicDevices.Keys
If StartsWith(strFilename, varKeyDevice) Then
Device2DriveFilename = dicDevices(varKeyDevice) & Mid(strFilename, Len(varKeyDevice) + 1)
End If
Next
End Function

Private Function GetProcessFilename(ByVal lProcessID As Long)

#If Win64 Then
Dim hProcess As LongPtr
#Else
Dim hProcess As Long
#End If
Dim lLength As Long
Dim strBuffer As String

GetProcessFilename = ""
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcessID)
If hProcess <> 0 Then
strBuffer = Space(MAX_PATH)
Err.Clear
On Error Resume Next
lLength = GetProcessImageFileName(hProcess, strBuffer, Len(strBuffer))
If Err.Number = 453 Then
lLength = K32GetProcessImageFileName(hProcess, strBuffer, Len(strBuffer))
End If
On Error GoTo 0
GetProcessFilename = Device2DriveFilename(Left(strBuffer, CLng(lLength)))
CloseHandle hProcess
End If
End Function

Private Function GetDevices() As Dictionary

Dim intIter As Integer
Dim strBuffer As String
Dim lLength As Long
Dim dicDevices As Dictionary

Set dicDevices = New Dictionary

Set GetDevices = dicDevices
For intIter = Asc("A") To Asc("Z")
strBuffer = Space(MAX_PATH)
lLength = QueryDosDevice(Chr(intIter) & ":", strBuffer, Len(strBuffer))
If lLength > 0 Then
dicDevices.Add Left(strBuffer, InStr(strBuffer, vbNullChar) - 1), Chr(intIter) & ":"
 End If
Next
End Function

Private Sub ProcessListToSheet(oCell)

#If Win64 Then
Dim hSnapshot As LongPtr
#Else
Dim hSnapshot As Long
#End If
Dim lRet As Long
Dim sPE32 As PROCESSENTRY32
Dim strProcess As String
Dim iIter As Integer
Dim iColumn As Integer
Dim iPositionNull As Integer

AdjustTokenForDebug

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 = GetProcessFilename(sPE32.th32ProcessID)
Cells(iIter, iColumn + 3).Value = GetProcessOwner(sPE32.th32ProcessID)
Cells(iIter, iColumn + 4).Value = GetTimes(sPE32.th32ProcessID)
Cells(iIter, iColumn + 5).Value = GetType(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)

#If Win64 Then
Dim hSnapshot As LongPtr
Dim hThread As LongPtr
#Else
Dim hSnapshot As Long
Dim hThread As Long
#End If
Dim lRet As Long
Dim sTE32 As THREADENTRY32

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)

#If Win64 Then
Dim hProcess As LongPtr
#Else
Dim hProcess As Long
#End If

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

AdjustTokenForDebug

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

Private Sub AdjustTokenForDebug()

#If Win64 Then
Dim hToken As LongPtr
#Else
Dim hToken As Long
#End If
Dim sTP As TOKEN_PRIVILEGES

If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) <>

0 Then
If LookupPrivilegeValue("", "SeDebugPrivilege", sTP.LuidUDT) <> 0 Then
sTP.PrivilegeCount = 1
sTP.Attributes = SE_PRIVILEGE_ENABLED
 If AdjustTokenPrivileges(hToken, False, sTP, 0, ByVal 0&, ByVal 0&) <> 0 Then
End If
End If
CloseHandle hToken
End If

End Sub

Sub MacroProcessList()
Range("A7:G65000").ClearContents
Set dicDevices = GetDevices()
ProcessListToSheet Range("B7")
Range("A6:G65000").Sort "Process executable", xlAscending, header:=xlYes
End Sub

Sub MacroExecuteCommands()
ExecuteCommands Range("A7")
End Sub