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
