home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / AA_File_de565532202002.psc / clsCPUUsageNT.cls < prev    next >
Encoding:
Visual Basic class definition  |  2001-09-24  |  4.5 KB  |  117 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsCPUUsageNT"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. 'clsCPUUsageNT- copyright ⌐ 2001, The KPD-Team
  11. 'Visit our site at http://www.allapi.net
  12. 'or email us at KPDTeam@allapi.net
  13. Option Explicit
  14. Private Const SYSTEM_BASICINFORMATION = 0&
  15. Private Const SYSTEM_PERFORMANCEINFORMATION = 2&
  16. Private Const SYSTEM_TIMEINFORMATION = 3&
  17. Private Const NO_ERROR = 0
  18. Private Type LARGE_INTEGER
  19.     dwLow As Long
  20.     dwHigh As Long
  21. End Type
  22. Private Type SYSTEM_BASIC_INFORMATION
  23.     dwUnknown1 As Long
  24.     uKeMaximumIncrement As Long
  25.     uPageSize As Long
  26.     uMmNumberOfPhysicalPages As Long
  27.     uMmLowestPhysicalPage As Long
  28.     uMmHighestPhysicalPage As Long
  29.     uAllocationGranularity As Long
  30.     pLowestUserAddress As Long
  31.     pMmHighestUserAddress As Long
  32.     uKeActiveProcessors As Long
  33.     bKeNumberProcessors As Byte
  34.     bUnknown2 As Byte
  35.     wUnknown3 As Integer
  36. End Type
  37. Private Type SYSTEM_PERFORMANCE_INFORMATION
  38.     liIdleTime As LARGE_INTEGER
  39.     dwSpare(0 To 75) As Long
  40. End Type
  41. Private Type SYSTEM_TIME_INFORMATION
  42.     liKeBootTime As LARGE_INTEGER
  43.     liKeSystemTime As LARGE_INTEGER
  44.     liExpTimeZoneBias  As LARGE_INTEGER
  45.     uCurrentTimeZoneId As Long
  46.     dwReserved As Long
  47. End Type
  48. Private Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal dwInfoType As Long, ByVal lpStructure As Long, ByVal dwSize As Long, ByVal dwReserved As Long) As Long
  49. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  50. Private liOldIdleTime As LARGE_INTEGER
  51. Private liOldSystemTime As LARGE_INTEGER
  52. Public Sub Initialize()
  53.     Dim SysTimeInfo As SYSTEM_TIME_INFORMATION
  54.     Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION
  55.     Dim Ret As Long
  56.     'get new system time
  57.     Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&)
  58.     If Ret <> NO_ERROR Then
  59.         Debug.Print "Error while initializing the system's time!", vbCritical
  60.         Exit Sub
  61.     End If
  62.     'get new CPU's idle time
  63.     Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&)
  64.     If Ret <> NO_ERROR Then
  65.         Debug.Print "Error while initializing the CPU's idle time!", vbCritical
  66.         Exit Sub
  67.     End If
  68.     'store new CPU's idle and system time
  69.     liOldIdleTime = SysPerfInfo.liIdleTime
  70.     liOldSystemTime = SysTimeInfo.liKeSystemTime
  71. End Sub
  72. Public Function Query() As Long
  73.     Dim SysBaseInfo As SYSTEM_BASIC_INFORMATION
  74.     Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION
  75.     Dim SysTimeInfo As SYSTEM_TIME_INFORMATION
  76.     Dim dbIdleTime As Currency
  77.     Dim dbSystemTime As Currency
  78.     Dim Ret As Long
  79.     Query = -1
  80.     'get number of processors in the system
  81.     Ret = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(SysBaseInfo), LenB(SysBaseInfo), 0&)
  82.     If Ret <> NO_ERROR Then
  83.         Debug.Print "Error while retrieving the number of processors!", vbCritical
  84.         Exit Function
  85.     End If
  86.     'get new system time
  87.     Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&)
  88.     If Ret <> NO_ERROR Then
  89.         Debug.Print "Error while retrieving the system's time!", vbCritical
  90.         Exit Function
  91.     End If
  92.     'get new CPU's idle time
  93.     Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&)
  94.     If Ret <> NO_ERROR Then
  95.         Debug.Print "Error while retrieving the CPU's idle time!", vbCritical
  96.         Exit Function
  97.     End If
  98.     'CurrentValue = NewValue - OldValue
  99.     dbIdleTime = LI2Currency(SysPerfInfo.liIdleTime) - LI2Currency(liOldIdleTime)
  100.     dbSystemTime = LI2Currency(SysTimeInfo.liKeSystemTime) - LI2Currency(liOldSystemTime)
  101.     'CurrentCpuIdle = IdleTime / SystemTime
  102.     If dbSystemTime <> 0 Then dbIdleTime = dbIdleTime / dbSystemTime
  103.     'CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors
  104.     dbIdleTime = 100 - dbIdleTime * 100 / SysBaseInfo.bKeNumberProcessors + 0.5
  105.     Query = Int(dbIdleTime)
  106.     'store new CPU's idle and system time
  107.     liOldIdleTime = SysPerfInfo.liIdleTime
  108.     liOldSystemTime = SysTimeInfo.liKeSystemTime
  109. End Function
  110. Private Function LI2Currency(liInput As LARGE_INTEGER) As Currency
  111.     CopyMemory LI2Currency, liInput, LenB(liInput)
  112. End Function
  113. Public Sub Terminate()
  114.     'nothing to do
  115. End Sub
  116.  
  117.