Change the Priority of any Process

[THEROB]

This code finds a process then changes its priority. It only works in windows 2000 / XP. Changing the priority can have some bad consequences - it may even cause the process to crash!

Enjoy

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID 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 Const PROCESS_QUERY_INFORMATION = &H400
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const PROCESS_ALL_ACCESS = 0
Private Const PROCESS_SET_INFORMATION = &H200
 
Private Const IDLE_PRIORITY_CLASS = &H40
Private Const BELOW_NORMAL_PRIORITY_CLASS = &H4000
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const REALTIME_PRIORITY_CLASS = &H100 'please don't use this
 
Private Const MAX_PATH& = 260
 
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
 
Function ChangePriority(sProcessName As String, lngPriority As Long) As Boolean
 
    On Error GoTo errHnd
    Dim hProcess As Long
    Dim iRet As Long
 
    'Find the process we want to change priority
    hProcess = FindProcessId(sProcessName)
    If hProcess <> 0 Then
        ' Get the current Priority
        iRet = GetPriorityClass(hProcess)
        'If the priority is different then change
    
        If iRet <> lngPriority Then
            iRet = SetPriorityClass(hProcess, lngPriority)
            ChangePriority = (iRet <> 0)
        Else
            ChangePriority = True
        End If
    End If
    
    Call CloseHandle(hProcess)
    
    Exit Function
errHnd:
    ChangePriority = False
End Function
 
Public Function FindProcessId(sProcessName As String) As Long
    Dim uProcess As PROCESSENTRY32
    Dim rProcessFound As Long
    Dim hSnapshot As Long
    Dim szExename As String
    Dim hProcess As Long
    On Local Error GoTo errHnd
   
    uProcess.dwSize = Len(uProcess)
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    rProcessFound = ProcessFirst(hSnapshot, uProcess)
    'loop around all processes until found
   
    Do While rProcessFound
        szExename = StripNulls(uProcess.szexeFile)
        If LCase$(szExename) = LCase$(sProcessName) Then
            hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_SET_INFORMATION, False, uProcess.th32ProcessID)
    
            FindProcessId = hProcess
            Call CloseHandle(hSnapshot)
                
            Exit Function
        End If
        rProcessFound = ProcessNext(hSnapshot, uProcess)
    Loop
          
    Call CloseHandle(hSnapshot)
    Exit Function
    
errHnd:
    FindProcessId = 0
End Function
Private Function StripNulls(s As String) As String
    Dim i As Long
    i = InStr(1, s, Chr$(0))
    StripNulls = Trim$(Left$(s, i - 1))
End Function
Private Sub Form_Load()
    'load notepad and set its priority to be low
    Shell "notepad.exe"
    
    ChangePriority "notepad.exe", IDLE_PRIORITY_CLASS
 
End Sub