vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2021
 
zurück
Rubrik: System/Windows · Sonstiges   |   VB-Versionen: VB5, VB609.08.04
CPU Auslastung auslesen für alle Windows Systeme

Ermitteln der aktuellen CPU Auslastung ohne WMI oder zusätzliche OCX-Komponenten. Funktioniert auf fast allen Windows Systemen auch Win 2k & XP usw...

Autor:   Benjamin KunzBewertung:     [ Jetzt bewerten ]Views:  29.326 
www.exp-soft.de.vuSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Unser heutiger Tipp zeigt, wie sich die aktuelle CPU-Auslastung ermitteln lässt.

Erstellen Sie hierzu ein neues Projekt und fügen diesem ein neues Klassenmodul hinzu. Benennen Sie das Klassenmodul clsCPULoad und fügen nachfolgenden Code ein:

Option Explicit
 
Private Declare Function RegQueryValueEx& Lib "advapi32.dll" _
  Alias "RegQueryValueExA" ( _
  ByVal hKey&, _
  ByVal lpValueName$, _
  ByVal lpReserved&, _
  lpType&, _
  lpData As Any, _
  lpcbData&)
 
Private Declare Function RegOpenKey& Lib "advapi32.dll" _
  Alias "RegOpenKeyA" ( _
  ByVal hKey&, _
  ByVal lpSubKey$, _
  phkResult&)
 
Private Declare Function RegCloseKey& Lib "advapi32.dll" ( _
  ByVal hKey&)
 
Private Declare Sub CopyMemory Lib "kernel32.dll" _
  Alias "RtlMoveMemory" ( _
  Dest As Any, _
  Src As Any, _
  ByVal Length As Long)
 
Private Declare Function PdhOpenQuery Lib "PDH.DLL" ( _
  ByVal Reserved As Long, _
  ByVal dwUserData As Long, _
  ByRef hQuery As Long) As Long
 
Private Declare Function PdhCloseQuery Lib "PDH.DLL" ( _
  ByVal hQuery As Long) As Long
 
Private Declare Function PdhVbAddCounter Lib "PDH.DLL" ( _
  ByVal QueryHandle As Long, _
  ByVal CounterPath As String, _
  ByRef CounterHandle As Long) As Long
 
Private Declare Function PdhCollectQueryData Lib "PDH.DLL" ( _
  ByVal QueryHandle As Long) As Long
 
Private Declare Function PdhVbGetDoubleCounterValue Lib "PDH.DLL" ( _
  ByVal CounterHandle As Long, _
  ByRef CounterStatus As Long) As Double
 
Private Declare Function GetVersionEx Lib "kernel32" _
  Alias "GetVersionExA" ( _
  VersionInfo As OSVERSIONINFOEX) As Long
 
Private Const OSVERSIONINFOSIZE = 148
 
Private Const PDH_CSTATUS_VALID_DATA = &H0
Private Const PDH_CSTATUS_NEW_DATA = &H1
Private Const ERROR_SUCCESS = 0
Private Const VER_PLATFORM_WIN32_NT = 2
 
Private Type OSVERSIONINFOEX
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
  wServicePackMajor As Integer
  wServicePackMinor As Integer
  wSuiteMask As Integer
  bProductType As Byte
  bReserved As Byte
End Type
 
Private hQuery As Long
Private hCounter As Long
Private RetVal As Long
 
Private Stack() As Long
Private StackPointer As Long
Private m_StackSize As Long
Private m_Sum As Long
 
Private m_BandWidth As Long
Private Sub Class_Initialize()
  m_StackSize = 5
  ReDim Stack(0 To m_StackSize - 1)
  StackPointer = 0
 
  If IsNT Then
    RetVal = PdhOpenQuery(0, 1, hQuery)
    If RetVal = 0 Then
      ' Performance-Counter definieren
      RetVal = PdhVbAddCounter(hQuery, _
        "\Prozessor(0)\Prozessorzeit (%)", hCounter)
 
      ' Query im Fehlerfall wieder schließen
      If RetVal <> 0 Then PdhCloseQuery hQuery
    End If
  End If
End Sub
Private Sub Class_Terminate()
  ' Query wieder schließen
  If IsNT Then PdhCloseQuery hQuery
End Sub
' NT-System?
Private Function IsNT() As Boolean
  Static VerInfo As OSVERSIONINFOEX, bOsVersionInfoEx As Long
  Static Flag As Boolean, NT As Boolean
 
  If Not Flag Then
    VerInfo.dwOSVersionInfoSize = Len(VerInfo)
    bOsVersionInfoEx = GetVersionEx(VerInfo)
 
    If bOsVersionInfoEx = 0 Then
      VerInfo.dwOSVersionInfoSize = OSVERSIONINFOSIZE
      GetVersionEx VerInfo
    End If
 
    NT = (VerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT)
    Flag = True
  End If
 
  IsNT = NT
End Function
Public Property Get StackSize() As Long
  StackSize = m_StackSize
End Property
 
Public Property Let StackSize(ByRef NewStackSize As Long)
  m_StackSize = NewStackSize
  ReDim Stack(0 To m_StackSize - 1)
  StackPointer = 0
End Property
Private Sub PushBandWidth(ByRef NewBandWidth As Long)
  Static u As Long
 
  u = UBound(Stack)
  If StackPointer <= u Then
    Stack(StackPointer) = NewBandWidth
    m_Sum = m_Sum + NewBandWidth
    StackPointer = StackPointer + 1
 
  Else
    m_Sum = m_Sum - Stack(0) + NewBandWidth
    Call CopyMemory(Stack(0), Stack(1), u * 4)
    Stack(u) = NewBandWidth
 
  End If
  m_BandWidth = m_Sum / StackPointer
End Sub
Private Function GetValue9x() As Long
  Dim V As Long
  Static hK As Long, sK As String
  Const KDyn& = &H80000006
 
  sK = IIf(hK = 0, "PerfStats\StartStat", "PerfStats\StatData")
  If RegOpenKey(KDyn, sK, hK) Then Exit Function
 
  Call RegQueryValueEx(hK, "KERNEL\CPUUsage", 0, 4, V, 4)
  Call RegCloseKey(hK)
 
  PushBandWidth V
  GetValue9x = m_BandWidth
End Function
Private Function GetValueNT() As Long
  Dim dblValue As Double
  Dim pdhStatus As Long
 
  ' definierten Counter aktualisieren
  PdhCollectQueryData hQuery
  dblValue = PdhVbGetDoubleCounterValue(hCounter, pdhStatus)
 
  ' Wert des Counters abfragen
  If (pdhStatus = PDH_CSTATUS_VALID_DATA) Or _
    (pdhStatus = PDH_CSTATUS_NEW_DATA) Then
 
    PushBandWidth CLng(dblValue)
    GetValueNT = m_BandWidth
  End If
End Function
' Rückgabe der CPU-Auslastung
Public Property Get Value() As Long
  If IsNT Then
    Value = GetValueNT
  Else
    Value = GetValue9x
  End If
End Property

Beispiel:
Platzieren Sie auf die Form ein Timer-Control, sowie ein Label-Control und fügen nachfolgenden Code in den Codeteil der Form ein.

Option Explicit
 
' Klasse instanzieren
Private CPULoad As New clsCPULoad
Private Sub Form_Load()
  ' Stacksize festlegen
  CPULoad.StackSize = 10
 
  ' Timer auf 1 Sekunde stellen und aktivieren
  Timer1.Interval = 1000
  Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
  Dim Value As Integer
 
  On Error Resume Next
 
  ' CPU-Auslastung ermitteln anzeigen
  Value = CPULoad.Value
  Label1.Caption = Value & " %"
End Sub

Dieser Tipp wurde bereits 29.326 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2021 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel