Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
GetCPU
| Uploader: |  csde_rats |
| Datum/Zeit: | 11.11.2007 16:53:04 |
#Include "windows.bi"
#Undef GetVersionEx
Dim Shared GetVersionEx As Function (_
ByVal lpVersionInformation As OSVERSIONINFO) As Long
Dim kernel32 As Any Ptr = DylibLoad("kernel32.dll")
GetVersionEx = DylibSymbol(kernel32, "GetVersionEx")
Dim Shared PdhCollectQueryData As Function ( _
ByVal QueryHandle As Long) As Long
Dim Shared PdhVbGetDoubleCounterValue As Function ( _
ByVal CounterHandle As Long, _
ByRef CounterStatus As Long) As Double
Dim Shared PdhOpenQuery As Function ( _
ByVal Reserved As Long, _
ByVal dwUserData As Long, _
ByRef hQuery As Long) As Long
Dim Shared PdhCloseQuery As Function ( _
ByVal hQuery As Long) As Long
Dim Shared PdhVbAddCounter As Function ( _
ByVal QueryHandle As Long, _
ByVal CounterPath As String, _
ByRef CounterHandle As Long) As Long
Dim As Any Ptr PDH=DylibLoad("PDH.DLL")
PdhCollectQueryData=DylibSymbol(PDH, "PdhCollectQueryData")
PdhVbGetDoubleCounterValue=DylibSymbol(PDH, "PdhVbGetDoubleCounterValue")
PdhOpenQuery=DylibSymbol(PDH, "PdhOpenQuery")
PdhCloseQuery=DylibSymbol(PDH, "PdhCloseQuery")
PdhVbAddCounter=DylibSymbol(PDH, "PdhVbAddCounter")
Const PDH_CSTATUS_VALID_DATA = &H0
Const PDH_CSTATUS_NEW_DATA = &H1
'Const ERROR_SUCCESS = 0
'Const VER_PLATFORM_WIN32_NT = 2
Const OSVERSIONINFOSIZE = 148
Dim Shared hQuery As Long
Dim Shared hCounter As Long
Dim Shared RetVal As Long
Dim Shared Stack() As Long
Dim Shared StackPointer As Long
Dim Shared m_StackSize As Long
Dim Shared m_Sum As Long
Dim Shared m_BandWidth As Long
Sub PushBandWidth(ByRef NewBandWidth As Long)
Static u As Long
u = UBound(Stack)
If StackPointer <= u Then
Stack(StackPointer) = NewBandWidth
m_Sum = m_Sum + NewBandWidth
StackPointer = StackPointer + 1
Else
m_Sum = m_Sum - Stack(0) + NewBandWidth
CopyMemory(Stack(0), Stack(1), u * 4)
Stack(u) = NewBandWidth
End If
m_BandWidth = m_Sum / StackPointer
End Sub
Function GetValue9x() As Long
Dim V As Long
Static hK As Long, sK As String
Const KDyn As Long = &H80000006
sK = *IIf(hK = 0, @"PerfStats\StartStat", @"PerfStats\StatData")
If RegOpenKey(KDyn, sK, hK) Then Exit Function
RegQueryValueEx(hK, "KERNEL\CPUUsage", 0, 4, V, 4)
RegCloseKey(hK)
PushBandWidth V
GetValue9x = m_BandWidth
End Function
Function GetValueNT() As Long
Dim dblValue As Double
Dim pdhStatus As Long
' definierten Counter aktualisieren
PdhCollectQueryData(hQuery)
dblValue = PdhVbGetDoubleCounterValue(hCounter, pdhStatus)
' Wert des Counters abfragen
If (pdhStatus = PDH_CSTATUS_VALID_DATA) Or _
(pdhStatus = PDH_CSTATUS_NEW_DATA) Then
PushBandWidth CLng(dblValue)
GetValueNT = m_BandWidth
End If
End Function
' NT-System?
Function IsNT() As Boolean
Static ThisVerInfo As OSVERSIONINFO, bOsVersionInfoEx As Long
Static Flag As Boolean, NT As Boolean
If Not Flag Then
ThisVerInfo.dwOSVersionInfoSize = Len(ThisVerInfo)
bOsVersionInfoEx = GetVersionEx(ThisVerInfo)
If bOsVersionInfoEx = 0 Then
ThisVerInfo.dwOSVersionInfoSize = OSVERSIONINFOSIZE
GetVersionEx(ThisVerInfo)
End If
NT = (ThisVerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT)
Flag = True
End If
IsNT = NT
End Function
Sub Class_Initialize()
m_StackSize = 5
ReDim Stack(0 To m_StackSize - 1)
StackPointer = 0
If IsNT Then
RetVal = PdhOpenQuery(0, 1, hQuery)
If RetVal = 0 Then
' Performance-Counter definieren
RetVal = PdhVbAddCounter(hQuery, _
"\Prozessor(0)\Prozessorzeit (%)", hCounter)
' Query im Fehlerfall wieder schließen
If RetVal <> 0 Then PdhCloseQuery(hQuery)
End If
End If
End Sub
Class_Initialize()
Do
Print "CPU: " & GetValueNT() & "%"
If InKey = Chr(27) Then Exit Do
Loop