host/winhost/CUpTime.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CUpTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const ERROR_SUCCESS = 0&
Private Const PDH_FMT_LARGE = &H400&
Private Const REG_DWORD = 4 ' 32-bit number
Private Const HKEY_DYN_DATA = &H80000006

Private Type PDH_FMT_COUNTERVALUE
    CStatus As Long
    largeValueLo As Long
    largeValueHi As Long
End Type

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Declare Function PdhVbOpenQuery Lib "pdh" ( _
  hQuery As Long) As Long

Private Declare Function PdhVbAddCounter Lib "pdh" ( _
  ByVal hQuery As Long, _
  ByVal szFullCounterPath As String, _
  hCounter As Long) As Long

Private Declare Function PdhCollectQueryData Lib "pdh" ( _
  ByVal hQuery As Long) As Long

Private Declare Function PdhGetFormattedCounterValue Lib "pdh" ( _
  ByVal hCounter As Long, _
  ByVal dwFormat As Long, _
  lpdwType As Any, _
  pValue As PDH_FMT_COUNTERVALUE) As Long

Private Declare Function PdhVbGetDoubleCounterValue Lib "pdh" ( _
  ByVal CounterHandle As Long, _
  ByRef CounterStatus As Long) As Double

Private Declare Function PdhCloseQuery Lib "pdh" ( _
  ByVal hQuery As Long) As Long

Private Declare Function PdhVbIsGoodStatus Lib "pdh" ( _
  ByVal StatusValue As Long) As Long

Private Declare Function GetVersion Lib "kernel32" () As Long

Private hPdhQuery As Long, hPdhCounter As Long, hPdhCounterCPU As Long
Private sCounterPath As String
Private m_sComputerName As String
Private m_Win9x As Boolean, m_dMilliSecs As Double, m_iSecs As Integer, m_iMins As Integer, m_iHours As Integer, m_iDays As Integer, m_sCPUTime As String, m_iPercentIdle As Integer

Public Property Get ComputerName() As String
    ComputerName = m_sComputerName
End Property

Public Property Let ComputerName(NewComputer As String)
    m_sComputerName = NewComputer
End Property

Public Property Get isWin9x() As Boolean
    isWin9x = m_Win9x
    'isWin9x = True (for debugging purposes)
End Property

Public Property Get MilliSecs() As Double
    MilliSecs = m_dMilliSecs
End Property

Public Property Get Seconds() As Integer
    Seconds = m_iSecs
End Property

Public Property Get Minutes() As Integer
    Minutes = m_iMins
End Property

Public Property Get Hours() As Integer
    Hours = m_iHours
End Property

Public Property Get Days() As Integer
    Days = m_iDays
End Property

Public Property Get CPUTime() As String
    CPUTime = m_sCPUTime
End Property

Public Property Get PercentIdle() As String
    PercentIdle = m_iPercentIdle
End Property

Public Function Init()
    On Error GoTo errhandler
    
    If GetVersion() And &H80000000 Then
        m_Win9x = True
    Else
        m_Win9x = False
    End If
    
    If m_Win9x Then Exit Function
    
    If PdhVbOpenQuery(hPdhQuery) <> ERROR_SUCCESS Then Exit Function
    ' \\computer\System\System Up Time
    sCounterPath = "\\" & IIf(Len(m_sComputerName) = 0, ".", m_sComputerName) & "\System\System Up Time"
    
    If PdhVbAddCounter(hPdhQuery, sCounterPath, hPdhCounter) <> ERROR_SUCCESS Then
        Exit Function
    End If

    If PdhVbAddCounter(hPdhQuery, "\Processor(0)\% Processor Time", hPdhCounterCPU) <> ERROR_SUCCESS Then
        Exit Function
    End If

    Exit Function
errhandler:
    'msgDialog 1, Err.Description, "Error #" & Err.Number & " - Source: " & Err.Source
End Function

Public Function Unload()
    Call PdhCloseQuery(hPdhQuery)
End Function

Public Function Capture(Optional GetIdle As Boolean = False) As Boolean
    On Error GoTo errhandler

    Dim nStatusCode As Long
    Dim pdhfmtcv As PDH_FMT_COUNTERVALUE
    Dim pdhStatus As Long
    Dim dblCounterValue As Double
    Dim nMsecs As Double
    Dim lUptime As Double     'Uptime in seconds
    
    If PdhCollectQueryData(hPdhQuery) <> ERROR_SUCCESS Then
        Exit Function
    End If
    
    nStatusCode = PdhGetFormattedCounterValue(hPdhCounter, PDH_FMT_LARGE, ByVal 0&, pdhfmtcv)
    
    If nStatusCode <> ERROR_SUCCESS Or PdhVbIsGoodStatus(pdhfmtcv.CStatus) = 0 Then
        Exit Function
    End If

    'Get CPU info
    dblCounterValue = PdhVbGetDoubleCounterValue(hPdhCounterCPU, pdhStatus)
    m_sCPUTime = CStr(Replace(Format(dblCounterValue, "0.00"), ",", "."))
        
    lUptime = pdhfmtcv.largeValueHi
    
    m_dMilliSecs = CDbl(lUptime * 1000)
    m_iSecs = lUptime Mod 60
    m_iMins = (lUptime Mod 3600) \ 60
    m_iHours = (lUptime Mod (3600& * 24)) \ 3600
    m_iDays = lUptime \ (3600& * 24)
    Capture = True

    If (GetIdle = True) And (m_Win9x = False) Then
        'Save CPU idle information
        Dim PercentIdle As Integer
        Dim TotalSamples As Long
        Dim IdleSamples As Long
        
        TotalSamples = CLng(GetSetting("Uptime", "Idle", "TotalSamples", "0"))
        IdleSamples = CLng(GetSetting("Uptime", "Idle", "IdleSamples", "0"))
        
        TotalSamples = TotalSamples + 1
        If m_sCPUTime = "0.00" Then IdleSamples = IdleSamples + 1
        
        PercentIdle = CInt((IdleSamples / TotalSamples) * 100)
        m_iPercentIdle = PercentIdle
        SaveSetting "Uptime", "Idle", "TotalSamples", CStr(TotalSamples)
        SaveSetting "Uptime", "Idle", "IdleSamples", CStr(IdleSamples)
    End If
    
    Exit Function
errhandler:
    'msgDialog 1, Err.Description, "Error #" & Err.Number & " - Source: " & Err.Source
End Function
Revision:	1.1
Committed:	Wed Feb 28 09:15:05 2001 UTC (23 years, 8 months ago) by pjm2
Branch:	MAIN
CVS Tags:	PROJECT_COMPLETION
Log Message:	Some VB class files that are used to return certain information about the machine they are running on. I did not write these. I had to change a couple of bits to make them work, however.
#	User	Rev	Content
1	pjm2	1.1	VERSION 1.0 CLASS
2			BEGIN
3			MultiUse = -1 'True
4			Persistable = 0 'NotPersistable
5			DataBindingBehavior = 0 'vbNone
6			DataSourceBehavior = 0 'vbNone
7			MTSTransactionMode = 0 'NotAnMTSObject
8			END
9			Attribute VB_Name = "CUpTime"
10			Attribute VB_GlobalNameSpace = False
11			Attribute VB_Creatable = True
12			Attribute VB_PredeclaredId = False
13			Attribute VB_Exposed = False
14			Option Explicit
15
16			Private Const ERROR_SUCCESS = 0&
17			Private Const PDH_FMT_LARGE = &H400&
18			Private Const REG_DWORD = 4 ' 32-bit number
19			Private Const HKEY_DYN_DATA = &H80000006
20
21			Private Type PDH_FMT_COUNTERVALUE
22			CStatus As Long
23			largeValueLo As Long
24			largeValueHi As Long
25			End Type
26
27			Private Type LARGE_INTEGER
28			lowpart As Long
29			highpart As Long
30			End Type
31
32			Private Declare Function PdhVbOpenQuery Lib "pdh" ( _
33			hQuery As Long) As Long
34
35			Private Declare Function PdhVbAddCounter Lib "pdh" ( _
36			ByVal hQuery As Long, _
37			ByVal szFullCounterPath As String, _
38			hCounter As Long) As Long
39
40			Private Declare Function PdhCollectQueryData Lib "pdh" ( _
41			ByVal hQuery As Long) As Long
42
43			Private Declare Function PdhGetFormattedCounterValue Lib "pdh" ( _
44			ByVal hCounter As Long, _
45			ByVal dwFormat As Long, _
46			lpdwType As Any, _
47			pValue As PDH_FMT_COUNTERVALUE) As Long
48
49			Private Declare Function PdhVbGetDoubleCounterValue Lib "pdh" ( _
50			ByVal CounterHandle As Long, _
51			ByRef CounterStatus As Long) As Double
52
53			Private Declare Function PdhCloseQuery Lib "pdh" ( _
54			ByVal hQuery As Long) As Long
55
56			Private Declare Function PdhVbIsGoodStatus Lib "pdh" ( _
57			ByVal StatusValue As Long) As Long
58
59			Private Declare Function GetVersion Lib "kernel32" () As Long
60
61			Private hPdhQuery As Long, hPdhCounter As Long, hPdhCounterCPU As Long
62			Private sCounterPath As String
63			Private m_sComputerName As String
64			Private m_Win9x As Boolean, m_dMilliSecs As Double, m_iSecs As Integer, m_iMins As Integer, m_iHours As Integer, m_iDays As Integer, m_sCPUTime As String, m_iPercentIdle As Integer
65
66			Public Property Get ComputerName() As String
67			ComputerName = m_sComputerName
68			End Property
69
70			Public Property Let ComputerName(NewComputer As String)
71			m_sComputerName = NewComputer
72			End Property
73
74			Public Property Get isWin9x() As Boolean
75			isWin9x = m_Win9x
76			'isWin9x = True (for debugging purposes)
77			End Property
78
79			Public Property Get MilliSecs() As Double
80			MilliSecs = m_dMilliSecs
81			End Property
82
83			Public Property Get Seconds() As Integer
84			Seconds = m_iSecs
85			End Property
86
87			Public Property Get Minutes() As Integer
88			Minutes = m_iMins
89			End Property
90
91			Public Property Get Hours() As Integer
92			Hours = m_iHours
93			End Property
94
95			Public Property Get Days() As Integer
96			Days = m_iDays
97			End Property
98
99			Public Property Get CPUTime() As String
100			CPUTime = m_sCPUTime
101			End Property
102
103			Public Property Get PercentIdle() As String
104			PercentIdle = m_iPercentIdle
105			End Property
106
107			Public Function Init()
108			On Error GoTo errhandler
109
110			If GetVersion() And &H80000000 Then
111			m_Win9x = True
112			Else
113			m_Win9x = False
114			End If
115
116			If m_Win9x Then Exit Function
117
118			If PdhVbOpenQuery(hPdhQuery) <> ERROR_SUCCESS Then Exit Function
119			' \\computer\System\System Up Time
120			sCounterPath = "\\" & IIf(Len(m_sComputerName) = 0, ".", m_sComputerName) & "\System\System Up Time"
121
122			If PdhVbAddCounter(hPdhQuery, sCounterPath, hPdhCounter) <> ERROR_SUCCESS Then
123			Exit Function
124			End If
125
126			If PdhVbAddCounter(hPdhQuery, "\Processor(0)\% Processor Time", hPdhCounterCPU) <> ERROR_SUCCESS Then
127			Exit Function
128			End If
129
130			Exit Function
131			errhandler:
132			'msgDialog 1, Err.Description, "Error #" & Err.Number & " - Source: " & Err.Source
133			End Function
134
135			Public Function Unload()
136			Call PdhCloseQuery(hPdhQuery)
137			End Function
138
139			Public Function Capture(Optional GetIdle As Boolean = False) As Boolean
140			On Error GoTo errhandler
141
142			Dim nStatusCode As Long
143			Dim pdhfmtcv As PDH_FMT_COUNTERVALUE
144			Dim pdhStatus As Long
145			Dim dblCounterValue As Double
146			Dim nMsecs As Double
147			Dim lUptime As Double 'Uptime in seconds
148
149			If PdhCollectQueryData(hPdhQuery) <> ERROR_SUCCESS Then
150			Exit Function
151			End If
152
153			nStatusCode = PdhGetFormattedCounterValue(hPdhCounter, PDH_FMT_LARGE, ByVal 0&, pdhfmtcv)
154
155			If nStatusCode <> ERROR_SUCCESS Or PdhVbIsGoodStatus(pdhfmtcv.CStatus) = 0 Then
156			Exit Function
157			End If
158
159			'Get CPU info
160			dblCounterValue = PdhVbGetDoubleCounterValue(hPdhCounterCPU, pdhStatus)
161			m_sCPUTime = CStr(Replace(Format(dblCounterValue, "0.00"), ",", "."))
162
163			lUptime = pdhfmtcv.largeValueHi
164
165			m_dMilliSecs = CDbl(lUptime * 1000)
166			m_iSecs = lUptime Mod 60
167			m_iMins = (lUptime Mod 3600) \ 60
168			m_iHours = (lUptime Mod (3600& * 24)) \ 3600
169			m_iDays = lUptime \ (3600& * 24)
170			Capture = True
171
172			If (GetIdle = True) And (m_Win9x = False) Then
173			'Save CPU idle information
174			Dim PercentIdle As Integer
175			Dim TotalSamples As Long
176			Dim IdleSamples As Long
177
178			TotalSamples = CLng(GetSetting("Uptime", "Idle", "TotalSamples", "0"))
179			IdleSamples = CLng(GetSetting("Uptime", "Idle", "IdleSamples", "0"))
180
181			TotalSamples = TotalSamples + 1
182			If m_sCPUTime = "0.00" Then IdleSamples = IdleSamples + 1
183
184			PercentIdle = CInt((IdleSamples / TotalSamples) * 100)
185			m_iPercentIdle = PercentIdle
186			SaveSetting "Uptime", "Idle", "TotalSamples", CStr(TotalSamples)
187			SaveSetting "Uptime", "Idle", "IdleSamples", CStr(IdleSamples)
188			End If
189
190			Exit Function
191			errhandler:
192			'msgDialog 1, Err.Description, "Error #" & Err.Number & " - Source: " & Err.Source
193			End Function