Print Page | Close Window

CPU usage shown

Printed From: Mirage Source
Category: Tutorials
Forum Name: Submitted Tutorials
Forum Discription: Tutorial submissions for MSE are posted here, waiting for approval
URL: http://ms.shannaracorp.com/backup-forums/forum_posts.asp?TID=68
Printed Date: 20 December 2006 at 6:03pm
Software Version: Web Wiz Forums 8.01 - http://www.webwizforums.com


Topic: CPU usage shown
Posted By: minatours
Subject: CPU usage shown
Date Posted: 08 February 2006 at 9:31am

This code adds a little cpu usage graph to your server, and if don’t have access to the server you can get it by typing ‘/cpu’ on th client.. Only for developers and higher.

 

Code by

copyright © 2001, The KPD-Team

Visit our site at http://www.allapi.net

 

Server

 

Changed:

ModGlobals

ModHandleData

 

Added:

MdCPU.bas

ClsCpuUsage.cls

ClsCpuUsagNt.cls

 

ModGlobals

 

Add at the bottom

Public Ret as Long

 

ModHandleData


   
' ::::::::::::::::::::::::::
    ' :: Cpu   request packet ::
    ' ::::::::::::::::::::::::::
    If LCase(Parse(0)) = "cpu" Then
    If Ret = -1 Then
        Call PlayerMsg(Index, "Error while retrieving CPU usage", White)
    Else
        Call PlayerMsg(Index, "Cpu =" & Ret & "%", White)
    End If

 

 

FrmServer

 

Two picture boxes, a timer and a label.

 

PicUsage (65 by 66)

PicGraph (65 by 241)

TmrRefresh

LblCpuUsage

 

Lay it out kind of like this:

 

Now let’s add the code to this form.

 

Firstly at the top

 

Option Explicit

Private QueryObject As Object


 

Then add this to form_Load

 

   

Private Sub
Form_Load()

    SetThreadPriority GetCurrentThread, THREAD_BASE_PRIORITY_MAX

    SetPriorityClass GetCurrentProcess, HIGH_PRIORITY_CLASS

    If IsWinNT Then

        Set QueryObject = New clsCPUUsageNT

    Else

        Set QueryObject = New clsCPUUsage

    End If

    QueryObject.Initialize

    tmrRefresh.Enabled = True

    tmrRefresh_Timer

End Sub


 

SetThreadPriority GetCurrentThread, THREAD_BASE_PRIORITY_MAX

    SetPriorityClass GetCurrentProcess, HIGH_PRIORITY_CLASS

 

This little bit sets the program priority to high, to make sure that it gets updated even if another program is hogging CPU.

 

If IsWinNT Then

        Set QueryObject = New clsCPUUsageNT

    Else

        Set QueryObject = New clsCPUUsage

    End If

 

This checks what windows you are using so it know what Cls to use.

 

QueryObject.Initialize
    tmrRefresh.Enabled = True
    tmrRefresh_Timer

 

This bit initializes the Query and enables the timer.

 

Add this to Form_Unload

   

tmrRefresh.Enabled
= False

    QueryObject.Terminate

    Set QueryObject = Nothing

 

 

     tmrRefresh.Enabled = False

 

Stop the timer

 

    QueryObject.Terminate

    Set QueryObject = Nothing

 

Terminate the query and set it to nothing

 

 

Private Sub tmrRefresh_Timer()

   

    Ret = QueryObject.Query

    If Ret = -1 Then

        tmrRefresh.Enabled = False

        lblCpuUsage.Caption = ":("

        MsgBox "Error while retrieving CPU usage"

    Else

        DrawUsage Ret, picUsage, picGraph

        lblCpuUsage.Caption = CStr(Ret) + "%"

    End If

End Sub

 

If Ret = -1 Then

        tmrRefresh.Enabled = False

        lblCpuUsage.Caption = ":("

        MsgBox "Error while retrieving CPU usage

 

This little bit checks to if your percentage is blow 0. If it is then stops the timer, shows an unhappy chappy and a message box.

 

Else

        DrawUsage Ret, picUsage, picGraph

        lblCpuUsage.Caption = CStr(Ret) + "%"

    End If

 

Else it draws the usage to the pictures and displays the usage in th label.

 

MdMisc

Option Explicit

Const SPACE = 5

Const BAR_WIDTH = 50

Public Const HWND_TOPMOST = -1&

Public Const HWND_NOTOPMOST = -2&

Public Const SWP_NOSIZE = &H1&

Public Const SWP_NOMOVE = &H2&

Public Const SWP_NOACTIVATE = &H10&

Public Const SWP_SHOWWINDOW = &H40&

Public Const THREAD_BASE_PRIORITY_MAX = 2

Public Const HIGH_PRIORITY_CLASS = &H80

Public Type OSVERSIONINFO

    dwOSVersionInfoSize As Long

    dwMajorVersion As Long

    dwMinorVersion As Long

    dwBuildNumber As Long

    dwPlatformId As Long

    szCSDVersion As String * 128

End Type

Public Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long

Public Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long

Public Declare Function GetCurrentThread Lib "kernel32" () As Long

Public Declare Function GetCurrentProcess Lib "kernel32" () As Long

Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Public GraphPoints(0 To 99) As Long

 

All the publics put together. J

 

Sub DrawUsage(lUsage As Long, picPercent As PictureBox, picGraph As PictureBox)

    Dim Cnt As Long

    picPercent.ScaleMode = vbPixels

    For Cnt = 0 To 10

        picPercent.Line (SPACE, SPACE + Cnt * 3)-(SPACE + BAR_WIDTH, SPACE + Cnt * 3 + 1), IIf(lUsage >= 100 - Cnt * 10 And lUsage <> 0, &HC000&, &H4000&), BF

    Next Cnt

    ShiftPoints

    GraphPoints(UBound(GraphPoints)) = lUsage

    picGraph.Cls

    For Cnt = LBound(GraphPoints) To UBound(GraphPoints) - 1

        picGraph.Line (Cnt, 100 - GraphPoints(Cnt))-(Cnt + 1, 100 - GraphPoints(Cnt + 1)), &H8000&

    Next Cnt

End Sub


 

'Shift all the points from the graph one place to the left

Sub ShiftPoints()

    Dim Cnt As Long

    For Cnt = LBound(GraphPoints) To UBound(GraphPoints) - 1

        GraphPoints(Cnt) = GraphPoints(Cnt + 1)

    Next Cnt

End Sub


 

'return True is the OS is WindowsNT3.5(1), NT4.0, 2000 or XP

Public Function IsWinNT() As Boolean

    Dim OSInfo As OSVERSIONINFO

    OSInfo.dwOSVersionInfoSize = Len(OSInfo)

    'retrieve OS version info

    GetVersionEx OSInfo

    'if we're on NT, return True

    IsWinNT = (OSInfo.dwPlatformId = 2)

End Function

Nxt we need the Classes, thses wre allrady half commented. And someone of it is over my head .

 

ClsCpuUsage

 

Option Explicit

Private Const STANDARD_RIGHTS_ALL = &H1F0000

Private Const KEY_QUERY_VALUE = &H1

Private Const KEY_SET_VALUE = &H2

Private Const KEY_CREATE_SUB_KEY = &H4

Private Const KEY_ENUMERATE_SUB_KEYS = &H8

Private Const KEY_NOTIFY = &H10

Private Const KEY_CREATE_LINK = &H20

Private Const SYNCHRONIZE = &H100000

Private Const READ_CONTROL = &H20000

Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)

Private Const HKEY_DYN_DATA = &H80000006

Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))

Private Const ERROR_SUCCESS = 0&

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private hKey As Long, dwDataSize As Long, dwCpuUsage As Byte, dwType As Long

Public Sub Initialize()

    'start the counter by reading the value of the 'StartStat' key

    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then

        Debug.Print "Error while initializing counter"

        Exit Sub

    End If

    dwDataSize = 4 'Length of Long

    RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize

    RegCloseKey hKey

    'get current counter's value

    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0, KEY_READ, hKey) <> ERROR_SUCCESS Then

        Debug.Print "Error while opening counter key"

        Exit Sub

    End If

End Sub

[cod]Public Function Query() As Long

    dwDataSize = 4 'size of Long

    'Query the counter

    RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize

    Query = CLng(dwCpuUsage)

End Function[/code]

Public Sub Terminate()

    RegCloseKey hKey

    'stopping the counter

    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then

        Debug.Print "Error while stopping counter"

        Exit Sub

    End If

    dwDataSize = 4 'length of Long

    RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize

    RegCloseKey hKey

End Sub

 


 

clsCpuUsageNt

Option Explicit

Private Const SYSTEM_BASICINFORMATION = 0&

Private Const SYSTEM_PERFORMANCEINFORMATION = 2&

Private Const SYSTEM_TIMEINFORMATION = 3&

Private Const NO_ERROR = 0

Private Type LARGE_INTEGER

    dwLow As Long

    dwHigh As Long

End Type

Private Type SYSTEM_BASIC_INFORMATION

    dwUnknown1 As Long

    uKeMaximumIncrement As Long

    uPageSize As Long

    uMmNumberOfPhysicalPages As Long

    uMmLowestPhysicalPage As Long

    uMmHighestPhysicalPage As Long

    uAllocationGranularity As Long

    pLowestUserAddress As Long

    pMmHighestUserAddress As Long

    uKeActiveProcessors As Long

    bKeNumberProcessors As Byte

    bUnknown2 As Byte

    wUnknown3 As Integer

End Type

Private Type SYSTEM_PERFORMANCE_INFORMATION

    liIdleTime As LARGE_INTEGER

    dwSpare(0 To 75) As Long

End Type

Private Type SYSTEM_TIME_INFORMATION

    liKeBootTime As LARGE_INTEGER

    liKeSystemTime As LARGE_INTEGER

    liExpTimeZoneBias  As LARGE_INTEGER

    uCurrentTimeZoneId As Long

    dwReserved As Long

End Type

Private Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal dwInfoType As Long, ByVal lpStructure As Long, ByVal dwSize As Long, ByVal dwReserved As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private liOldIdleTime As LARGE_INTEGER

Private liOldSystemTime As LARGE_INTEGER

Public Sub Initialize()

    Dim SysTimeInfo As SYSTEM_TIME_INFORMATION

    Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION

    Dim Ret As Long

    'get new system time

    Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&)

    If Ret <> NO_ERROR Then

        Debug.Print "Error while initializing the system's time!", vbCritical

        Exit Sub

    End If

    'get new CPU's idle time

    Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&)

    If Ret <> NO_ERROR Then

        Debug.Print "Error while initializing the CPU's idle time!", vbCritical

        Exit Sub

    End If

    'store new CPU's idle and system time

    liOldIdleTime = SysPerfInfo.liIdleTime

    liOldSystemTime = SysTimeInfo.liKeSystemTime

End Sub

Public Function Query() As Long

    Dim SysBaseInfo As SYSTEM_BASIC_INFORMATION

    Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION

    Dim SysTimeInfo As SYSTEM_TIME_INFORMATION

    Dim dbIdleTime As Currency

    Dim dbSystemTime As Currency

    Dim Ret As Long

    Query = -1

    'get number of processors in the system

    Ret = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(Sy sBaseInfo), LenB(SysBaseInfo), 0&)

    If Ret <> NO_ERROR Then

        Debug.Print "Error while retrieving the number of processors!", vbCritical

        Exit Function

    End If

    'get new system time

    Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&)

    If Ret <> NO_ERROR Then

        Debug.Print "Error while retrieving the system's time!", vbCritical

        Exit Function

    End If

    'get new CPU's idle time

    Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&)

    If Ret <> NO_ERROR Then

        Debug.Print "Error while retrieving the CPU's idle time!", vbCritical

        Exit Function

    End If

    'CurrentValue = NewValue - OldValue

    dbIdleTime = LI2Currency(SysPerfInfo.liIdleTime) - LI2Currency(liOldIdleTime)

    dbSystemTime = LI2Currency(SysTimeInfo.liKeSystemTime) - LI2Currency(liOldSystemTime)

    'CurrentCpuIdle = IdleTime / SystemTime

    If dbSystemTime <> 0 Then dbIdleTime = dbIdleTime / dbSystemTime

    'CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors

    dbIdleTime = 100 - dbIdleTime * 100 / SysBaseInfo.bKeNumberProcessors + 0.5

    Query = Int(dbIdleTime)

    'store new CPU's idle and system time

    liOldIdleTime = SysPerfInfo.liIdleTime

    liOldSystemTime = SysTimeInfo.liKeSystemTime

End Function

Private Function LI2Currency(liInput As LARGE_INTEGER) As Currency

    CopyMemory LI2Currency, liInput, LenB(liInput)

End Function

Public Sub Terminate()

    'nothing to do

End Sub

 

 

 

 

CLIENT

 

Ok client side.

 

Change

ModGameLogic

 

 

ModGameLogic

Find

' Editing spell request

 

and add below it this will request the cpu usage percentage.

' Request CPU

             If Mid(MyText, 1, 8) = "/cpu" Then

                 Call SendData("cpu" & SEP_CHAR & END_CHAR)

                 MyText = ""

                 Exit Sub

             End If

 

 

And that’s it. Hope you enjoy Sorry its not more explained. If there is anything wrong post please. Thanks.

 

 




Replies:
Posted By: Sync
Date Posted: 26 February 2006 at 12:59pm
Image missing ..


Posted By: Misunderstood
Date Posted: 09 March 2006 at 10:51am
any idea on what part of that line?
Does it need another parameter, are you using something that it wants as another variable type?

Guess I should probably read the tutorial


Posted By: Sonire
Date Posted: 09 March 2006 at 7:56pm
Syntax Error on this line:

Ret = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(Sy sBaseInfo), LenB(SysBaseInfo), 0&)


Helpz0rz


-------------
I grant permission for anyone to alter a tutorial previously posted by me for use in a tutorial submission for MSE, so long as "Originally Coded By Sonire" is credited at the top of the tutorial.



Print Page | Close Window

Bulletin Board Software by Web Wiz Forums version 8.01 - http://www.webwizforums.com
Copyright ©2001-2006 Web Wiz Guide - http://www.webwizguide.info