Setting Thread and Class Priorities in a VB App

Simple standard module for setting the priority of the your app's process. Useful for screen savers so that they don't tie up the processor when another app is running an unattended task.
Caution: The VB IDE and its Projects share the same process space. When experimenting with this in the IDE make sure that you exit gracefully so that the priorities can be returned to normal (i.e. don't hit the stop button).

Download source code with a test app (3KB)

Option Explicit

'By Arthur Marks, arthurruhtra@netscape.net
'Use at your own risk...

Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
Private Const THREAD_BASE_PRIORITY_IDLE = -15
Private Const THREAD_BASE_PRIORITY_LOWRT = 15
Private Const THREAD_BASE_PRIORITY_MAX = 2
Private Const THREAD_BASE_PRIORITY_MIN = -2
Private Const MAXLONG = &H7FFFFFFF
'Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
'Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
'Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
'Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
'Private Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
'Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
'Private Const THREAD_PRIORITY_NORMAL = 0
'Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT
Public Enum eTHREAD_PRIORITY
    THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN '-2
    THREAD_PRIORITY_NORMAL = 0
    THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX '2
    THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1) '1
    THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1) '-1
    THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE '-15
    THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT '15
    THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
End Enum

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 Const HIGH_PRIORITY_CLASS = &H80
'Private Const IDLE_PRIORITY_CLASS = &H40
'Private Const NORMAL_PRIORITY_CLASS = &H20
'Private Const REALTIME_PRIORITY_CLASS = &H100
Public Enum ePROCESS_PRIORITY
    ERROR_PRIORITY_CLASS = 0 'my addition in case api fails
    IDLE_PRIORITY_CLASS = &H40
    NORMAL_PRIORITY_CLASS = &H20
    HIGH_PRIORITY_CLASS = &H80
    REALTIME_PRIORITY_CLASS = &H100
End Enum

Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'----------------------------------------------------------------


Public Property Get ProcessPriority() As ePROCESS_PRIORITY
    ProcessPriority = GetPriorityClass(GetCurrentProcess)
End Property

Public Property Let ProcessPriority(ByVal vNewValue As ePROCESS_PRIORITY)
    SetPriorityClass GetCurrentProcess, vNewValue
End Property

Public Property Get ThreadPriority() As eTHREAD_PRIORITY
    ThreadPriority = GetThreadPriority(GetCurrentThread)
End Property

Public Property Let ThreadPriority(ByVal vNewValue As eTHREAD_PRIORITY)
    SetThreadPriority GetCurrentThread, vNewValue
End Property