hallo,
hat vielleicht jemand eine idee, wie man mit vb5 die cpu-auslastung eines Rechners auslesen kann?
Danke im Voraus
bobi
Hallo Bobi.
Ohne Gewähr: Vielleicht hilft Dir da das SysInfo-Steuerelement weiter.
VG
Carsten
Hallo Rainer,
bin deinem link gefolgt und habe auch das Beispielprojekt ausprobiert.
hat nicht funktioniert, weil ich vergessen habe, zu sagen, dass ich mit winxp arbeite.
Wäre dankbar für eine Antwort, die auf winxp funktioniert.
bobi
Hallo bobi,
das Programm ist nicht von mir, ich habe angenommen, es funktioniert auch mit XP.
Ich habe mal bei AVB gefragt, Du kannst ja wenn Du Lust hast, dort im Forum auch schon mitlesen. Ich werde ich Antwort aber in jedem Fall hier sinngemäß wiedergeben.
Gruß Rainer
Hallo bobi,
holst Du Dir die Antwort bitte bei AVB ab?
Meine Frage dort in VB5/VB6 Forum:
Tipp 233: Prozessorauslastung ermitteln
wurde von Frank Schüler mit einem Link beantwortet. Ich habe das Programm gerade mit XP getestet, läuft hervorragend!
Gruß Rainer
Hallo Rainer,
beim ausführen des projektes kommt bei mir die Fehlermeldung: „Sub oder funktion nicht definiert“ und das wort „split“ ist markiert.
Woran liegt das?
bobi
Hi bobi,
beim ausführen des projektes kommt bei mir die Fehlermeldung:
„Sub oder funktion nicht definiert“ und das wort „split“ ist
markiert.
Woran liegt das?
da wird eine Funktion von VB6 benutzt, die es in VB5 nicht gibt.
Wirf mal einen Blick in die [FAQ:2906], Reinhard hat sich damit befasst und die Funktionen, die in VB5 fehlen ‚nachgebaut‘. Sieh aber bitte genau hin, ob die direkt so einzusetzen sind, oder ob der Code leicht angepasst werden muss. Ich kann das nicht prüfen ich verwende VB6.
Gruß Rainer
Hi bobi,
schreib mal den folgenden Code in ein Modul und füge dieses Modul dem Projekt hinzu, dann sollte der Code laufen, wenn nicht noch etwas anderes fehlt.
Public Function Split(ByVal Txt As String, ByVal TZ As String) As Variant
Dim n As Long, Pos As Long, i As Long, Pa As Long, Arr() As String
If Len(Txt) \> 1 Then
Do
Pos = InStr(Pos + 1, Txt, TZ)
n = n + 1
Loop While Pos
ReDim Arr(n)
Pos = 0
For i = LBound(Arr) To UBound(Arr) - 1
Pa = Pos + 1
Pos = InStr(Pos + 1, Txt, TZ)
If Pos = 0 Then Pos = Len(Txt)
Arr(i) = Mid(Txt, Pa, Pos - Pa)
Next
Split = Arr
End If
End Function
habe den code engefügt, doch jetzt kommt ein anderer Fehler: „Keine Zuweisung an Datenfeld möglich“ und das wort „strSplitObjectList“ ist markiert.
Komme mir langsam ein bisschen blöd vor, aber ich bin halt noch anfänger.
Ich hoffe, dass du wegen mir nicht verzweifelst. 
bobi
Hallo,
habe den code engefügt, doch jetzt kommt ein anderer Fehler:
„Keine Zuweisung an Datenfeld möglich“ und das wort
„strSplitObjectList“ ist markiert.Komme mir langsam ein bisschen blöd vor, aber ich bin halt
noch anfänger.
Ich hoffe, dass du wegen mir nicht verzweifelst.
nein, ganz sicher nicht.
Das ist ja nicht Deine Schuld, das liegt daran, daß der Code mit VB6 geschrieben ist und Du das etwas ältere VB5 verwendest.
Weil ich VB6 verwende, bemerke ich diese Fallen nicht.
Ich beschäftige mich mal etwas intensiver mir dem Problem, ich hatte gehofft, daß Dir der Code hilft und Du die Essenz selbst herausziehen kannst.
Das kann aber bis zum Wochenende dauern, für ‚zwischendurch‘ ist das vermutlich zu viel, ich habe mir den Code noch nicht angesehen. Ich werde das mal vereinfachen, auf das Nötigste reduzieren und auf Funktionen verzichten, die VB5 nicht kennt.
Bis dann,
Gruß Rainer
hallo rainer,
Ich werde das mal vereinfachen, auf das Nötigste reduzieren
damit hast du völlig recht, denn ich möchte ja nichts anderes als die aktuelle cpu-auslastung herausfinden.
Danke, dass du dir die Mühe machst!!!
bobi
Hallo bobi,
nachdem ich mit dem Zerlegen des Codes schon ziemlich weit war, musste ich einsehen, daß das ohne Split nicht funktioniert.
ich habe deshalb doch das Original wieder in meine IDE geladen, eine Prozedur ‚Split5‘ eingefügt, die ich bei AVB bekommen habe, und im Programm ‚Split‘ durch ‚Split5‘ ersetzt.
Split5 statt meiner eigenen Split-Prozedur habe ich verwendet, weil das universeller funktioniert als das, was ich mir ausgedacht hatte.
Der Code läuft bei mir jetzt ohne Problem und Slpit gibt es in dem Programm nicht mehr. Join und Replace wurden nicht verwendet, das soll jetzt so bei Dir laufen. Mangels VB5 kann ich das aber nicht testen, das nusst Du selbst tun.
Einfach das letzte Beispiel laden und den Quellcode komplett ersetzen.
Gruß Rainer
Option Explicit
' Wenn Machine = vbNullString ist, dann wird der
' Lokale PC verwendet. Ansonsten im Netzwerk
' kann auch die IP-Adresse oder der Hostname
' eines Clients, der online ist, angegeben werden.
Private Const Machine As String = vbNullString ' oder "\\IP-Adresse" oder "\\HostName"
Private Const Stepping As Long = 2 ' 1 bis 6 Geschwindigkeit für die Verlaufsanzeige
Private Const TimerInterval As Long = 500
Private Type Prozessor
Handle As Long
Object As String
Counter As String
Instance As String
End Type
Private Const ERROR\_SUCCESS As Long = 0
Private Const PDH\_MORE\_DATA As Long = &H800007D2
Private Const PERF\_DETAIL\_WIZARD As Long = 400
Private Declare Function PdhConnectMachine Lib "pdh.dll" \_
Alias "PdhConnectMachineA" ( \_
ByVal szMachineName As String) As Long
Private Declare Function PdhVbCreateCounterPathList Lib "pdh.dll" ( \_
ByVal DetailLevel As Long, \_
ByVal CaptionString As String) As Long
Private Declare Function PdhCollectQueryData Lib "pdh.dll" ( \_
ByVal QueryHandle As Long) As Long
Private Declare Function PdhRemoveCounter Lib "pdh.dll" ( \_
ByVal CounterHandle 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 PdhVbGetDoubleCounterValue Lib "pdh.dll" ( \_
ByVal CounterHandle As Long, \_
ByRef CounterStatus As Long) As Double
Private Declare Function PdhVbIsGoodStatus Lib "pdh.dll" ( \_
ByVal StatusValue As Long) As Long
Private Declare Function PdhCloseQuery Lib "pdh.dll" ( \_
ByVal hQuery As Long) 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 PdhEnumObjects Lib "pdh.dll" \_
Alias "PdhEnumObjectsA" ( \_
ByVal szDataSource As String, \_
ByVal szMachineName As String, \_
ByVal mszObjectList As String, \_
ByRef pcchBufferLength As Long, \_
ByVal dwDetailLevel As Long, \_
ByVal bRefresh As Long) As Long
Private Declare Function PdhEnumObjectItems Lib "pdh.dll" \_
Alias "PdhEnumObjectItemsA" ( \_
ByVal szDataSource As String, \_
ByVal szMachineName As String, \_
ByVal szObjectName As String, \_
ByVal mszCounterList As String, \_
ByRef pcchCounterListLength As Long, \_
ByVal mszInstanceList As String, \_
ByRef pcchInstanceListLength As Long, \_
ByVal dwDetailLevel As Long, \_
ByVal dwFlags As Long) As Long
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private Const SWP\_NOMOVE As Long = 2
Private Const SWP\_NOSIZE As Long = 1
Private Const SWP\_WNDFLAGS = SWP\_NOMOVE Or SWP\_NOSIZE
Private Const HWND\_TOPMOST As Long = -1
Private Const HWND\_NOTOPMOST As Long = -2
Private Declare Sub SetWindowPos Lib "user32" ( \_
ByVal hWnd As Long, \_
ByVal hWndInsertAfter As Integer, \_
ByVal X As Integer, \_
ByVal Y As Integer, \_
ByVal cx As Integer, \_
ByVal cy As Integer, \_
ByVal wFlags As Integer)
Private hQuery As Long
Private tProzessor() As Prozessor
Private lngY As Long
Private lngX As Long
Private lngXLine() As Long
Private lngOldVal() As Long
Private Sub DrawTotal(ByVal Value As Double)
Dim Y As Long
Dim C As Long
C = RGB(0, 127, 0)
For Y = 20 To 1 Step -1
If Value \> 100 - (5 \* Y) Then
C = RGB(0, 255, 0)
Else
C = RGB(0, 96, 0)
End If
picTotal.Line ((picTotal.ScaleWidth / 2) - 21, 3 \* Y)-(( \_
picTotal.ScaleWidth / 2) - 1, (3 \* Y) + 1), C, BF
picTotal.Line ((picTotal.ScaleWidth / 2) + 1, 3 \* Y)-(( \_
picTotal.ScaleWidth / 2) + 20, (3 \* Y) + 1), C, BF
Next Y
lblTotal.Caption = Format$(Value, "0") & "%"
End Sub
Private Sub DrawProzessor(ByVal Value As Double, ByVal Index As Long)
p(Index).Picture = p(Index).Image
p(Index).PaintPicture p(Index).Picture, 0, 0, p(Index).ScaleWidth - \_
Stepping, p(Index).ScaleHeight, Stepping, 0, p(Index).ScaleWidth - \_
Stepping, p(Index).ScaleHeight, vbSrcCopy
p(Index).Line (p(Index).ScaleWidth - Stepping, 0)-(p(Index).ScaleWidth, p( \_
Index).ScaleHeight - 1), p(Index).BackColor, BF
For lngY = p(Index).ScaleHeight - 1 To 0 Step -12
p(Index).Line (p(Index).ScaleWidth - Stepping, lngY)-(p( \_
Index).ScaleWidth, lngY), RGB(0, 96, 0)
Next lngY
lngXLine(Index) = lngXLine(Index) + Stepping
If lngXLine(Index) = 12 Then
p(Index).Line (p(Index).ScaleWidth - 1, 0)-(p(Index).ScaleWidth - 1, \_
p(Index).ScaleHeight), RGB(0, 96, 0)
lngXLine(Index) = 0
End If
Value = ((p(Index).ScaleHeight - 1) \* Value) \ 100
p(Index).Line (p(Index).ScaleWidth - Stepping - 1, p(Index).ScaleHeight - \_
lngOldVal(Index))-(p(Index).ScaleWidth - 1, p(Index).ScaleHeight - \_
Value), RGB(0, 255, 0)
lngOldVal(Index) = Value
End Sub
Private Sub Command1\_Click()
' mal zum reinschauen was man so alles an
' Leistungsindikatoren abfragen kann.
Call PdhVbCreateCounterPathList(PERF\_DETAIL\_WIZARD, ":smile:")
End Sub
Private Sub Form\_Load()
Dim lngRet As Long
Dim lngItem As Long
Dim lngObjectListSize As Long
Dim lngCounterListSize As Long
Dim lngInstanceListSize As Long
Dim strMachine As String
Dim strObject As String
Dim strCounter As String
Dim strObjectListBuffer As String
Dim strCounterListBuffer As String
Dim strInstanceListBuffer As String
Dim strSplit5ObjectList() As String
Dim strSplit5InstanceList() As String
Dim strSplit5CounterList() As String
Call SetWindowPos(Me.hWnd, HWND\_TOPMOST, 0, 0, 0, 0, SWP\_WNDFLAGS)
Timer1.Interval = 0
Timer1.Enabled = True
ReDim tProzessor(0)
Me.ScaleMode = vbPixels
p(0).ScaleMode = vbPixels
p(0).Move 4, 4, 295, 89
p(0).AutoRedraw = True
p(0).BackColor = vbBlack
For lngX = p(0).ScaleWidth - 1 To 0 Step -12
p(0).Line (lngX, 0)-(lngX, p(0).ScaleHeight), RGB(0, 96, 0)
Next lngX
For lngY = p(0).ScaleHeight - 1 To 0 Step -12
p(0).Line (0, lngY)-(p(0).ScaleWidth, lngY), RGB(0, 96, 0)
Next lngY
p(0).Picture = p(0).Image
lbl(0).FontBold = True
lbl(0).ForeColor = RGB(255, 255, 0)
lbl(0).BackStyle = 0
lbl(0).Caption = "CPU-Nutzung:"
Set lbl(0).Container = p(0)
lbl(0).Move 2, 2, p(0).ScaleWidth
picTotal.ScaleMode = vbPixels
picTotal.BackColor = vbBlack
picTotal.Move p(0).Left + p(0).Width + 4, p(0).Top
lblTotal.FontBold = True
lblTotal.ForeColor = RGB(255, 255, 0)
lblTotal.BackStyle = 0
Call DrawTotal(0)
Command1.Move picTotal.Left, picTotal.Top + picTotal.Height + 4, picTotal.Width
Command1.Caption = ":smile:"
If Machine vbNullString Then
If PdhConnectMachine(Machine) = ERROR\_SUCCESS Then
strMachine = Machine
Else
strMachine = vbNullString
End If
End If
lngRet = PdhEnumObjects(vbNullString, strMachine, vbNullString, \_
lngObjectListSize, PERF\_DETAIL\_WIZARD, 1)
If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
If lngObjectListSize 0 Then
strObjectListBuffer = String$(lngObjectListSize, 0)
lngRet = PdhEnumObjects(vbNullString, strMachine, \_
strObjectListBuffer, lngObjectListSize, PERF\_DETAIL\_WIZARD, 0)
If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
strSplit5ObjectList = Split5(strObjectListBuffer, Chr$(0))
For lngItem = 0 To UBound(strSplit5ObjectList) - 1
If strSplit5ObjectList(lngItem) = "Prozessor" Or \_
strSplit5ObjectList(lngItem) = "Processor" Then
strObject = strSplit5ObjectList(lngItem)
Exit For
End If
Next lngItem
End If
End If
End If
If Len(strObject) \> 0 Then
lngRet = PdhEnumObjectItems(vbNullString, strMachine, strObject, \_
vbNullString, lngCounterListSize, vbNullString, \_
lngInstanceListSize, PERF\_DETAIL\_WIZARD, 0)
If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
If lngCounterListSize 0 And lngInstanceListSize 0 Then
strCounterListBuffer = String$(lngCounterListSize, 0)
strInstanceListBuffer = String$(lngInstanceListSize, 0)
lngRet = PdhEnumObjectItems(vbNullString, strMachine, \_
strObject, strCounterListBuffer, lngCounterListSize, \_
strInstanceListBuffer, lngInstanceListSize, \_
PERF\_DETAIL\_WIZARD, 0)
If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
strSplit5CounterList = Split5(strCounterListBuffer, Chr$(0))
For lngItem = 0 To UBound(strSplit5CounterList) - 1
If strSplit5CounterList(lngItem) = "Prozessorzeit " & \_
"(%)" Or strSplit5CounterList(lngItem) = "% " & \_
"Processortime" Then
strCounter = strSplit5CounterList(lngItem)
Exit For
End If
Next lngItem
If Len(strCounter) \> 0 Then
strSplit5InstanceList = Split5(strInstanceListBuffer, Chr$(0))
ReDim tProzessor(UBound(strSplit5InstanceList) - 1)
For lngItem = 0 To UBound(strSplit5InstanceList) - 1
tProzessor(lngItem).Handle = 0
tProzessor(lngItem).Object = strObject
tProzessor(lngItem).Counter = strCounter
tProzessor(lngItem).Instance = \_
strSplit5InstanceList(lngItem)
Next lngItem
End If
End If
End If
End If
End If
If UBound(tProzessor) \> 0 Then
If PdhOpenQuery(0, 1, hQuery) = ERROR\_SUCCESS Then
For lngItem = 0 To UBound(tProzessor)
If PdhVbAddCounter(hQuery, strMachine & "\" & tProzessor( \_
lngItem).Object & "(" & tProzessor(lngItem).Instance & \_
")\" & tProzessor(lngItem).Counter, tProzessor( \_
lngItem).Handle) ERROR\_SUCCESS Then
tProzessor(lngItem).Handle = 0
Else
ReDim lngXLine(lngItem)
ReDim lngOldVal(lngItem)
If lngItem \> 0 Then
Load p(lngItem)
Load lbl(lngItem)
Set lbl(lngItem).Container = p(lngItem)
p(lngItem).Move p(lngItem - 1).Left, p(lngItem - \_
1).Top + p(lngItem - 1).Height + 4
p(lngItem).Visible = True
lbl(lngItem).Visible = True
End If
End If
Next lngItem
Me.Height = Me.ScaleY(p(p.Count - 1).Top + p(p.Count - 1).Height + \_
28, Me.ScaleMode, vbTwips)
Timer1.Interval = TimerInterval
End If
End If
End Sub
Private Sub Form\_Unload(Cancel As Integer)
Dim lngItem As Long
Timer1.Interval = 0
If hQuery 0 Then
For lngItem = 0 To UBound(tProzessor)
If tProzessor(lngItem).Handle 0 Then
If PdhRemoveCounter(tProzessor(lngItem).Handle) = ERROR\_SUCCESS Then
tProzessor(lngItem).Handle = 0
End If
End If
Next lngItem
Call PdhCloseQuery(hQuery)
End If
End Sub
Private Sub Timer1\_Timer()
Dim dblValue As Double
Dim lngStatus As Long
Dim lngItem As Long
Timer1.Interval = 0
If PdhCollectQueryData(hQuery) = ERROR\_SUCCESS Then
For lngItem = 0 To UBound(tProzessor)
If tProzessor(lngItem).Handle 0 Then
dblValue = PdhVbGetDoubleCounterValue(tProzessor( \_
lngItem).Handle, lngStatus)
If PdhVbIsGoodStatus(lngStatus) = 1 Then
Select Case tProzessor(lngItem).Instance
Case "\_Total"
lbl(0).Caption = "CPU-Nutzung Total: " & Format$( \_
dblValue, "0") & "%"
Call DrawProzessor(dblValue, 0)
Call DrawTotal(dblValue)
Case Else
lbl(Val(tProzessor(lngItem).Instance) + 1).Caption = \_
"CPU-Nutzung Cpu " & Val(tProzessor( \_
lngItem).Instance) & ": " & Format$(dblValue, \_
"0") & "%"
Call DrawProzessor(dblValue, Val(tProzessor( \_
lngItem).Instance) + 1)
End Select
End If
End If
Next lngItem
End If
Timer1.Interval = TimerInterval
End Sub
Public Function Split5(sString As String, Separator As String) As String()
'Split Function für VB5
Dim i As Long, j As Long, z As Long
Dim s() As String
'Anzahl der Separatoren feststellen
i = 1
Do
j = InStr(i, sString, Separator, vbBinaryCompare)
If j = 0 Then
Exit Do
End If
i = j + 1
z = z + 1
Loop
'aufdröseln in Elemente
ReDim s(z)
If z = 0 Then
s(z) = sString
Split5 = s()
Exit Function
End If
i = 1
z = 0
Do
j = InStr(i, sString, Separator, vbBinaryCompare)
If j = 0 Then
Exit Do
End If
s(z) = Mid$(sString, i, j - i)
i = j + Len(Separator)
z = z + 1
Loop
'den letzten Teil auslösen
If i
Hallo Rainer,
nachdem ich mit dem Zerlegen des Codes schon ziemlich weit
war, musste ich einsehen, daß das ohne Split nicht
funktioniert.
Was spricht gegen Split ? Ist doch eine tolle Erfindung *gg*
ich habe deshalb doch das Original wieder in meine IDE
geladen, eine Prozedur ‚Split5‘ eingefügt, die ich bei AVB
bekommen habe, und im Programm ‚Split‘ durch ‚Split5‘ ersetzt.
Haettest du mal in die FAQ geschaut *grins* Haettest du dir viel Arbeit sparen koennen. FAQ:2906
MfG Alex
Hi Alex,
schön, von Dir zu lesen.
Was spricht gegen Split? Ist doch eine tolle Erfindung *gg*
Find ich auch, scheint aber mit VB5 Ärger zu machen und ich wollte es entfernen. Das hat aber nicht geklappt.
Haettest du mal in die FAQ geschaut *grins* Haettest du dir
viel Arbeit sparen koennen. FAQ:2906
Sieh mal ganz oben, die FAQ hatte ich als Erstes verlinkt. Das hat bobi aber nichts genützt, er hat das Programm damit nicht zum Laufen bekommen.
Gruß Rainer
Hallo Rainer,
was meinst du mit IDE?
Ich habe mir das Beispiel von „Tipp:233“ aus activevb runtergeladen, doch nun kommt an dieser
For lngX = p(0).ScaleWidth - 1 To 0 Step -12
p(0).Line (lngX, 0)-(lngX, p(0).ScaleHeight), RGB(0, 96, 0)
Next lngX
stelle die fehlermeldung: „Sub oder Function nicht definiert!“
bobi
Hallo bobi,
was meinst du mit IDE?
Die Entwicklungsumgebung.
Ich habe mir das Beispiel von „Tipp:233“ aus activevb
runtergeladen, doch nun kommt an dieserFor lngX = p(0).ScaleWidth - 1 To 0 Step -12
p(0).Line (lngX, 0)-(lngX, p(0).ScaleHeight), RGB(0, 96, 0)
Next lngX
stelle die fehlermeldung: „Sub oder Function nicht definiert!“
hmmmm. Funktion nicht definiert? VB5 muss doch ‚Line‘ können.
Es sieht so aus, als bräuchten wir Hilfe. Ich frag mal …
Gruß Rainer
Der Code läuft bei mir jetzt ohne Problem und Slpit gibt es in
dem Programm nicht mehr. Join und Replace wurden nicht
verwendet, das soll jetzt so bei Dir laufen. Mangels VB5 kann
ich das aber nicht testen, das nusst Du selbst tun.Einfach das letzte Beispiel laden und den Quellcode komplett
ersetzen.
Hallo Rainer,
ich habe es mit VB5.0 getestet. Also diesen Code von dir genommen, noch einen Timer in die Form gebaut und dann gestartet.
In der Sub Form_Load kommt Fehler „Sub oder Function nicht definiert“ bei p(0).ScaleMode = vbPixels
und p(0) ist markiert.
Timer1.Interval = 0
Timer1.Enabled = True
ReDim tProzessor(0)
Me.ScaleMode = vbPixels
p(0).ScaleMode = vbPixels
Was also muß ich am Code noch ändern bzw. in die Form einbauen?
Deine Hinweismail auf diese Beitragsfolge habe ich vor Minuten erst gelesen und jetzt nur den ersten gefundenen Code von dir getestet, man kann also (noch) nicht sagen daß ich mir die Beitragsfolge genauestens angesehen habe :smile:)
Gruß
Reinhard
Gruß
Reinhard
Hallo Reinhard,
ich habe es mit VB5.0 getestet. Also diesen Code von dir
genommen, noch einen Timer in die Form gebaut und dann
gestartet.
In der Sub Form_Load kommt Fehler „Sub oder Function nicht
definiert“ bei p(0).ScaleMode = vbPixels
und p(0) ist markiert.
alles klar. Du hast nicht das Beispiel geladen und dort den Code geändert, sondern ein neues Projekt gestartet. p(0) ist eine der Pictureboxen, die auf der Form liegen, die wird dann natürlich nicht gefunden. Das muss dann auch der Fehler bei bobi sein.
Wenn Du Lust dazu hast, könntest Du mal alles entfernen, was nach Grafik aussieht. Die Prozessorleistung in Me.Caption anzuzeigen genügt hier völlig.
Wenn ich etwas baue, kommt nur immer Code heraus, der nicht läuft und ich kann nicht sehen, warum. 
Gruß Rainer
Hallo Rainer,
alles klar. Du hast nicht das Beispiel geladen und dort den
Code geändert, sondern ein neues Projekt gestartet.
ja.
p(0) ist eine der Pictureboxen, die auf der Form liegen, die wird
dann natürlich nicht gefunden. Das muss dann auch der Fehler bei
bobi sein.
Möglich.
Wenn Du Lust dazu hast, könntest Du mal alles entfernen, was
nach Grafik aussieht. Die Prozessorleistung in Me.Caption
anzuzeigen genügt hier völlig.
Ich habe mal alles innerhalb von der Sub Form_Load auskommentiert, in der Form sind nur der Timer und ein CommanButton, bei F5 erscheint:
http://www.bilder-space.de/show.php?file=21.054XjrRT…
Ist das okay? Ein Weg, ein Holzweg?
damit jeder klarkommt welcher Code das bei VB% bewirkt ist er nachgfolgend gelistet, in der Form ist nur ein Timer und eine CB.
Wobei dabei die zeile
Public Function Split5(sString As String, Separator As String) As String()
als Fehlerhaft dargestellt wird, also andersfarbig, aber keinen Fehler beim Codeablauf hervorruft.
Ohne das farblich sehen zu können gehe ich davon aus sie wird in Grün dargestellt. *Farbsehschwäche hab*
Wenn ich etwas baue, kommt nur immer Code heraus, der nicht
läuft und ich kann nicht sehen, warum.
Das erstere ist bei mir erstmal normal *gg* das Zweitere macht/würde mich wahnsinnig machen )
Gruß
Reinhard
Option Explicit
' Wenn Machine = vbNullString ist, dann wird der
' Lokale PC verwendet. Ansonsten im Netzwerk
' kann auch die IP-Adresse oder der Hostname
' eines Clients, der online ist, angegeben werden.
Private Const Machine As String = vbNullString ' oder "\\IP-Adresse" oder "\\HostName"
Private Const Stepping As Long = 2 ' 1 bis 6 Geschwindigkeit für die Verlaufsanzeige
Private Const TimerInterval As Long = 500
Private Type Prozessor
Handle As Long
Object As String
Counter As String
Instance As String
End Type
Private Const ERROR\_SUCCESS As Long = 0
Private Const PDH\_MORE\_DATA As Long = &H800007D2
Private Const PERF\_DETAIL\_WIZARD As Long = 400
Private Declare Function PdhConnectMachine Lib "pdh.dll" \_
Alias "PdhConnectMachineA" ( \_
ByVal szMachineName As String) As Long
Private Declare Function PdhVbCreateCounterPathList Lib "pdh.dll" ( \_
ByVal DetailLevel As Long, \_
ByVal CaptionString As String) As Long
Private Declare Function PdhCollectQueryData Lib "pdh.dll" ( \_
ByVal QueryHandle As Long) As Long
Private Declare Function PdhRemoveCounter Lib "pdh.dll" ( \_
ByVal CounterHandle 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 PdhVbGetDoubleCounterValue Lib "pdh.dll" ( \_
ByVal CounterHandle As Long, \_
ByRef CounterStatus As Long) As Double
Private Declare Function PdhVbIsGoodStatus Lib "pdh.dll" ( \_
ByVal StatusValue As Long) As Long
Private Declare Function PdhCloseQuery Lib "pdh.dll" ( \_
ByVal hQuery As Long) 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 PdhEnumObjects Lib "pdh.dll" \_
Alias "PdhEnumObjectsA" ( \_
ByVal szDataSource As String, \_
ByVal szMachineName As String, \_
ByVal mszObjectList As String, \_
ByRef pcchBufferLength As Long, \_
ByVal dwDetailLevel As Long, \_
ByVal bRefresh As Long) As Long
Private Declare Function PdhEnumObjectItems Lib "pdh.dll" \_
Alias "PdhEnumObjectItemsA" ( \_
ByVal szDataSource As String, \_
ByVal szMachineName As String, \_
ByVal szObjectName As String, \_
ByVal mszCounterList As String, \_
ByRef pcchCounterListLength As Long, \_
ByVal mszInstanceList As String, \_
ByRef pcchInstanceListLength As Long, \_
ByVal dwDetailLevel As Long, \_
ByVal dwFlags As Long) As Long
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private Const SWP\_NOMOVE As Long = 2
Private Const SWP\_NOSIZE As Long = 1
Private Const SWP\_WNDFLAGS = SWP\_NOMOVE Or SWP\_NOSIZE
Private Const HWND\_TOPMOST As Long = -1
Private Const HWND\_NOTOPMOST As Long = -2
Private Declare Sub SetWindowPos Lib "user32" ( \_
ByVal hWnd As Long, \_
ByVal hWndInsertAfter As Integer, \_
ByVal X As Integer, \_
ByVal Y As Integer, \_
ByVal cx As Integer, \_
ByVal cy As Integer, \_
ByVal wFlags As Integer)
Private hQuery As Long
Private tProzessor() As Prozessor
Private lngY As Long
Private lngX As Long
Private lngXLine() As Long
Private lngOldVal() As Long
Private Sub DrawTotal(ByVal Value As Double)
Dim Y As Long
Dim C As Long
C = RGB(0, 127, 0)
For Y = 20 To 1 Step -1
If Value \> 100 - (5 \* Y) Then
C = RGB(0, 255, 0)
Else
C = RGB(0, 96, 0)
End If
picTotal.Line ((picTotal.ScaleWidth / 2) - 21, 3 \* Y)-(( \_
picTotal.ScaleWidth / 2) - 1, (3 \* Y) + 1), C, BF
picTotal.Line ((picTotal.ScaleWidth / 2) + 1, 3 \* Y)-(( \_
picTotal.ScaleWidth / 2) + 20, (3 \* Y) + 1), C, BF
Next Y
lblTotal.Caption = Format$(Value, "0") & "%"
End Sub
'Private Sub DrawProzessor(ByVal Value As Double, ByVal Index As Long)
'
' p(Index).Picture = p(Index).Image
'
' p(Index).PaintPicture p(Index).Picture, 0, 0, p(Index).ScaleWidth - \_
' Stepping, p(Index).ScaleHeight, Stepping, 0, p(Index).ScaleWidth - \_
' Stepping, p(Index).ScaleHeight, vbSrcCopy
'
' p(Index).Line (p(Index).ScaleWidth - Stepping, 0)-(p(Index).ScaleWidth, p( \_
' Index).ScaleHeight - 1), p(Index).BackColor, BF
'
' For lngY = p(Index).ScaleHeight - 1 To 0 Step -12
'
' p(Index).Line (p(Index).ScaleWidth - Stepping, lngY)-(p( \_
' Index).ScaleWidth, lngY), RGB(0, 96, 0)
'
' Next lngY
'
' lngXLine(Index) = lngXLine(Index) + Stepping
'
' If lngXLine(Index) = 12 Then
'
' p(Index).Line (p(Index).ScaleWidth - 1, 0)-(p(Index).ScaleWidth - 1, \_
' p(Index).ScaleHeight), RGB(0, 96, 0)
'
' lngXLine(Index) = 0
'
' End If
'
' Value = ((p(Index).ScaleHeight - 1) \* Value) \ 100
'
' p(Index).Line (p(Index).ScaleWidth - Stepping - 1, p(Index).ScaleHeight - \_
' lngOldVal(Index))-(p(Index).ScaleWidth - 1, p(Index).ScaleHeight - \_
' Value), RGB(0, 255, 0)
'
' lngOldVal(Index) = Value
'
'End Sub
Private Sub Command1\_Click()
' mal zum reinschauen was man so alles an
' Leistungsindikatoren abfragen kann.
Call PdhVbCreateCounterPathList(PERF\_DETAIL\_WIZARD, ":smile:")
End Sub
Private Sub Form\_Load()
' Dim lngRet As Long
' Dim lngItem As Long
' Dim lngObjectListSize As Long
' Dim lngCounterListSize As Long
' Dim lngInstanceListSize As Long
' Dim strMachine As String
' Dim strObject As String
' Dim strCounter As String
' Dim strObjectListBuffer As String
' Dim strCounterListBuffer As String
' Dim strInstanceListBuffer As String
' Dim strSplit5ObjectList() As String
' Dim strSplit5InstanceList() As String
' Dim strSplit5CounterList() As String
'
' Call SetWindowPos(Me.hWnd, HWND\_TOPMOST, 0, 0, 0, 0, SWP\_WNDFLAGS)
'
' Timer1.Interval = 0
' Timer1.Enabled = True
' ReDim tProzessor(0)
' Me.ScaleMode = vbPixels
' p(0).ScaleMode = vbPixels
' p(0).Move 4, 4, 295, 89
' p(0).AutoRedraw = True
' p(0).BackColor = vbBlack
'
' For lngX = p(0).ScaleWidth - 1 To 0 Step -12
'
' p(0).Line (lngX, 0)-(lngX, p(0).ScaleHeight), RGB(0, 96, 0)
'
' Next lngX
'
' For lngY = p(0).ScaleHeight - 1 To 0 Step -12
'
' p(0).Line (0, lngY)-(p(0).ScaleWidth, lngY), RGB(0, 96, 0)
'
' Next lngY
'
' p(0).Picture = p(0).Image
' lbl(0).FontBold = True
' lbl(0).ForeColor = RGB(255, 255, 0)
' lbl(0).BackStyle = 0
' lbl(0).Caption = "CPU-Nutzung:"
'
' Set lbl(0).Container = p(0)
'
' lbl(0).Move 2, 2, p(0).ScaleWidth
' picTotal.ScaleMode = vbPixels
' picTotal.BackColor = vbBlack
' picTotal.Move p(0).Left + p(0).Width + 4, p(0).Top
' lblTotal.FontBold = True
' lblTotal.ForeColor = RGB(255, 255, 0)
' lblTotal.BackStyle = 0
'
' Call DrawTotal(0)
'
' Command1.Move picTotal.Left, picTotal.Top + picTotal.Height + 4, picTotal.Width
'
' Command1.Caption = ":smile:"
'
' If Machine vbNullString Then
'
' If PdhConnectMachine(Machine) = ERROR\_SUCCESS Then
' strMachine = Machine
' Else
' strMachine = vbNullString
' End If
'
' End If
'
' lngRet = PdhEnumObjects(vbNullString, strMachine, vbNullString, \_
' lngObjectListSize, PERF\_DETAIL\_WIZARD, 1)
'
' If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
'
' If lngObjectListSize 0 Then
'
' strObjectListBuffer = String$(lngObjectListSize, 0)
'
' lngRet = PdhEnumObjects(vbNullString, strMachine, \_
' strObjectListBuffer, lngObjectListSize, PERF\_DETAIL\_WIZARD, 0)
'
' If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
'
' strSplit5ObjectList = Split5(strObjectListBuffer, Chr$(0))
'
' For lngItem = 0 To UBound(strSplit5ObjectList) - 1
'
' If strSplit5ObjectList(lngItem) = "Prozessor" Or \_
' strSplit5ObjectList(lngItem) = "Processor" Then
'
' strObject = strSplit5ObjectList(lngItem)
'
' Exit For
'
' End If
'
' Next lngItem
'
' End If
' End If
' End If
'
' If Len(strObject) \> 0 Then
'
' lngRet = PdhEnumObjectItems(vbNullString, strMachine, strObject, \_
' vbNullString, lngCounterListSize, vbNullString, \_
' lngInstanceListSize, PERF\_DETAIL\_WIZARD, 0)
'
' If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
'
' If lngCounterListSize 0 And lngInstanceListSize 0 Then
'
' strCounterListBuffer = String$(lngCounterListSize, 0)
' strInstanceListBuffer = String$(lngInstanceListSize, 0)
'
' lngRet = PdhEnumObjectItems(vbNullString, strMachine, \_
' strObject, strCounterListBuffer, lngCounterListSize, \_
' strInstanceListBuffer, lngInstanceListSize, \_
' PERF\_DETAIL\_WIZARD, 0)
'
' If lngRet = ERROR\_SUCCESS Or lngRet = PDH\_MORE\_DATA Then
'
' strSplit5CounterList = Split5(strCounterListBuffer, Chr$(0))
'
' For lngItem = 0 To UBound(strSplit5CounterList) - 1
'
' If strSplit5CounterList(lngItem) = "Prozessorzeit " & \_
' "(%)" Or strSplit5CounterList(lngItem) = "% " & \_
' "Processortime" Then
'
' strCounter = strSplit5CounterList(lngItem)
'
' Exit For
'
' End If
'
' Next lngItem
'
' If Len(strCounter) \> 0 Then
'
' strSplit5InstanceList = Split5(strInstanceListBuffer, Chr$(0))
'
' ReDim tProzessor(UBound(strSplit5InstanceList) - 1)
'
' For lngItem = 0 To UBound(strSplit5InstanceList) - 1
'
' tProzessor(lngItem).Handle = 0
' tProzessor(lngItem).Object = strObject
' tProzessor(lngItem).Counter = strCounter
'
' tProzessor(lngItem).Instance = \_
' strSplit5InstanceList(lngItem)
'
' Next lngItem
'
' End If
' End If
' End If
' End If
' End If
'
' If UBound(tProzessor) \> 0 Then
' If PdhOpenQuery(0, 1, hQuery) = ERROR\_SUCCESS Then
'
' For lngItem = 0 To UBound(tProzessor)
'
' If PdhVbAddCounter(hQuery, strMachine & "\" & tProzessor( \_
' lngItem).Object & "(" & tProzessor(lngItem).Instance & \_
' ")\" & tProzessor(lngItem).Counter, tProzessor( \_
' lngItem).Handle) ERROR\_SUCCESS Then
'
' tProzessor(lngItem).Handle = 0
'
' Else
'
' ReDim lngXLine(lngItem)
' ReDim lngOldVal(lngItem)
'
' If lngItem \> 0 Then
'
' Load p(lngItem)
' Load lbl(lngItem)
'
' Set lbl(lngItem).Container = p(lngItem)
'
' p(lngItem).Move p(lngItem - 1).Left, p(lngItem - \_
' 1).Top + p(lngItem - 1).Height + 4
'
' p(lngItem).Visible = True
' lbl(lngItem).Visible = True
'
' End If
' End If
'
' Next lngItem
'
' Me.Height = Me.ScaleY(p(p.Count - 1).Top + p(p.Count - 1).Height + \_
' 28, Me.ScaleMode, vbTwips)
'
' Timer1.Interval = TimerInterval
'
' End If
' End If
'
End Sub
Private Sub Form\_Unload(Cancel As Integer)
Dim lngItem As Long
Timer1.Interval = 0
If hQuery 0 Then
For lngItem = 0 To UBound(tProzessor)
If tProzessor(lngItem).Handle 0 Then
If PdhRemoveCounter(tProzessor(lngItem).Handle) = ERROR\_SUCCESS Then
tProzessor(lngItem).Handle = 0
End If
End If
Next lngItem
Call PdhCloseQuery(hQuery)
End If
End Sub
Private Sub Timer1\_Timer()
Dim dblValue As Double
Dim lngStatus As Long
Dim lngItem As Long
Timer1.Interval = 0
If PdhCollectQueryData(hQuery) = ERROR\_SUCCESS Then
For lngItem = 0 To UBound(tProzessor)
If tProzessor(lngItem).Handle 0 Then
dblValue = PdhVbGetDoubleCounterValue(tProzessor( \_
lngItem).Handle, lngStatus)
If PdhVbIsGoodStatus(lngStatus) = 1 Then
Select Case tProzessor(lngItem).Instance
Case "\_Total"
lbl(0).Caption = "CPU-Nutzung Total: " & Format$( \_
dblValue, "0") & "%"
Call DrawProzessor(dblValue, 0)
Call DrawTotal(dblValue)
Case Else
lbl(Val(tProzessor(lngItem).Instance) + 1).Caption = \_
"CPU-Nutzung Cpu " & Val(tProzessor( \_
lngItem).Instance) & ": " & Format$(dblValue, \_
"0") & "%"
Call DrawProzessor(dblValue, Val(tProzessor( \_
lngItem).Instance) + 1)
End Select
End If
End If
Next lngItem
End If
Timer1.Interval = TimerInterval
End Sub
Public Function Split5(sString As String, Separator As String) As String()
'Split Function für VB5
Dim i As Long, j As Long, z As Long
Dim s() As String
'Anzahl der Separatoren feststellen
i = 1
Do
j = InStr(i, sString, Separator, vbBinaryCompare)
If j = 0 Then
Exit Do
End If
i = j + 1
z = z + 1
Loop
'aufdröseln in Elemente
ReDim s(z)
If z = 0 Then
s(z) = sString
Split5 = s()
Exit Function
End If
i = 1
z = 0
Do
j = InStr(i, sString, Separator, vbBinaryCompare)
If j = 0 Then
Exit Do
End If
s(z) = Mid$(sString, i, j - i)
i = j + Len(Separator)
z = z + 1
Loop
'den letzten Teil auslösen
If i