Very basic process CPU load determiner

Windows specific questions.
Post Reply
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Very basic process CPU load determiner

Post by paul doe »

fxm wrote:Yes, I was thinking for large parameters as often the UDT instances.
Precisely. In this particular case, it's pointless =D
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Very basic process CPU load determiner

Post by fxm »

I agree.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

CPU Load2

So far, new versions of CPU Load overwrote the second listing in the opening page. Now, whilst I think CPU Load2 is better than CPU Load I am not going to be dogmatic and overwrite with this version - you may disagree with my logic in this version and prefer CPU Load.

Firstly, I have dropped the 'average of 8' applied to the 'CPU Load' metric. 'CPU Load' now displays the raw data; that is, no conditioning. The 'Max Load' metric always was raw data and that has not changed. The polling has been increased to a default of 1000ms and the display/refresh rate is in line with the polling rate.

A confidence interval has been introduced. However, until at least 30 samples have been taken the third line of the output is as previously; that is, 'Ave Session Load'. Once we have more than 30 samples the third line changes to '95% Conf Interval:' followed by the average and confidence limits. For a one second polling then the third line will change only after 30 seconds have elapsed. 30 is used because the normal distribution, used for calculating the % confidence limits, is unreliable with less.

I mentioned "default of 1000ms". caseih suggested condsidering moving averages over long intervals. Well, that won't happen because I have dropped conditioning. However, there is a place for differing polling rates - as with Task Manager, Process Explorer and Process Hacker. We can now choose a polling rate via a command switch, 'poll:nnn' where nnn is our requested rate. With nnn = 250 we are so close to the action 'CPU Load' becomes very 'busy' and the confidence limits tend to be large. We need to keep the volatility at arms length and this is better served with nnn >= 500. In fact, Process Explorer and Process Hacker have the fastest polling rate set at 500ms. Perhaps their authors also felt that 250ms was too fast. If we choose a value less than 500 then CPU Load2 will override us and use 500.

For large polling values it is worth remembering that the output will be empty until a second sample has been aquired. So, if we choose a polling rate of 10000 (10 seconds) then we will be looking at a blank console for 10 seconds. In addition, the confidence limits will not be shown until five minutes (10s x30) have elapsed.

My preferred polling rate is 1000ms and we get that by not using the switch as it is the default. Process Hacker refers to 1s as 'Normal'.

We can also choose a session time via a command switch, 'samples:nnn'. The session time will actually be samples x polling rate. I have noticed that once we get past 60 samples or so the third line of the output tends to steady for monitoring applications which do not vary the load on the CPU. With regard the normal distribution the more samples the merrier but the law of diminishing returns applies here. I have been using 'samples:120'; beyond which we will not gain any further information. The default for samples is -1, continuous monitoring.

One way of adding switches to a command line is to add them to the 'Target' box of a shortcut. Another way, which is what I have been doing, is to use my 'Run with switches'. You can use the attached zip of the opening post of that thread or compile your own FB version with the code at the bottom part of that thread.

With 'Run with switches' we simply right click on the CPU Load2 exe, choose 'Run with switches' and type something like 'poll:500 samples:120' and then press OK.

Here is a test using Cpustres.exe and the Performance Monitor. The Performance Monitor fills a graph in 100 seconds polling at one second. With CPU Load2 I used 'samples:100' and the default polling rate of 1000ms.

Image

The 'Max Load' will always be at the top end of the confidence interval and will often exceed it. In this case it is within the confidence limits. Our average of 21.06 is a little shy of the Performance Monitor average of 21.450 but the point of CPU Load2 is not about averages but about confidence intervals which gives us a little more insight than just an average.

CPU Load2 ( Latest version )

Code: Select all

#include once "windows.bi"
#include once "win\winbase.bi"
#Include Once "win\mmsystem.bi"
#include once "string.bi"

Type myCursorInfo
  dwSize As Dword
  bVisible As Boolean
End Type

#define CrLf Chr(10)+Chr(13)
#define Cancel 2

Dim Shared As Long cores, Samples = -1
Dim Shared As boolean FirstInstance = True
Dim Shared As Single Multiplier = 1.96
Dim Shared As String perCent

' Default confidence level
perCent = "95% "

Dim As Uint_Ptr TimerID
Dim As Longint Dummy, KernelTime, UserTime
Dim As Dword ProcessId, Result, Answer
Dim As Handle hProcess
Dim As WinBool Inherit
Dim TaskListLoaded As boolean
Dim As Handle hOut
Dim info As myCursorInfo
Dim As Long i, poll = 1000
Dim As String TargetName, TaskList

' Console specifics
DeleteMenu(GetSystemMenu(GetConsoleWindow,False), SC_CLOSE, MF_BYCOMMAND)
SetConsoleTitle("CPU Load")
SetWindowPos( GetConsoleWindow, HWND_TOPMOST, 200, 400, 0, 0, SWP_NOSIZE )

Function loadfile(file As String) As String 'By dodicat
  Var  f=Freefile
  Open file For Binary Access Read As #f
  Dim As String text
  If Lof(1) > 0 Then
    text = String(Lof(f), 0)
    Get #f, , text
  End If
  Close #f
  Return text
End Function

Sub GetCPULoad( uTimerID As Uint, uMsg As Uint, dwUser As Handle, dw1 As Dword_Ptr, dw2 As Dword_Ptr )
  Static As Longint LastKernelTime, LastUserTime
  Static As Ulongint FreqPC, LastPC, SessionStart, SessionNow
  Static As Double MaxLoad, totCPU, totCPU2
  Static As Long passCount
  Dim As Longint Dummy, KernelTime, UserTime
  Dim As Double CPULoad, tot, ConfInt
  Dim hProcess As Handle
  Dim As Ulongint PC
	
  If FirstInstance Then
    FirstInstance = false
    MaxLoad = 0
    totCPU = 0
    totCPU2 = 0
    passCount = 0
    QueryPerformanceFrequency Cast( Large_Integer Ptr, @FreqPC )
    Sleep 1
    ' GetProcessTimes will be executed at the next interrupt
    GetProcessTimes( dwUser, Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @LastKernelTime), Cast(LPFILETIME, @LastUserTime ) )
    QueryPerformanceCounter Cast( Large_Integer Ptr, @LastPC )
    SessionStart = LastPC
  Else
    Sleep 1 ' GetProcessTimes will be executed at next interrupt
    GetProcessTimes( dwUser, Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @KernelTime), Cast(LPFILETIME, @UserTime ) )
    QueryPerformanceCounter Cast( Large_Integer Ptr, @PC )
    CPULoad = (KernelTime - LastKernelTime + UserTime - LastUserTime)*FreqPC/( (PC - LastPC)*cores*10^5 )
    totCPU += CPULoad
    totCPU2 += CPULoad*CPULoad
    passCount += 1
    ConfInt = Multiplier*Sqr((totCPU2 - totCPU*totCPU/passCount)/passCount)
    Locate 4, 10
    Print "CPU Load:  ";Format(CPULoad, "##0.00")
    Locate 6, 10
    Print "Max Load:  ";Format( MaxLoad, "##0.00" )
    If passCount > 30 Then
      Locate 8,10
      Print perCent;"Conf Interval:  ";Format(totCPU/passCount,"##0.00");" ";Chr(241);" ";Format(ConfInt,"##0.00");"   "
    Elseif passCount > 1 Then
      Locate 8,10
      Print "Ave Session Load:  ";Format(totCPU/passCount,"##0.00")
    End If
    Locate 10,10
    Print "Session Time:  ";Format( (PC - SessionStart)/FreqPC, "####0.0" );" seconds"
    LastKernelTime = KernelTime
    LastUserTime = UserTime
    LastPC = PC
    If CPULoad > MaxLoad Then MaxLoad = CPULoad
    If Samples > 0 Then
      ' Fall through Sleep and kill the timer 'If passCount >= Samples'
      If passCount >= Samples Then SendMessage(GetConsoleWindow, WM_CHAR, Cast(WPARAM,27), Cast(LPARAM,1))
    End If
  End If
End Sub

Width 50, 11

' Get command line
Dim As String arg = Ucase(Command)
Dim As Long find

If Len(arg) <>  0 Then
  find = Instr( arg, "POLL:" )
  If find <> 0 Then
    poll = Val(Mid( arg, find + 5 ))
    If poll = 0 Then
      poll = 1000
    Elseif poll < 500 Then
      poll = 500
    End If
  End If
  find = Instr( arg, "SAMPLES:" )
  If find <> 0 Then
    Samples = Val(Mid( arg, find + 8 ))
    If Samples = 0 Then Samples = -1
  End If
  If Instr( arg, "LOWCI" ) Then
    Multiplier = 1.64485
    perCent = "90% "
  Elseif Instr( arg, "HIGHCI" ) Then
    Multiplier = 2.57583
    perCent = "99% "
  End If
End If

'Get number of cores
Shell "echo %NUMBER_OF_PROCESSORS% >tmpcores.txt"
cores=Valint(loadfile("tmpcores.txt"))
Kill "tmpcores.txt"

' Prepare for cursor control
hOut = GetStdHandle( STD_OUTPUT_HANDLE )
Info.dwSize = 100

Do
  ' Get target name
  Input "  Target's name: ";TargetName
  
  ' Knock cursor on the head
  Info.bVisible = False
  SetConsoleCursorInfo( hOut, Cast( CONSOLE_CURSOR_INFO Ptr, @info ) )
  
  If TargetName = "" Then
    Print "  Target name was empty"
    Goto ConsiderLeaving
  End If
  TargetName = Ucase( TargetName )
  Shell "cmd.exe /c tasklist > tasklist.txt"
  TaskList = loadfile("tasklist.txt")
  If TaskList = "" Then
    Print "  Had a problem loading Task list"
    Goto ConsiderLeaving
  End If
  TaskListLoaded = true
  TaskList = Ucase( TaskList )
  Find = Instr(Tasklist, TargetName)
  If Find = 0 Then
    Print "  Could not find target's name in Task list"
    Goto ConsiderLeaving
  End If
  Find = Instr(find + Len(TargetName), TaskList, " ")
  If Find = 0 Then
    Print "  Found target name in Task list but then had a problem"
    Goto ConsiderLeaving
  End If
  TaskList = Mid(Tasklist, find)
  ProcessId = Valint(TaskList)
  If ProcessId = 0 Then
    Print "  I got zero for the process id"
    Goto ConsiderLeaving
  End If
  Kill "tasklist.txt"
  TaskListLoaded = False
  Cls
  
  ' Begin output
  Print "    Press ENTER to stop monitoring PID #";ProcessID
  hProcess = OpenProcess( PROCESS_ALL_ACCESS, Inherit, Cast(Dword, ProcessId ) )
  If hProcess = 0 Then
    Print
    Print "  Open process failed"
    Goto ConsiderLeaving
  End If
  Result = GetProcessTimes( hProcess, Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @KernelTime), Cast(LPFILETIME, @UserTime ) )
  If Result = 0 Then
    Print
    Print "  Get process times failed"
    Goto ConsiderLeaving
  End If
  
  ' Set up timer. Maximum resolution, 16, used - that will be mitigated in Sub GetCPULoad
  TimerID = timeSetEvent( poll, 16, Cast( LPTIMECALLBACK, @GetCPUload ), Cptr( Dword_Ptr, hProcess ), TIME_PERIODIC )
  
  Sleep ' We will fall through this with the automatic timeout using the 'samples' switch
  
  If TimerID <> 0 Then timeKillEvent TimerID
  
  ConsiderLeaving:
  ' Slight pause
  Sleep 500, 1
  Answer = MessageBox( Null, "Click Retry to consider another process." + CrLf + CrLf _
  + "Click Cancel to Exit CPU Load.", "CPU Load", MB_RETRYCANCEL + MB_ICONSTOP + MB_TOPMOST )
  
  ' There maybe a character in the keyboard buffer - get rid of it
  Dim As String char = Inkey
  
  If Answer = Cancel  Then
    If hProcess <> 0 Then CloseHandle hProcess
    If TaskListLoaded Then Kill "tasklist.txt"
  Else
    ' Bring cursor back
    Info.dwSize = 1
    Info.bVisible = true
    SetConsoleCursorInfo( hOut, Cast( CONSOLE_CURSOR_INFO Ptr, @info ) )
    Cls
    FirstInstance = True
  End If
  
Loop Until Answer = Cancel
Last edited by deltarho[1859] on Nov 08, 2017 0:08, edited 2 times in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

I should mention, or perhaps not, that the 95% confidence interval is got by a multiplier of 1.96 in the code. We can be more confident with a larger interval and use a multiplier of 2.57583 corresponding to 99%. With less confidence and a smaller interval we can use a multiplier of 1.64485 corresponding to 90%. However, failing an argument on what to use the consensus of opinion is to use 95%. What to actually use depends upon the environment the data is sourced from and, possibly, the result of a risk assessment. We could be talking about medical practices or tool manufacturing tolerances or whatever.

I was tempted to include a switch in this context but remembered a blog by Bruce Schneier who effectively said with regard to cryptography software "Don't give users too many choices unless you know they fully appreciate what the choices mean". My first cryptography programs gave users more options than you could shake a stick at. After reading Schneier's blog I realised that assuming that my users were as au fait with the subject as yours truly was a grave mistake. <smile>
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

If you find that a with a particular test the confidence interval is larger than usual compared with the average it may be because the CPU load is more volatile than usual and even a polling rate of 1s is too close to the action. In this case it may be worthwhile polling at 2s. Perhaps this is why the other programs have options for slower polling rates. I am learning as I go along here. <smile>
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

A tale of two snapshots.

Image

The top snapshot examines 120 samples at the default of 1ms intervals and a 95% confidence interval.

The bottom snapshot, again, examines 120 samples but at 2ms intervals and a 90% confidence interval. At a slower polling rate we are 'pulling away from the action' and would expect a smaller confidence interval. Reducing the level of confidence will also give a smaller confidence interval.

The average load is almost identical but the confidence limits are very much closer with the second snapshot.

This what I meant by having too many options.

I favour the top snapshot: It is not too close to the action and not too far away and does not mask the underlying volatility. We are more likely to capture a higher max load. I prefer a 95% confidence interval over a 90% confidence interval.

If we were not talking about CPU loads but something completely different then the second snapshot approach may be preferable.

Having said that someone may have an argument for the second snapshot approach with regard CPU loads and that is because we are not talking mathematics here but statistics. <smile>
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

I have been experimenting with the 99% confidence interval. I was concerned that the intervals displayed may be high and not particularly helpful but this not proving to be the case especially with higher CPU loads which seem to be less volatile. However, for high loads I have only being using Cpustres.exe so this may not always be the case, I don't know.

It is worth checking out confidence intervals if this is new to you.

So, I have decided to add another two switches. LowCI -> 90% confidence intervals and HighCI -> 99% confidence intervals. The default is 95%

We could then have a command line like 'samples: 120 poll: 750 HighCI.

I should have mentioned before now that samples and poll are not case sensitive and nor are LowCI and HighCI.

With above example the session will automatically time out in 90 seconds ( 120 x 750 / 1000 )

You may need to experiment with the confidence interval for a particular application that you are monitoring. I would suggest that once you are happy with the output then as you tweak your application stick to the same confidence interval.

I have added some comments to the code as some things are not obvious without reading all of the notes above.

CPU Load2 updated above.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

Update

I have been using CPULoas2 quite a lot lately and I've had a few ideas.

Firstly, the display order of the metrics has changed and, to my mind, is a little better.

Code: Select all

    Press ENTER to stop monitoring PID #19300
 
 
            Current CPU Load:  0.00
 
            Ave Session Load:  3.65
 
            99% Conf Limit: <= 4.45
 
            Max Load:  13.14
 
            Session Time:  120.0 seconds
When CPULoad2 opens, we are invited to input a target name. We no longer have to include an extension; “.exe” is added for us.

When we analyse samples, we should use the t-distribution and not the normal distribution if the number of samples is less than thirty. For the t-distribution we have to have access to a table which lists values according to the number of samples. To avoid that, the original CPULoad2 displayed the average session load and replaced that with a confidence interval when the number of samples exceeded thirty; with the normal distribution being used.

The average session load is a useful metric, so now gets displayed all the time. The third metric line is initially blank and does not get populated until the number of samples exceeds thirty.

Some people, including some scientists, don't fully understand what is meant by 'confidence interval'. They think that the interval is a certainty for future samples; it isn't.

Confidence intervals are usually displayed as x ± y. If, for example, we have 95% 8 ± 2 what that means is we are 95% confident that future values will fall within that range. Another way of putting that we are 5% confident, that is not very, that future values will fall outside the range.

The original CPULoad2 was two-sided like 8 ± 2. If the 8 was smaller and the 2 larger, we could have a negative lower bound. That would be nonsense in the context of CPU load, so now a confidence limit is used rather than a confidence interval.

In the above we have '99% Conf Limit: <= 4.45' What that means is with the given samples CPULoad2 is 99% confident that a future load will not exceed 4.45. Well, we have one in the 'Max Load: 13.14'. Historically, we cannot have that many high-value samples indicated by 'Ave Session Load: 3.65' and that is why the average session load now gets displayed all the time. If, for some reason, the average session load starts to increase, then the confidence limit will also increase and vice versa.

I have two monitors and could have CPULoad2 located anywhere. Messages were always displayed in the centre of my primary monitor. I find that a pain, so now messages are displayed in the centre of CPULoad's console. Hopefully, you will only see one message when a session ends. The code for centring was written by Bernhard Fomm at the PowerBASIC forums; a very long time ago.

The only problem with this is we are unable to copy the CPULoad2 screen at the end of a session. So now if we click on Cancel the message clears, and we are given twenty seconds to copy the screen before CPULoad2 closes. Needless to say, if you would rather not make a copy, then press any key to close; CPULoad2 is only Sleeping at this point.

This topic runs into a few pages, and I cannot remember if I mentioned that we can have more than one instance. I was using two instances in the thread 'FreeBASIC's Timer'. However, we can, well, I can, forget which instance is doing what, so the title bar now includes the name of the process being monitored.

Command line switches

The 'pool:' switch is as the original CPULoad2. It defaults to 1000ms, but can be changed to 500ms using pool:500. Actually, any value <= 500 will give 500.

The 'Samples' switch is as the original CPULoad2. Pooling at 1000ms will see a session time limited to 120 seconds using Samples:120. Pooling at 500ms will see a session time limited to 60 seconds using Samples:120. I use poll:500 and Samples:240 giving a session time of 120 seconds. Without declaring samples, CPULoad will run indefinitely until we intervene.

The original CPULoad2 used a default confidence value of 95% with a LOWCI switch for 90% and a HIGHCI switch for 99%. For CPU loads I think it's better to default to 99% and that is the case now. We can lower that with a MIDCL switch for 95% and LOWCL switch for 90%, your choice. Note that the last character is 'L' and not 'I' for limit rather than interval. All switches are case-insensitive.

If we run CPULoad2 alongside Process Explorer then the process loads are pretty much in agreement. The process load in Task Manager tends to be a little higher. This is odd, assuming all three applications use the same APIs.

CPULoad2.bas

Compile as a Win32 console and '-gen gcc -O 2' is OK

Code: Select all

'#console on
'#Resource "Theme.rc"
#include once "windows.bi"
#include once "win\winbase.bi"
#Include Once "win\mmsystem.bi"
#include once "string.bi"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

#define CrLf Chr(10)+Chr(13)

Dim Shared hHookMsgBox As HHook
Dim Shared hMsgBoxParent As HWND
Dim Shared MsgBoxTimedOut As Long

Function CenteredMessageBox_CB ( lMsg As Long, wParam As HWND, lParam As ulong ) As Long
Dim As Rect rc1, rc2
Dim As Long x, y
  If lMsg = HCBT_ACTIVATE Then
    If hMsgBoxParent <> HWND_DESKTOP Then
      GetWindowRect hMsgBoxParent, Cast( LPRECT, @rc1)
      GetWindowRect wParam, Cast( LPRECT, @rc2)
      x = (rc1.Left + rc1.Right - rc2.Right + rc2.Left) / 2
      y = (rc1.Top + rc1.Bottom - rc2.Bottom + rc2.Top) / 2
      SetWindowText GetDlgItem(wParam, IDRETRY), "New target"
      SetWindowText GetDlgItem(wParam, IDCANCEL), "Exit"
      SetWindowPos wParam, HWND_TOPMOST, x, y, 0, 0, SWP_NOSIZE
    End If
    UnhookWindowsHookEx hHookMsgBox
    Return 0 
  End If
End Function

Function CenteredMessageBox ( hWindow As HWND, _ ' Parent window handle
                              lpText As ZString, _ ' The message to be displayed
                              lpCaption As ZString, _ ' The message box caption
                              uType As Long _ ' Specifies the contents and behavior of the dialog box - MB_OK and so on
                            ) As Long
  hMsgBoxParent = hWindow
  hHookMsgBox = SetWindowsHookEx( WH_CBT, Cast( HOOKPROC, @CenteredMessageBox_CB), GetModuleHandle( 0 ), GetCurrentThreadId )
  Function = MessageBox( hWindow, lpText, lpCaption, uType )
End Function

Dim Shared As HWND hConsole
hConsole = GetConsoleWindow

Type myCursorInfo
  dwSize As Dword
  bVisible As Boolean
End Type

Dim Shared As Long cores, Samples = -1
Dim Shared As boolean FirstInstance = True
Dim Shared As Single Multiplier = 2.3263 ' 99%
Dim Shared As String perCent
Dim Shared As Dword ProcessID
perCent = "99% "
Dim Shared As Uint_Ptr TimerID
Dim As Longint Dummy, KernelTime, UserTime
Dim As Dword Result, Answer
Dim As Handle hProcess
Dim As WinBool Inherit
Dim As Handle hOut
Dim info As myCursorInfo
Dim As Long i, poll = 1000
Dim Shared As String TargetName, oldTargetName, TaskList

' Console specifics
DeleteMenu(GetSystemMenu(GetConsoleWindow,False), SC_CLOSE, MF_BYCOMMAND)
SetWindowPos( GetConsoleWindow, HWND_TOPMOST, 200, 400, 0, 0, SWP_NOSIZE )
SetConsoleTitle("CPULoad2")

Function PipeToString ( Byval s As String = "" ) As String
#define max_ 2000000
Var f=Freefile
  Open Pipe s For Binary Access Read As #f
    s = Input(max_,f)
  Close #f
  return s
End Function

Sub GetCPULoad( uTimerID As Uint, uMsg As Uint, dwUser As Handle, dw1 As Dword_Ptr, dw2 As Dword_Ptr )
  Static As Longint LastKernelTime, LastUserTime
  Static As Ulongint FreqPC, LastPC, SessionStart, SessionNow
  Static As Double MaxLoad, totCPU, totCPU2, totxx
  Static As Long passCount, Check = True
  Dim As Longint Dummy, KernelTime, UserTime
  Dim As Double CPULoad, tot, ConfInt, SD
  Dim As Ulongint PC
  Dim As Boolean MB = True
	
  If FirstInstance Then
    FirstInstance = false
    MaxLoad = 0
    totCPU = 0
    totCPU2 = 0
    passCount = 0
    totxx = 0
    oldTargetName = TargetName
    QueryPerformanceFrequency Cast( Large_Integer Ptr, @FreqPC )
    Sleep 1 ' GetProcessTimes will be executed at the next interrupt
    GetProcessTimes( dwUser, Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @LastKernelTime), Cast(LPFILETIME, @LastUserTime ) )
    QueryPerformanceCounter Cast( Large_Integer Ptr, @LastPC )
    SessionStart = LastPC
  Else
    Dim As Long find
    Dim As String Dummy
    Dummy = pipetostring("tasklist /fi " & chr(34) & "PID eq " & Str(ProcessID) & Chr(34))
    find = Instr( Dummy, Str(ProcessID) )
    If find = 0 Then
      CenteredMessageBox( hConsole, "It appears that PID #" + Str(ProcessID) + " is no longer running.", _
      "CPULoad2", MB_TASKMODAL + MB_OK + MB_TOPMOST )
      ' Kill the timer 
      If TimerID <> 0 Then timeKillEvent TimerID
      SendMessage(GetConsoleWindow, WM_CHAR, Cast(WPARAM,27), Cast(LPARAM,1))
    end if
    Sleep 1 ' GetProcessTimes will be executed at next interrupt
    GetProcessTimes( dwUser, Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @KernelTime), Cast(LPFILETIME, @UserTime ) )
    QueryPerformanceCounter Cast( Large_Integer Ptr, @PC )
    CPULoad = (KernelTime - LastKernelTime + UserTime - LastUserTime)*FreqPC/( (PC - LastPC)*cores*10^5 )
    totCPU += CPULoad
    totxx += CPULoad * CPULoad
    passCount += 1
    totCPU2 += (CPULoad - totCPU/passCount)^2 ' sigma( (x - xbar)^2 )
    If passCount > 1 Then
      SD = Sqr( (totxx - totCPU^2/passCount)/(passCount - 1) )
    End If
    ConfInt = Multiplier * sqr( totCPU2 )/passCount
    Locate 5, 13
    Print "Current CPU Load:   ";Format(CPULoad, "##0.00");" "
    Locate 7, 13
    Print "Ave Session Load:   ";Format(totCPU/passCount,"##0.00");" "
    Locate 9, 13
    If passCount > 1 Then
      Print "Standard Deviation: ";Format(SD,"##0.00");" "
    End If
    If passCount > 30 Then
      Locate 11,13
      Print perCent;"Conf Limit:  <= ";Format(totCPU/passCount + ConfInt,"##0.00");" "
    End If
    Locate 13,13
    Print "Max Load:          ";Format( MaxLoad, "##0.00" );" "
    Locate 15,13
    Print "Session Time:  ";Format( (PC - SessionStart)/FreqPC, "####0.0" );" seconds "
    LastKernelTime = KernelTime
    LastUserTime = UserTime
    LastPC = PC
    If CPULoad > MaxLoad Then MaxLoad = CPULoad
    If Samples > 0 Then
      ' Kill the timer
      If passCount >= Samples Then
        If TimerID <> 0 Then timeKillEvent TimerID
        SendMessage(GetConsoleWindow, WM_CHAR, Cast(WPARAM,27), Cast(LPARAM,1))
      end if
    End If
  End If
End Sub

Width 50, 17

' Get command line
Dim As String arg = Ucase(Command)
Dim As Long find

If Len(arg) <>  0 Then
  find = Instr( arg, "POLL:" )
  If find <> 0 Then
    poll = Val(Mid( arg, find + 5 ))
    if poll < 100 Then
      poll = 100
    End If
    if poll > 1000 Then
      poll = 1000
    End If
  End If
  find = Instr( arg, "SAMPLES:" )
  If find <> 0 Then
    Samples = Val(Mid( arg, find + 8 ))
    If Samples = 0 Then Samples = -1
  End If
  If Instr( arg, "LOWCL" ) Then
    Multiplier = 1.2816
    perCent = "90% "
  Elseif Instr( arg, "MIDCL" ) Then
    Multiplier = 1.6449
    perCent = "95% "
  End If
End If

'Get number of cores
cores = Valint(PipeToString("echo %NUMBER_OF_PROCESSORS%"))

' Prepare for cursor control
hOut = GetStdHandle( STD_OUTPUT_HANDLE )
Info.dwSize = 100

Dim As Ulong targetFound
Do
  ' Get target name
  Input "  Target's name: ";TargetName
  ' Knock cursor on the head
  Info.bVisible = False
  SetConsoleCursorInfo( hOut, Cast( CONSOLE_CURSOR_INFO Ptr, @info ) )
  If Ucase(TargetName) <> "RESET" Then   
    If TargetName = "" Then
      CenteredMessageBox( hConsole, "Target name was empty.", "CPULoad2", MB_OK + MB_TOPMOST )
      Goto ConsiderLeaving
    Else
      TargetName += ".exe"
      SetConsoleTitle("CPULoad2 : " + TargetName)
    End If
    TargetName = Ucase( TargetName )
    TaskList = PipeToString("tasklist")
    If TaskList = "" Then
      CenteredMessageBox( hConsole, "Had a problem loading Task list.", "CPULoad2", MB_OK + MB_TOPMOST )
      SetConsoleTitle("CPULoad2")
      Goto ConsiderLeaving
    End If
    TaskList = Ucase( TaskList )
    Find = Instr(Tasklist, TargetName)
    If Find = 0 Then
      CenteredMessageBox( hConsole, "Could not find target's name in Task list.", "CPULoad2", MB_OK + MB_TOPMOST )
      SetConsoleTitle("CPULoad2")
      Goto ConsiderLeaving
    Else
      targetFound = find
    End If
    Find = Instr(find + Len(TargetName), TaskList, TargetName)
    If Find <> 0 Then
      CenteredMessageBox( hConsole, "Found another instance of " + TargetName  + CrLf + CrLf _
      + "I am not designed to handle multiple process names.", "CPULoad2", MB_OK + MB_TOPMOST )
      SetConsoleTitle("CPULoad2")
      Goto ConsiderLeaving
    end if
    TaskList = Mid(Tasklist, targetFound + Len(TargetName) )
    ProcessId = Valint(TaskList)
    If ProcessId = 0 Then
      CenteredMessageBox( hConsole, "I got zero for the process id.", "CPULoad2", MB_OK + MB_TOPMOST )
      SetConsoleTitle("CPULoad2")
      Goto ConsiderLeaving
    End If
  Else
    TargetName = oldTargetName
    If TargetName = "" Then
      CenteredMessageBox( hConsole, "I don't have a target name to work with.", "CPULoad2", MB_OK + MB_TOPMOST )
      Cls
      Goto ConsiderLeaving
    end if
  End If  
  Cls
 
  ' Begin output
  Locate 2, 0
  Print "     Press ESC to stop monitoring PID #";ProcessID
  If hProcess = 0 Then
    hProcess = OpenProcess( PROCESS_QUERY_LIMITED_INFORMATION, Inherit, Cast(Dword, ProcessId ) )
    If hProcess = 0 Then
      CenteredMessageBox( hConsole, "Open process failed.", "CPULoad2", MB_OK + MB_ICONQUESTION + MB_TOPMOST )
      Goto ConsiderLeaving
    End If
  End If
  Result = GetProcessTimes( hProcess, Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @Dummy), Cast(LPFILETIME, @KernelTime), Cast(LPFILETIME, @UserTime ) )
  If Result = 0 Then
    CenteredMessageBox( hConsole, "Get process times failed.", "CPULoad2", MB_OK + MB_ICONQUESTION + MB_TOPMOST )
    Goto ConsiderLeaving
  End If
  ' Set up timer.
  TimerID = timeSetEvent( poll, 1, Cast( LPTIMECALLBACK, @GetCPUload ), Cptr( Dword_Ptr, hProcess ), TIME_PERIODIC )
  
  Do
    Sleep 1
  Loop Until GetKey = 27
  
  ' If we pressed ESC then kill timer
  ' The timer is automatically killed when a process task exists during monitoring or we exceed the session time, if any
  If TimerID <> 0 Then timeKillEvent TimerID
  
ConsiderLeaving:
    
  Answer = CenteredMessageBox( hConsole, "Click 'New target' to monitor another process." + CrLf + CrLf _
  + "Click 'Exit' to exit CPULoad2." + CrLf + CrLf + "Note: You now have twenty seconds to copy the console," + CrLf + CrLf _
  + "otherwise press any key to really exit.", "CPULoad2", MB_RETRYCANCEL + MB_DEFBUTTON2 + MB_ICONQUESTION + MB_TOPMOST )
  
  ' There maybe a character in the keyboard buffer - get rid of it
  Do : Loop While Len(Inkey)
 
  If Answer = IDCANCEL Then
    If hProcess <> 0 Then CloseHandle hProcess
  Else
    ' Bring cursor back
    Info.dwSize = 1
    Info.bVisible = true
    SetConsoleCursorInfo( hOut, Cast( CONSOLE_CURSOR_INFO Ptr, @info ) )
    Cls
    FirstInstance = True
  End If
  
Loop Until Answer = IDCANCEL

Sleep 20000
Last edited by deltarho[1859] on Jul 26, 2023 4:26, edited 25 times in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

In the 'FreeBASIC's Timer' topic UEZ embedded some load indication code in one of dodicat's programs.

Here is a snapshot with CPULoad2 running at the same time.
Image

As you can see, the UEZ code and CPULoad2 are in agreement on the current CPU load; not exactly, but we are polling at different times, so that should be expected. Process Explorer was giving similar loads. Task Manager, on the other hand, was in the 13%/14% range.

This is further evidence that Task Manager is not a reliable source regarding process loads.

You may think that tmp2cdc.exe, in CPULoads's title, is a weird name. I loaded the code from FreeBASIC and used WinFBE's 'Quick Run'. That name was given by WinFBE.

Having two monitors is handy because I can have an application running on my primary monitor and CPULoad2 running on my secondary monitor.

Actually getting a secondary monitor, which I did many years ago, was one of the best additions to my system. I can have WinFBE running on my primary monitor and be on the internet with my secondary monitor, checking out a Windows API.

Added: Whilst UEZ's embedding is useful, it is required for any process we want to monitor, and some members may find that difficult. CPULoad2, on the other hand, does not require any additional coding to a process we wish to monitor. Of course, we cannot embed code if we don't have the source code of the process we wish to monitor. With CPULoad2, we also get a lot more statistics.
Last edited by deltarho[1859] on Jun 09, 2023 15:15, edited 1 time in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

If you want to 'theme' the messages, put Theme.rc in fbc's command line.

Theme.rc

Code: Select all

1 24 "Theme.xml"
If you use WinFBE add this to your code: '#Resource "Theme.rc"

Here is 'Theme.xml'

Code: Select all

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">

    <assemblyIdentity
        version="1.0.0.1"
        processorArchitecture="*"
        name="MyAppName.exe"
        type="win32"
    />
    <description>Optional MyDescription for MyAppName.exe</description>
    
    <asmv3:application>
        <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
        <dpiAware>true</dpiAware>
        </asmv3:windowsSettings>
    </asmv3:application>

    <!-- Compatibility section for Program Compatibility Assistant (PCA) -->
    <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
        <application>
            <!-- Windows Vista -->
            <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
            <!-- Windows 7 -->
            <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
            <!-- Windows 8 -->
            <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
            <!-- Windows 8.1 -->
            <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
            <!-- Windows 10 -->
            <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
        </application>
    </compatibility>

    <!-- Trustinfo section for User Account Control (UAC) -->
    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
        <security>
            <requestedPrivileges>
                <!-- level   = "asInvoker"            -->
                <!-- level   = "highestAvailable"     -->
                <!-- level   = "requireAdministrator" -->
                <requestedExecutionLevel
                    level    = "asInvoker"
                    uiAccess = "false"
                />
            </requestedPrivileges>
        </security>
    </trustInfo>

    <!-- Dependency section -->
    <dependency>
        <dependentAssembly>
            <assemblyIdentity
                type="win32"
                name="Microsoft.Windows.Common-Controls"
                version="6.0.0.0"
                processorArchitecture="*"
                publicKeyToken="6595b64144ccf1df"
                language="*"
            />
        </dependentAssembly>
    </dependency>

</assembly>
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

Not required now. The replacement code is now included above.
Last edited by deltarho[1859] on Jun 09, 2023 14:56, edited 1 time in total.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Very basic process CPU load determiner

Post by UEZ »

@deltarho[1859]: good work with CPULoad2, but using the process name to measure CPU load may not be the best choice, because if the process name occurs several times, as for example with almost all browsers that open several child processes under the same names, the first name found will be taken, although you may want to measure a different process. Therefore, it would be better to choose the PID input. PIDs are always unique.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

@UEZ

Good point.

Firefox currently has 14 instances of Firefox.

In such situations, I would recommend that Process Explorer be used. Few, including me, wouldn't know which PID to use anyway.

I am going to stay with process name as most targets will only have the one process name.

I could check after finding a process name whether another existed, advise the user if so, and then 'pull out'.

Thanks.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

The update code above has been updated.

If a process name has been found, a second instance check is made and if found, the user is advised and told: “I am not designed to handle multiple process names.”

I tried it with Firefox and Microsoft Edge.

A cop out? Not really – this topic is called: “Very basic process CPU load determiner” :)
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Very basic process CPU load determiner

Post by deltarho[1859] »

Oops. I stopped tasklist.txt being killed – I wanted to check something.

Corrected above.
Post Reply