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.2
Committed:	Fri Mar 28 16:30:35 2003 UTC (21 years, 7 months ago) by tdb
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.1:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	Removed some un-used code from CVS. We can always resurrect this later if someone feels they want to work on it. Gone are the old perl ihost which isn't needed now, winhost which is broken and shows no sign of being fixed, and DBReporter. If someone wants to revive them, I'll undelete them :-)
#	Content
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