VB.NET: Idle Time external Application

Question

I saw a lot of posts about calculating idle time within a program, but what I am trying to do is calculate the idle time of a separate Windows program. Long story short, we have 12 licenses for very expensive accounting software. We have about 20 employees, but not everyone uses the software. From time to time, we will have all 12 licenses being used -- and there is a hierarchy in the firm as to who should be able to access the software based upon need.

I am being tasked to write a program that will let us "kick off" users. I wrote a simple program that will run in the background and check if the software is loaded. Another program simply sends a command through a shared network drive to tell the program to close if necessary.

It works. What I'm being asked to do now is to include the idle time of the software. Is there any way for me to monitor an external application for keystrokes or mouse clicks? I think I can basically report the last time the application was used and derive the idle time from subtracting it from the current time. However, I'm struggling with how to figure out if any keys were sent to the specific application? Logically I'm thinking this is like a keylogger (without the logging), but only if the specific application is in focus.

Does anyone have any ideas I can explore? I'm willing to do the research, but just wondering if anyone knows of any API or other tricks to use.

Check this, it will help you. https://code.msdn.microsoft.com/windowsdesktop/Monitorare-il-tempo-di-bba0178c — Juanche, Apr 27 '17 at 20:36

score 1 · Accepted Answer · answered Apr 27 '17 at 19:45

1

You can combine GetForgroundWindow and GetLastInputInfo (Win32 functions) in a reasonable loop.
If the target application (target) is running, and the target is not the foreground window then we can assume that the application is idle. Just record the time it transitioned from foreground to background.

If the target is the foreground window then you can use GetLastInputInfo to determine the last time the application received mouse or keyboard input.

** Unfortunately MSDN is down right now so I can't link to the documentation.

answered Apr 27 '17 at 19:45

Sam Axe

33,313
9
55
89

Thanks so much @Sam Axe! This idea worked perfectly, yet never occurred to me! THANK YOU! – Alex S. May 02 '17 at 17:47
@AlexS. I'm very happy that worked for you. You might consider posting the appropriate code here as an answer to help out others that have the same question. – Sam Axe May 02 '17 at 20:36

score 0 · Answer 2 · answered May 04 '17 at 20:30

So I have settings stored with a location for user logs. If I find that the user has an application open (Axys), then I create a file with their windows username (a .usr file). In that file, I save the last time the application was active.

    Dim strFileName As String = My.Settings.UserLogs & "\" & strWinUser & ".usr"
    Dim strTime As String = String.Empty
    lastInputInf.cbSize = Marshal.SizeOf(lastInputInf)
    lastInputInf.dwTime = 0
    GetLastInputInfo(lastInputInf)

        Dim Caption As New System.Text.StringBuilder(256)
        GetWindowText(GetForegroundWindow, Caption, Caption.Capacity)

        If Caption.ToString.Contains("Axys")  Then
            If (CInt((Environment.TickCount - lastInputInf.dwTime) / 1000)) > 0 Then
                Dim timeDbl As Double = CDbl((Environment.TickCount - lastInputInf.dwTime) / 1000)
                strTime = DateTime.Now.AddSeconds(-1 * timeDbl).ToString
            Else
                strTime = DateTime.Now.ToString
            End If

            Dim objWriter As New System.IO.StreamWriter(strFileName)
            objWriter.Write(strTime)
            objWriter.Close()

        Else
        End If

score -1 · Answer 3 · answered Apr 28 '17 at 05:53

Not sure if this could help but maybe there's good info via Microsoft's UPTIME.exe. Its a tool to track the uptime, boots, blue screens, etc.

Here's a vbscript that could have some clues to get this info for VB.NET

I am not the author found here: https://community.spiceworks.com/scripts/show/57-uptime-vbs

' ========================================================
' Script:           UpTime.vbs
' Description:      Create spreadsheet of uptime stats for all servers
' Note:         Change the variables below as required.
'               This program requires a copy of Microsoft's UPTIME.EXE tool available from http://support.microsoft.com/kb/232243
' Author:           Alan Kobb
'               Herley-CTI
' Originally created:   8/26/09
'  Copyright 2009, Herley-CTI.  ALL RIGHTS RESERVED.
' ========================================================

Set objShell = CreateObject("WScript.Shell")
Set dServers = CreateObject("Scripting.Dictionary")
Dim objExcel, objWorkbook, nPos, strXLFile, objWorksheet, sUpTime

' **********************************************************************************************************
' Variables to set values for

' Add an array element with the name of each server you want to track.  Set the DIM to the number of servers.
Dim aServers(2)
aServers(0) = "Server1"
aServers(1) = "Server2"

' The path and name of the Excel file created.
strXLFile = "C:\UpTimes.xls"

' How many days to track for each server.
nDays = "365"

' Path and filename of Uptime.exe (Required.  Download from Microsoft at http://support.microsoft.com/kb/232243)
sUpTime = "C:\tools\uptime.exe"

' **********************************************************************************************************

'REGION Open Excel File
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)
'ENDREGION
objWorksheet.Cells(2,1) = "Server"
objWorksheet.cells(1,2) = "% Time"
objWorksheet.cells(2,2) = "Avail"
objWorksheet.Cells(1,3) = "#"
objWorksheet.Cells(2,3) = "Reboot"
objWorksheet.Cells(1,4) = "Current"
objWorksheet.Cells(2,4) = "Uptime"
objWorksheet.Cells(3,4) = "(days)"
objWorksheet.Cells(2,5) = "MTBR"
objWorksheet.Cells(3,5) = "(days)"
objWorksheet.Cells(1,6) = "#"
objWorksheet.Cells(2,6) = "Bluescreens"
objWorksheet.Cells(1,7) = "Abnormal"
objWorksheet.Cells(2,7) = "Shutdowns"
objWorksheet.Cells(2,8) = "Reboots"
objWorksheet.Cells(2,9) = "Shutdowns"
objWorksheet.Cells(2,10) = "Notes"
nRow = 5

For i = 0 To UBound(aServers)
    If Len(aServers(i)) > 1 Then
        strServer = "\\" & aServers(i)

        strCmd = sUpTime & " /p:" & nDays & " " & strserver
        WScript.Echo strCmd

        Set objExec = objShell.Exec(strCmd)

        Do While objExec.Status = 0
            WScript.Sleep 2000
        Loop

        nAvailablePercent = 0
        nTotalReboots = 0
        nCurrentDays = 0
        nMTBR = 0
        bTooLittleData = False
        bInconsistant = False
        nBlues = 0
        nAbnormals = 0
        nBoots = 0
        nShuts = 0

        Do While Not(objExec.StdOut.AtEndOfStream)
            strLine = objExec.StdOut.ReadLine
            'WScript.Echo strLine
            If InStr(strLine,"Availability") >= 1 Then nAvailablePercent = field(strLine,":",2)
            If InStr(strLine,"Total Reboots") >= 1 Then nTotalReboots = field(strLine,":",2)
            If InStr(strLine,"Current System") >= 1 Then nCurrentDays = field(field(field(strLine,":",2),",",1),"d",1)
            If InStr(strLine,"Mean") >= 1 Then nMTBR = field(field(strLine,":",2),"d",1)
            If InStr(strLine,"earliest") >= 1 Then bTooLittleData = True
            If InStr(strLine,"Bluescreen ") >= 1 Then nBlues = nBlues + 1
            If InStr(strLine,"Abnormal") >= 1 Then nAbnormals = nAbnormals + 1
            If InStr(strLine,"Boot") >= 1 Then nBoots = nBoots + 1
            If InStr(strLine,"  Shutdown") >= 1 Then nShuts = nShuts + 1
        Loop

        objWorksheet.Cells(nRow,1) = Mid(strServer,3)
        objWorksheet.cells(nRow,2) = nAvailablePercent
        objWorksheet.Cells(nRow,3) = nTotalReboots
        objWorksheet.Cells(nRow,4) = nCurrentDays
        objWorksheet.Cells(nRow,5) = nMTBR
        objWorksheet.Cells(nRow,6) = nBlues
        objWorksheet.Cells(nRow,7) = nAbnormals
        objWorksheet.Cells(nRow,8) = nTotalReboots
        objWorksheet.Cells(nRow,9) = nShuts
        If bTooLittleData Then objWorksheet.Cells(nRow,10) = "Insufficient Data"
        nRow = nRow + 1
    End If
Next

' Save
objExcel.Visible = True
'objExcel.ActiveWorkbook.SaveAs strXLFile

Function Field(Str,Delim,Pos)
Dim aString
aString = Split(Str,Delim)
Field = aString(Pos-1)
End Function

I also wonder if querying the Windows Management Instrumentation could be of some help.

I hope something here can help. Good luck.

VB.NET: Idle Time external Application

3 Answers3