Adding real-time CPU utilization to a VB6 form

Posted on 2007-07-24
Last Modified: 2008-02-01
I have a program that kicks up CPU utilization that I will be using to test our virtual machines.  Does anyone know how I can show the CPU utilization on the form?  I'd like to see the CPU utilization updating in real-time on the form.  The program looks like this...

Dim isExist As Boolean
Private Sub Command1_Click()
Dim goal
Dim before
Dim x
Dim y
Dim i
goal = 2181818
isExist = False
Do While True
    If isExist Then Exit Do
    before = Timer
    For i = 0 To goal
        x = 0.000001
        y = Sin(x)
        y = y + 0.00001
    y = y + 0.01
End Sub

Private Sub Command2_Click()
isExist = True
End Sub
Question by:bpl5000
    LVL 48

    Accepted Solution

    LVL 5

    Author Comment

    Isn't there an easier way?  I would actually like to know the CPU utilization of the VB program itself instead of totally cpu utilization.  The executable is named cpubusy.exe.    Would there be a way to display the programs CPU utilization?
    LVL 5

    Author Comment

    I found this code, but I'm getting a 'subscript out of range' error.   I get the error on the line "Set pCounterItem = SystemMonitor1.Counters(1)"  Any ideas why this doesn't work for me?

    Option Explicit
    Dim pCollectSamples As Boolean
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMillseconds As Long)
    Private Sub Command1_Click()
       With SystemMonitor1
        Call .Counters.Add("\Thread(Idle/0)\% Processor Time")
       End With
       Timer1.Enabled = True
       pCollectSamples = True
    End Sub

    Private Sub Timer1_Timer()
        Dim pCounterItem As CounterItem
        Dim pValue As Double, pstatus As Long
        Dim pmin As Double
        Dim pmax As Double
        Dim pavg As Double
        Dim i As Integer
        If pCollectSamples Then
            For i = 0 To 10
                Sleep 100
            pCollectSamples = False
        End If
        Set pCounterItem = SystemMonitor1.Counters(1)

        Call pCounterItem.GetValue(pValue, pstatus)
        'Debug.Print "Value:", pValue, "Status:", pstatus

        Call pCounterItem.GetStatistics(pmax, pmin, pavg, pstatus)
       Text1.Text = "Average:" & pavg & "   value:" & pValue
       If pavg >= 99.75 And pValue >= 99.99 Then
            MsgBox "Idle Now"
       End If
    End Sub

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Find Ransomware Secrets With All-Source Analysis

    Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

    Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
    This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
    Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
    This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

    794 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    18 Experts available now in Live!

    Get 1:1 Help Now