تعیین حدود استفاده یک برنامه اجرا شده از CPU

[pcdownload.bloghaa.com]

با عرض سلام خدمت دوستان

احتمالا شما هم برای اجرای یک فایل exe از تابع shell استفاده می کنید
یک کار جالب با این تابع میتوان انجام داد آن هم تعیین حدود استفاده برنامه اجراشده از CPU است.

داخل ماژول :



Option Explicit

Public Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const IDLE_PRIORITY_CLASS = &H40
Public Const BELOW_NORMAL_PRIORITY_CLASS = &H4000
Public Const NORMAL_PRIORITY_CLASS = &H20
Public Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000
Public Const HIGH_PRIORITY_CLASS = &H80
Public Const REALTIME_PRIORITY_CLASS = &H100

Public Enum PRIORITY_CLASS
IDLE_PRIORITY
BELOW_NORMAL_PRIORITY
NORMAL_PRIORITY
ABOVE_NORMAL_PRIORITY
HIGH_PRIORITY
REALTIME_PRIORITY
End Enum

Public Function PriorityShell(PathName$, WindowStyle As VbAppWinStyle, Priority As PRIORITY_CLASS) As Long
Dim hInst, hProcess, dwPriorityClass As Long
Select Case Priority
Case IDLE_PRIORITY
dwPriorityClass = IDLE_PRIORITY_CLASS
Case BELOW_NORMAL_PRIORITY
dwPriorityClass = BELOW_NORMAL_PRIORITY_CLASS
Case NORMAL_PRIORITY
dwPriorityClass = NORMAL_PRIORITY_CLASS
Case ABOVE_NORMAL_PRIORITY
dwPriorityClass = ABOVE_NORMAL_PRIORITY_CLASS
Case HIGH_PRIORITY
dwPriorityClass = HIGH_PRIORITY_CLASS
Case REALTIME_PRIORITY
dwPriorityClass = REALTIME_PRIORITY_CLASS
Case Else
dwPriorityClass = NORMAL_PRIORITY_CLASS
End Select
hInst = Shell(PathName, WindowStyle)
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, hInst)
Call SetPriorityClass(hProcess, dwPriorityClass)
Call CloseHandle(hProcess)
PriorityShell = hInst
End Function


کد :


Private Sub Command1_Click()
Call PriorityShell("calc.exe", vbNormalFocus, HIGH_PRIORITY)
End Sub