Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0233: Prozessorauslastung ermitteln

 von 

Beschreibung 

Die aktuelle Prozessorauslastung läßt sich mit wenigen Handgriffen aus der Registry erfahren.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

QueryPerformanceCounter, QueryPerformanceFrequency, RegCloseKey, RegOpenKeyA (RegOpenKey), RegQueryValueExA (RegQueryValueEx), SetWindowPos

Download:

Download des Beispielprojektes [2,47 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "Label2"

Option Explicit

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
        Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
        lpValueName As String, ByVal lpReserved As Long, _
        lpType As Long, lpData As Any, lpcbData As Long) _
        As Long

Private Declare Function RegOpenKey Lib "advapi32.dll" _
        Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal _
        lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long

Private Declare Function SetWindowPos Lib "user32" _
        (ByVal hwnd As Long, ByVal hWndInsertAfter As _
        Long, ByVal x As Long, ByVal y As Long, ByVal cx _
        As Long, ByVal cy As Long, ByVal wFlags As Long) _
        As Long

Private Declare Function QueryPerformanceCounter Lib _
        "kernel32" (lpPerformanceCount As LARGE_INTEGER) _
        As Long

Private Declare Function QueryPerformanceFrequency Lib _
        "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private Type LARGE_INTEGER
  lowpart As Long
  highpart As Long
End Type

Private Const REG_DWORD = 4
Private Const HKEY_DYN_DATA = &H80000006
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1

Private Sub Form_Load()
  Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
                    SWP_NOMOVE Or SWP_NOSIZE)
  Picture1.AutoRedraw = True
End Sub

Private Sub Timer1_Timer()
  Dim Proz As Single, x%
  
    x = GetCPUStatus
    Proz = (Picture1.ScaleWidth - 2 * Screen.TwipsPerPixelX) / 100
    Picture1.Cls
    
    If x > 0 Then
      Picture1.Line (Screen.TwipsPerPixelX, Screen.TwipsPerPixelY) _
                   -(Proz * x, Picture1.ScaleHeight - 2 * _
                     Screen.TwipsPerPixelY), &H8000000D, BF
    End If
    
    Label1.Caption = Trim$(CStr(x) & " %")
End Sub

Private Function GetCPUStatus() As Integer
  Dim Data&, hKey&, Result&
  
    Result = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)
    
    If Result = 0 Then
      Result = RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, _
                               REG_DWORD, Data, 4)
    
      GetCPUStatus = Str(Int(Data))
      Call RegCloseKey(hKey)
    End If
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 27 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von ThePuppetMaster am 14.04.2007 um 07:26

Hab mich jetz mal dran gemacht, und einen kleinen Code geschrieben, mit dem man diesen CPU-Wert-Datenerfassung Starten und auslesen kann.
Eigentlich sollte man, um Resoucen zu sparen, die Datenerfassung wieder abschalten, allerdings glaube ich nicht, das es so viel Resourcen beanspruchen würde, als das es relevant wäre.

Das Abschalten sollte jedoch gemacht werden, wenn mehr als nur die CPU Auslastung abgefragt wird. DAS wiederum ist resourcensparen ;)


Die Declarationen:
====================================================
Private Const REG_DWORD = 4
Private Const HKEY_DYN_DATA = &H80000006
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const SYNCHRONIZE = &H100000
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
====================================================



Zum Starten der Datenerfassung:
====================================================
Public Function Data_Init_CPUState()
On Error Resume Next
Dim hKey As Long
Dim Result As Long
Dim cbData As Long
Dim dwType As Long
Result = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0, KEY_READ, hKey)
If Result = 0 Then
Result = RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, dwType, 0, cbData)
If Result = 0 Then Result = RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, dwType, cbData, 4)
RegCloseKey hKey
End If
End Function
====================================================


Abfragen kann man die Daten dann hiermit:
====================================================
Public Function Data_Get_CPUState() As Integer
On Error Resume Next
Dim hKey As Long
Dim Result As Long
Dim XData As Long
Result = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)
If Result = 0 Then
Result = RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, REG_DWORD, XData, 4)
RegCloseKey hKey
Data_Get_CPUState = Str(Int(XData))
End If
End Function
====================================================



MfG
TPM

Kommentar von ThePuppetMaster am 14.04.2007 um 06:24

http://support.microsoft.com/kb/174631/de

Hier findet Ihr die Grundlagen zur leistungsabfrage (Auch, wie man das ganze "anstösst")


MfG
TPM

Kommentar von Henrik Schlittler am 14.10.2006 um 17:43

Gibt es für Windows xp eine API-Funktion, welche die Prozessorauslastung ermitteln kann??

Besten Dank im voraus für eine gute Antwort - Henrik Schlittler

Kommentar von Henrik Schlittler am 14.10.2006 um 17:39

Gibt es für Windows xp eine API-Funktion, welche die Prozessorauslastung ermitteln kann??

Besten Dank im voraus für eine gute Antwort - Henrik Schlittler

Kommentar von oldmike am 20.06.2006 um 22:48

Unter Windows XP scheint man das mit Diensten und Objekten zu lösen. Sucht mal in der Registry nach "Leistungsindikator".

MfG OldMike

Kommentar von oldmike am 20.06.2006 um 22:48

Unter Windows XP scheint man das mit Diensten und Objekten zu lösen. Sucht mal in der Registry nach "Leistungsindikator".

MfG OldMike

Kommentar von Floyd am 09.07.2003 um 09:51

An: Lippmann Sylvi

schau mal hier: http://www.programmierer-board.de/phpBB2/viewtopic.php?p=314758#314758

MfG {Floyd}

Kommentar von Rame am 08.07.2003 um 12:11

Hallo,

leider funktioniert dieses Beispiel bei mir nicht.
und zwar ist Result = 0, so daß Prozesserauslastung nicht ermittler werden kann.

Result = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)

If Result = 0 Then
Result = RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, _
REG_DWORD, Data, 4)

GetCPUStatus = Str(Int(Data))
Call RegCloseKey(hKey)
End If

Rame

Kommentar von Lippmann Sylvi am 05.06.2003 um 11:27

Hallo ich benötige im Rahmen meiner Diplomarbeit Information zum Thema:Wie kann ich die Prozessorauslastung messen?
Kann mir bitte jemand Informationen zu Tools übersenden die die Prozessorlast messen und wenn möglich für verschiedene Architektuen einstzbar sind?Vielen Dank!

Kommentar von Passi am 01.09.2002 um 20:57

Hi,
Das mit den 10% Schritten hatte ich auch. Gelöst habe ich es einfach, indem ich den Timer auf 500 Gesetzt hab, dann ging das ganz genau.
Grüße, Passi

Kommentar von Jürgen am 10.08.2002 um 19:20

Hallo Leute
Ihr müsst das ding erst anstoßen, das steht doch oben, könnt ihr nicht lesen

Kommentar von Darksidhe am 25.07.2002 um 10:03

Ich hab nich verstanden warum unbedingt die fehlermeldung als vordefinierte variable voehanden sein muss:(

Kommentar von L!nus am 26.05.2002 um 17:25

Der Trick an der ganzen sache mit dem "Anstoßen" ist relativ simpel: Man gucke sich in der Registry mittels RegEdit mal den fragwürdigen Schlüssel DYN_DATA an. Da muss man ZUERST in StartData oder sowas diese KERNEL/CPUusage Sache auf True oder -1 oder was auch immer stellen. Erst DANN kann man in StatsData die Werte auslesen.
Und genau das ist der "Anstoß", den sonst meinetwegen auch der Systemmonitor von Windows gibt.
Danach kann oder muss man das ganze glaube ich wieder mit StopData beenden oder sowas.
Wer sichs in regedit anguckt, wird sofort verstehen was ich meine...

Kommentar von locoZxanoZ am 03.05.2002 um 23:26

Bin als Laptop
Besitzer nicht mehr zufrieden die Prozessorauslastung nicht mehr wie 10% ist.Win Millenium war installiert und wurde durch xp Proffesional ersetzt.Da bei Pentium III mit 933 MGh so langsam wirkt hoffe ich auf eine Raht

Kommentar von thorsten am 19.01.2002 um 22:17

Ich habe ME auf meinem Laptop von Anfang an und sonst keine Programme und nix und habe eine Proz.Auslastung von permanent 70% ! Gerikom sagt das sei normal,das kann doch nicht sein. Wo ist das Problem,was kann ich tun?

Kommentar von PaTMaN am 06.12.2001 um 09:47

Der Code aus #11 funtkioniert bei mir unter W2k, aber leider teigt er nur 10 Schritte an (0,10,20...100). Gibt es einen Weg dies zu verfeinern?

Kommentar von unknown am 20.11.2001 um 12:33

Option Explicit
'### für OnTop ###
Private Declare Function SetWindowPos Lib "user32" (ByVal _
hwnd As Long, ByVal hWndInsertAfter As Long, ByVal _
x As Long, ByVal y As Long, ByVal cx As Long, ByVal _
cy As Long, ByVal wFlags As Long) As Long
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
'## ------ ##
'--------------------------------------------------------------------
'Konstanten
'--------------------------------------------------------------------
Const PDH_CSTATUS_VALID_DATA = &H0
Const PDH_CSTATUS_NEW_DATA = &H1
Const ERROR_SUCCESS = 0
'--------------------------------------------------------------------
'API-Deklarationen
'--------------------------------------------------------------------
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
'--------------------------------------------------------------------
'Variablen
'--------------------------------------------------------------------
Dim hQuery As Long
Dim hCounter As Long
Dim RetVal As Long
Private Sub Check1_Click()
If Check1.Value = vbChecked Then
SetWindowPos hwnd, _
HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE + SWP_NOSIZE
Else
SetWindowPos hwnd, _
HWND_NOTOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE + SWP_NOSIZE
End If
End Sub
'--------------------------------------------------------------------
'Implementation
'--------------------------------------------------------------------
Private Sub Form_Load()
'Query anlegen und Handle darauf ermitteln
RetVal = PdhOpenQuery(0, 1, hQuery)
If RetVal 0 Then
MsgBox "Fehler beim Öffnen der Query", vbExclamation, "Fehler!"
End
End If
'Performance-Counter definieren
RetVal = PdhVbAddCounter(hQuery, "\Prozessor(0)\Prozessorzeit (%)", hCounter)
If RetVal 0 Then
MsgBox "Fehler beim Hinzufügen des Counters", vbExclamation, "Fehler!"
PdhCloseQuery hQuery 'Query im Fehlerfall wieder schließen
End
End If
Check1.Caption = "Fenster obenhalten"
Check1.Value = vbChecked
End Sub
Private Sub Form_Unload(Cancel As Integer)
PdhCloseQuery hQuery 'Query wieder schließen
End Sub
Private Sub Timer1_Timer()
Dim dblValue As Double
Dim pdhStatus As Long
PdhCollectQueryData hQuery 'Die definierten Counter aktualisieren
dblValue = PdhVbGetDoubleCounterValue(hCounter, pdhStatus)
'Wert des Counters abfragen
If (pdhStatus = PDH_CSTATUS_VALID_DATA) Or _
(pdhStatus = PDH_CSTATUS_NEW_DATA) Then
Label1.Caption = "CPU-Auslastung: " & Format$(dblValue, "0.00")
End If
ProgressBar1.Value = dblValue 'Anzeige des Progressbar-Controls
'aktualisieren
End Sub

Kommentar von Florian am 05.11.2001 um 12:35

Bei mir (Win98 VB6.0 SP5) funzt weder noch... gibt es da alternative Möglichkeiten??
LG
Florian

Kommentar von Mario am 09.08.2001 um 17:07

der trick unter win2k ist, daß man dort die pdh.dll verwendet. hier gibt's mehr info's dazu: http://www.microsoft.com/intlkb/germany/support/kb/D43/D43738.htm

Kommentar von MaDhAtTeR am 21.06.2001 um 18:54

Hat es inzwischen jemand geschafft das Prog unter W2k oder NT zum laufen zu kriegen???

Kommentar von Micha55 am 31.05.2001 um 23:06

Anm.: Der Code von Pawel läuft bei Win98 einwandfrei. Bei meinem Bekannten unter Windows 2000 läuft's nicht.

Kommentar von Micha55 am 18.05.2001 um 17:34

Bei meinem W98 wird auch immer 100% angezeigt. Starte ich ein ProzessorAuslastungsMeßprogramm das ich von Codeguru downgeloaded habe, und schließe das zuletztgeladene wieder, funktioniert plötzlich das Programm von activevb einwandfrei. Scheinbar muß das irgendwie erst "angestoßen" werden, damit's geht.

Kommentar von Pawel am 01.05.2001 um 02:39

Bei mir wird ebenfalls immer 100% angezeigt!
Hier ist der Code, der wirklich funktioniert:
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&)
Function GetCPULoad&()
Static hK&, sK$: Const KDyn& = &H80000006
sK = IIf(hK = 0, "PerfStats\StartStat", "PerfStats\StatData")
If RegOpenKey(KDyn, sK, hK) Then Exit Function
RegQueryValueEx hK, "KERNEL\CPUUsage", 0, 4, GetCPULoad, 4
RegCloseKey hK
End Function
Gruß, Pawel
http://www.pkworld.de

Kommentar von Holger Stratmann am 04.02.2001 um 03:28

Ich habe das selbe Problem, dass die Prozessorauslastung immer 100% anzeigt. Was kann ich tun? Vielen Dank im Voraus.

Kommentar von Marco am 01.02.2001 um 23:04

Hallo Leute,
bei mir (Win 98, 256 MB) wird immer eine Prozessorauslastung (gemessen mit Tune up, etc.) von 100 % angezeigt!! Ist das normal, oder woran liegt das? Danke schon mal im Vorraus...
Gruß Marco

Kommentar von ALE am 01.02.2001 um 10:33

hey kann mal jemand antworten ... bei mir macht der auch 100%!!!
hab ME. ciao

Kommentar von Andrups am 22.10.2000 um 13:39

Es wird bei mir eine Prozessorauslastung vom 100% angezeigt, obwohl ich nichts an meinem Rechner arbeite. Doch wenn ich TuneUp97 starte (dort wird die Prozessorauslastung ebenfalls angezeigt - allerding korrekt), wird in der VB-Beispielanwendung plötzlich die korrekte Auslastung angezeigt. Beende ich TuneUp97, dann wird die Prozessorauslastung wieder mit 100% angegeben.