Странное поведение VB

[visualman]

Данный код показывает загрузку процессора в процентах:

Код: Выделить всё



Private Enum PDH_STATUS
    PDH_CSTATUS_VALID_DATA = &H0
    PDH_CSTATUS_NEW_DATA = &H1
    PDH_CSTATUS_NO_MACHINE = &H800007D0
    PDH_CSTATUS_NO_INSTANCE = &H800007D1
    PDH_MORE_DATA = &H800007D2
    PDH_CSTATUS_ITEM_NOT_VALIDATED = &H800007D3
    PDH_RETRY = &H800007D4
    PDH_NO_DATA = &H800007D5
    PDH_CALC_NEGATIVE_DENOMINATOR = &H800007D6
    PDH_CALC_NEGATIVE_TIMEBASE = &H800007D7
    PDH_CALC_NEGATIVE_VALUE = &H800007D8
    PDH_DIALOG_CANCELLED = &H800007D9
    PDH_CSTATUS_NO_OBJECT = &HC0000BB8
    PDH_CSTATUS_NO_COUNTER = &HC0000BB9
    PDH_CSTATUS_INVALID_DATA = &HC0000BBA
    PDH_MEMORY_ALLOCATION_FAILURE = &HC0000BBB
    PDH_INVALID_HANDLE = &HC0000BBC
    PDH_INVALID_ARGUMENT = &HC0000BBD
    PDH_FUNCTION_NOT_FOUND = &HC0000BBE
    PDH_CSTATUS_NO_COUNTERNAME = &HC0000BBF
    PDH_CSTATUS_BAD_COUNTERNAME = &HC0000BC0
    PDH_INVALID_BUFFER = &HC0000BC1
    PDH_INSUFFICIENT_BUFFER = &HC0000BC2
    PDH_CANNOT_CONNECT_MACHINE = &HC0000BC3
    PDH_INVALID_PATH = &HC0000BC4
    PDH_INVALID_INSTANCE = &HC0000BC5
    PDH_INVALID_DATA = &HC0000BC6
    PDH_NO_DIALOG_DATA = &HC0000BC7
    PDH_CANNOT_READ_NAME_STRINGS = &HC0000BC8
End Enum

Private Const ERROR_SUCCESS = 0

Private Declare Function PdhOpenQuery Lib "PDH.DLL" (ByVal Reserved As Long, ByVal dwUserData As Long, ByRef hQuery As Long) As PDH_STATUS
Private Declare Function PdhCloseQuery Lib "PDH.DLL" (ByVal hQuery As Long) As PDH_STATUS
Private Declare Function PdhVbAddCounter Lib "PDH.DLL" (ByVal QueryHandle As Long, ByVal CounterPath As String, ByRef CounterHandle As Long) As PDH_STATUS
Private Declare Function PdhCollectQueryData Lib "PDH.DLL" (ByVal QueryHandle As Long) As PDH_STATUS
Private Declare Function PdhVbGetDoubleCounterValue Lib "PDH.DLL" (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double

Dim hCounter As Long
Dim hQuery As Long
Dim Status As PDH_STATUS

Private Function UpdateValues() As Long
    Dim dblCounterValue As Double
    Dim pdhStatus As Long
       
    PdhCollectQueryData (hQuery)
   
    dblCounterValue = PdhVbGetDoubleCounterValue(hCounter, pdhStatus)

    If (pdhStatus = PDH_CSTATUS_VALID_DATA) Or (pdhStatus = PDH_CSTATUS_NEW_DATA) Then
        UpdateValues = Format$(dblCounterValue, "0")
    Else
        UpdateValues = 0
    End If
End Function

Private Sub Command1_Click()
    Me.Caption = UpdateValues
End Sub

Private Sub Form_Load()
    Status = PdhOpenQuery(0, 1, hQuery)
   
    If Status <> ERROR_SUCCESS Then
        MsgBox "Ошибка"
        End
    End If
    Status = PdhVbAddCounter(hQuery, "\Processor(0)\% Processor Time", hCounter)

End Sub

Private Sub Form_Unload(Cancel As Integer)
    PdhCloseQuery (hQuery)
End Sub



Из процедур Form_Load; UpdateValues и Form_Unload мне нужно сделать одну функцию UpdateValues, соответственно код из Form_Load я вношу в начало функции UpdateValues, а код из Form_Unload в её конец. Получается следующее:

Код: Выделить всё


Private Function UpdateValues() As Long

    Status = PdhOpenQuery(0, 1, hQuery)
   
    If Status <> ERROR_SUCCESS Then
        MsgBox "Ошибка"
        End
    End If
    Status = PdhVbAddCounter(hQuery, "\Processor(0)\% Processor Time", hCounter)

    Dim dblCounterValue As Double
    Dim pdhStatus As Long
       
    PdhCollectQueryData (hQuery)
   
    dblCounterValue = PdhVbGetDoubleCounterValue(hCounter, pdhStatus)

    If (pdhStatus = PDH_CSTATUS_VALID_DATA) Or (pdhStatus = PDH_CSTATUS_NEW_DATA) Then
        UpdateValues = Format$(dblCounterValue, "0")
    Else
        UpdateValues = 0
    End If
   
    PdhCloseQuery (hQuery)
End Function



И вот парадокс: в таком варианте всегда возвращается нулевая загрузка процессора. Объясните, почему так?

[Andrey Fedorov]

Немножко лень разбираться с кодом, посему может устроит другой вариант:

Код: Выделить всё

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_PerfFormattedData_PerfOS_Processor",,48)
For Each objItem in colItems
    Wscript.Echo "-----------------------------------"
    Wscript.Echo "Win32_PerfFormattedData_PerfOS_Processor instance"
    Wscript.Echo "-----------------------------------"
    Wscript.Echo "PercentIdleTime: " & objItem.PercentIdleTime
Next

[visualman]

Спасибо, Андрей, но я пишу DLL автоматизации тестирования и предложеный Вами подход, увы не уместен в моём случае ))

Люди!!! Ни кто так и не объяснил, почему в таком варианте не работает!!

[Хакер]

У меня, например, первый способ не работает, потому как возвращается PDH_CSTATUS_NO_OBJECT

[visualman]

Я думаю, это из-за операционки. Хотя я в 2003 сижу и оно работает, но чем Билли не шутит ))

[Хакер]

FreeBSD

Хех

WXP Pro SP2

[Хакер]

Обязательно было написать на асме, да? Чтобы выпендриться, да? И причём на поганом макро-асме...

[keks-n]

Ale-Top
Тем, что форум по Visual Basic.

[GSerg]

Поставленная местным идиотом Ale-Top аватара стала последним моментом, который отправил его погулять.

[Jupiter]

Меня очень интересует эта тема. Но мне нужно определить загрузку процессора именно МОЕЙ программой. То есть программа должна отслеживать свой апетит и не перегружать проц. Но данный алгоритм, похоже, выдает ОБЩУЮ загрузку. Как жить дальше?
Спасибо.

[visualman]

Jupiter, держи спасательный круг:

http://www.Planet-Source-Code.com/vb/sc ... 9&lngWId=1

[Jupiter]

Jupiter, держи спасательный круг:

http://www.Planet-Source-Code.com/vb/sc ... 9&lngWId=1

Спасибо! ЭТо действительно очень ценный проект!

[IvanTheTerrible]

Данный код показывает загрузку процессора в процентах:
...
И вот парадокс: в таком варианте всегда возвращается нулевая загрузка процессора...

Еще один парадокс состоит в том, что при первом вызове всегда возвращается значение 100%. Начиная со 2-го, возвращаемое похоже на правду.
Пользование такими библиотеками напоминает шаманские танцы с бубном