cpu 使用测试 2000.frm

Windows API函数,希望大伙有用哦

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2910
   ClientLeft      =   2445
   ClientTop       =   1515
   ClientWidth     =   5625
   LinkTopic       =   "Form1"
   ScaleHeight     =   2910
   ScaleWidth      =   5625
   Begin VB.Frame Frame1 
      Caption         =   "CPU 使用图示"
      Height          =   2805
      Left            =   1260
      TabIndex        =   4
      Top             =   60
      Width           =   4305
      Begin VB.PictureBox Picture1 
         BackColor       =   &H80000009&
         Height          =   2445
         Left            =   150
         ScaleHeight     =   159
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   261
         TabIndex        =   5
         Top             =   210
         Width           =   3975
      End
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Height          =   270
      Left            =   180
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   900
      Width           =   645
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退  出"
      Height          =   315
      Left            =   180
      TabIndex        =   2
      Top             =   2490
      Width           =   915
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   450
      Top             =   2010
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Label3"
      Height          =   180
      Left            =   240
      TabIndex        =   6
      Top             =   1680
      Width           =   540
   End
   Begin VB.Label Label2 
      Caption         =   "%"
      Height          =   180
      Left            =   960
      TabIndex        =   1
      Top             =   930
      Width           =   90
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "CPU 占用率"
      Height          =   180
      Left            =   180
      TabIndex        =   0
      Top             =   390
      Width           =   900
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function PdhOpenQuery Lib "PDH.DLL" (ByVal Reserved As Long, ByVal dwUserData As Long, 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, 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, CounterStatus As Long) As Double
Enum PERF_DETAIL
    PERF_DETAIL_ADVANCED = 200
End Enum
Enum PDH_STATUS
    PDH_CSTATUS_VALID_DATA = &H0
    PDH_CSTATUS_NEW_DATA = &H1
End Enum
Private Type CounterInfo
    hCounter As Long
    strName As String
End Type
Dim hQuery As Long
Dim Counters As CounterInfo
Dim dblCounterValue As Double
Dim PdhStatus As Long
Dim I As Integer, X(120) As Single, Y(121) As Single
Private Sub Form_Load()
  PdhOpenQuery 0, 1, hQuery
  AddCounter "\Processor(0)\% Processor Time", hQuery
  Timer1.Enabled = True
      For I = 10 To 150 Step 10
        Picture1.Line (0, I)-(264, I), RGB(0, 128, 0)
      Next I
      For I = 10 To 264 Step 10
        Picture1.Line (I, 0)-(I, 160), RGB(0, 128, 0)
      Next I
      For I = 110 To 0 Step -1
        X(I) = I * 2.4
      Next I
  Label3 = Format(Time, "h:mm:ss")
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Timer1.Enabled = False
  PdhCloseQuery hQuery
End Sub
Private Sub Command1_Click()
  Timer1.Enabled = False
  PdhCloseQuery (hQuery)
  End
End Sub
Private Sub AddCounter(strCounterName As String, hQuery As Long)
Dim hCounter As Long
  PdhVbAddCounter hQuery, strCounterName, hCounter
  Counters.hCounter = hCounter
  Counters.strName = strCounterName
End Sub
Private Sub Timer1_Timer()
  PdhCollectQueryData hQuery
  dblCounterValue = PdhVbGetDoubleCounterValue(Counters.hCounter, PdhStatus)
  Y(0) = 1.6 * dblCounterValue
  Picture1.Cls
    For I = 10 To 150 Step 10
      Picture1.Line (0, I)-(264, I), RGB(0, 128, 0)
    Next I
    For I = 10 To 264 Step 10
      Picture1.Line (I, 0)-(I, 160), RGB(0, 128, 0)
    Next I
    For I = 110 To 0 Step -1
      Picture1.Line (X(I) + 2.4, 160 - Y(I + 1))-(X(I), 160 - Y(I)), RGB(255, 0, 0)
      Y(I + 1) = Y(I)
    Next I
Text1 = Format$(dblCounterValue, "0.00")
Label3 = Format(Time, "h:mm:ss")
End Sub