home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbtime1a / idbas_pr.bas < prev    next >
Encoding:
BASIC Source File  |  1999-09-19  |  2.1 KB  |  65 lines
  1. Attribute VB_Name = "IDBAS_Priority"
  2. Option Explicit
  3. Public Enum ePriorityClass
  4.     ePriorityClass_Normal = &H20
  5.     ePriorityClass_Low = &H40
  6.     ePriorityClass_High = &H80
  7.     ePriorityClass_RealTime = &H100
  8. End Enum
  9.  
  10. Private Const PROCESS_DUP_HANDLE = &H40
  11.  
  12. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  13. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  14. Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
  15. Private Declare Function SetPriorityClass& Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long)
  16. Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
  17.  
  18. Public Property Let Priority(priorityValue As ePriorityClass)
  19.  
  20.     Dim hProcess&
  21.     Dim ret&, pid&
  22.     pid = GetCurrentProcessId() ' get my proccess id
  23.     ' get a handle to the process
  24.     hProcess = OpenProcess(PROCESS_DUP_HANDLE, True, pid)
  25.  
  26.     If hProcess = 0 Then
  27.         Err.Raise 2, "Let Priority", "Unable to open the source process"
  28.         Exit Property
  29.     End If
  30.  
  31.     ' change the priority
  32.     ret = SetPriorityClass(hProcess, priorityValue)
  33.     ' Close the source process handle
  34.     Call CloseHandle(hProcess)
  35.  
  36.     If ret = 0 Then
  37.         Err.Raise 4, "Let Priority", "Unable to close source handle"
  38.         Exit Property
  39.     End If
  40.  
  41. End Property
  42. Public Property Get Priority() As ePriorityClass
  43.     Dim hProcess&
  44.     Dim ret&, pid&
  45.     pid = GetCurrentProcessId() ' get my proccess id
  46.     ' get a handle to the process
  47.     hProcess = OpenProcess(PROCESS_DUP_HANDLE, True, pid)
  48.  
  49.     If hProcess = 0 Then
  50.         Err.Raise 2, "Get Priority", "Unable to open the source process"
  51.         Exit Property
  52.     End If
  53.  
  54.     ' change the priority
  55.     Priority = GetPriorityClass(hProcess)
  56.     ' Close the source process handle
  57.     Call CloseHandle(hProcess)
  58.  
  59.     If Priority = 0 Then
  60.         Err.Raise 4, "Get Priority", "Unable to close source handle"
  61.         Exit Property
  62.     End If
  63. End Property
  64.  
  65.