Ledhed: Created page with 'As an admin from time to time you have a need to log application time. For example you are asked by HR to monitor how many hours an employee spends playing games. Here is a VBScr...'

2012-01-20T00:02:25Z

Created page with 'As an admin from time to time you have a need to log application time. For example you are asked by HR to monitor how many hours an employee spends playing games. Here is a VBScr...'

New page

As an admin from time to time you have a need to log application time.
For example you are asked by HR to monitor how many hours an employee spends playing games.
Here is a VBScript that will accomplish just that.

== The Script ==

On Error Resume Next

'******************************************************************************
'Change block - change values to fit local environment.
strCompList = "complist.txt"
strProcList = "proclist.txt"
g_strOutputFile = "applog.txt"
Const MON_TIME = 3600 'seconds script should run
Const MAX_TIME = 3600 'seconds - time limit on processes
'******************************************************************************

Dim g_arrTimeCounters() 'time counters for each app
Dim g_arrFreqCounters() 'frequency of usage counters for each app
Dim g_arrOverCounters() 'over-limit usage counters for each app
arrComputers = ReadTextFile(strCompList)
g_arrTargetProcs = ReadTextFile(strProcList)

'Redim counter arrays to same size as target process array
intUBound = UBound(g_arrTargetProcs)
Redim g_arrTimeCounters(intUBound)
Redim g_arrFreqCounters(intUBound)
Redim g_arrOverCounters(intUBound)

'Initialize all counters to 0.
For Each intTimeCounter In g_arrTimeCounters
intTimeCounter = 0
Next
For Each intFreqCounter In g_arrFreqCounters
intFreqCounter = 0
Next
For Each intOverCounter In g_arrOverCounters
intOverCounter = 0
Next

strMessageHeader = vbCrLf & "Target processes:" & vbCrLf
For Each strTargetProc In g_arrTargetProcs
strMessageHeader = strMessageHeader & strTargetProc & vbCrLf
Next
strMessageHeader = strMessageHeader & vbCrLf & "Querying machines on list:"
WScript.Echo strMessageHeader
WriteTextFile g_strOutputFile, strMessageHeader

Set SINK = WScript.CreateObject("WbemScripting.SWbemSink","SINK_")

For Each strComputer In arrComputers
strMessageHost = vbCrLf & "Host: " & strComputer
WScript.Echo strMessageHost
WriteTextFile g_strOutputFile, strMessageHost

Set g_objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
If Err = 0 Then
QueryProcess strComputer
Else
HandleError strComputer, "Unable to bind to WMI on host."
End If
Next

strMessageMon = vbCrLf & "Monitoring start time: " & Now & vbCrLf & _
"In monitoring mode for " & SecsToHours(MON_TIME) & vbCrLf & _
" ... Ctrl+C to end" & vbCrLf & _
"----------------------------------------------------"
WScript.Echo strMessageMon
WriteTextFile g_strOutputFile, strMessageMon

WScript.Sleep MON_TIME * 1000

strMessageSum = _
vbCrLf & "-------------------------------------------------- " & _
vbCrLf & "Monitoring finish time: " & Now & vbCrLf & _
vbCrLf & "Application usage:"
For i = 0 To UBound(g_arrTargetProcs)
strMessageSum = strMessageSum & vbCrLf & vbCrLf & "Application: " & _
g_arrTargetProcs(i) & vbCrLf & _
" Total Duration: " & SecsToHours(CInt(g_arrTimeCounters(i))) & vbCrLf & _
" Number of Uses: " & CInt(g_arrFreqCounters(i)) & vbCrLf & _
" Number of Uses over Time Limit: " & CInt(g_arrOverCounters(i))
Next
WScript.Echo strMessageSum
WriteTextFile g_strOutputFile, strMessageSum

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

Sub QueryProcess(strHost)

On Error Resume Next

Set objContext = CreateObject("WbemScripting.SWbemNamedValueSet")
objContext.Add "hostname", strHost

'Query host asynchronously for process creation events.
For Each strTargetProc In g_arrTargetProcs
strQuery = "SELECT * FROM __InstanceDeletionEvent WITHIN 10 " & _
"WHERE TargetInstance ISA 'Win32_Process' " & _
"AND TargetInstance.Name = '" & strTargetProc & "'"
g_objWMIService.ExecNotificationQueryAsync SINK, _
strQuery, , , , objContext
Next
If Err = 0 Then
strMessageTNP = vbCrLf & " Monitoring target processes."
WScript.Echo strMessageTNP
WriteTextFile g_strOutputFile, strMessageTNP
Else
HandleError strHost, " Unable to run asynchronous query."
End If

End Sub

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

Sub SINK_OnObjectReady(objLatestEvent, objAsyncContext)
'Trap asynchronous events.

Set objAsyncContextItem = objAsyncContext.Item("hostname")
strHost = objAsyncContextItem.Value
strProcName = objLatestEvent.TargetInstance.Name
strProcID = objLatestEvent.TargetInstance.ProcessId

Set objDateTime1 = CreateObject("WbemScripting.SWbemDateTime")
objDateTime1.Value = objLatestEvent.TargetInstance.CreationDate
vtmCreated = objDateTime1.GetVarDate

Set objDateTime2 = CreateObject("WbemScripting.SWbemDateTime")
objDateTime2.SetFileTime objLatestEvent.TIME_CREATED, False
vtmDeleted = objDateTime2.GetVarDate

intDuration = DateDiff("s", vtmCreated, vtmDeleted)

If intDuration > MAX_TIME Then
strTimeLimit = " Over time limit"
Else
strTimeLimit = " Not over time limit"
End If

strSinkData = VbCrLf & "Computer Name: " & strHost & vbCrLf & _
"Process Name: " & strProcName & VbCrLf & _
"Process ID: " & strProcID & VbCrLf & _
" Time created: " & vtmCreated & VbCrLf & _
" Time deleted: " & vtmDeleted & VbCrLf & _
" Duration: " & SecsToHours(intDuration) & VbCrLf & _
strTimeLimit
WScript.Echo strSinkData
WriteTextFile g_strOutputFile, strSinkData

'Increment time and frequency counters for app.
intCount = 0
For intCount = 0 to UBound(g_arrTargetProcs)
If g_arrTargetProcs(intCount) = objLatestEvent.TargetInstance.Name Then
g_arrTimeCounters(intCount) = g_arrTimeCounters(intCount) + intDuration
g_arrFreqCounters(intCount) = g_arrFreqCounters(intCount) + 1
If intDuration > MAX_TIME Then
g_arrOverCounters(intCount) = g_arrOverCounters(intCount) + 1
End If
End If
Next

End Sub

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

Function ReadTextFile(strFileName)
'Read lines of text file and return array with one element for each line.

On Error Resume Next

Const FOR_READING = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFilename) Then
Set objTextStream = objFSO.OpenTextFile(strFilename, FOR_READING)
Else
strRTFMessage1 = VbCrLf & "Input text file " & strFilename & " not found."
Wscript.Echo strRTFMessage1
WriteTextFile g_strOutputFile, strRTFMessage1
WScript.Quit(1)
End If

If objTextStream.AtEndOfStream Then
strRTFMessage2 = VbCrLf & "Input text file " & strFilename & " is empty."
Wscript.Echo strRTFMessage2
WriteTextFile g_strOutputFile, strRTFMessage2
WScript.Quit(2)
End If

strFileContents = objTextStream.ReadAll
arrLines = Split(strFileContents, vbCrLf)

objTextStream.Close

ReadTextFile = arrLines

End Function

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

'Write or append data to text file.
Sub WriteTextFile(strFileName, strOutput)

On Error Resume Next

Const FOR_APPENDING = 8

'Open text file for output.
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFileName) Then
Set objTextStream = objFSO.OpenTextFile(strFileName, FOR_APPENDING)
Else
Set objTextStream = objFSO.CreateTextFile(strFileName)
End If

'Write data to file.
objTextStream.WriteLine strOutput

objTextStream.Close

End Sub

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

Function SecsToHours(intTotalSecs)
'Convert time in seconds to hours, minutes, seconds and return in string.

intHours = intTotalSecs \ 3600
intMinutes = (intTotalSecs Mod 3600) \ 60
intSeconds = intTotalSecs Mod 60

SecsToHours = intHours & " hours, " & intMinutes & " minutes, " & _
intSeconds & " seconds"

End Function

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

Sub HandleError(strHost, strMsg)
'Handle errors.

strError = VbCrLf & " ERROR on " & strHost & VbCrLf & _
" Number: " & Err.Number & VbCrLf & _
" Description: " & Err.Description & VbCrLf & _
" Source: " & Err.Source & VbCrLf & _
" Explanation: " & strMsg
WScript.Echo strError
WriteTextFile g_strOutputFile, strError
Err.Clear

End Sub

== Supporting Files ==

=== proclist.txt ===
proclist.txt contains a list of processes you'd like to monitor usage.
One process per line.
'''Example:'''
sol.exe
winmine.exe
iexplore.exe

=== complist.txt ===
complist.txt contains a list of computer names you'd like to monitor appliactions on.
One computer per line.
'''Example:'''
comp-1
comp-2
file-srvr

=== applog.txt ===
This file contains the logging information gathered by the script.

== Configuration ==
You can configure settings within the script to achieve the desired behavior:

MON_TIME = 60 'seconds script should run
MAX_TIME = 10 'seconds - time limit on processes

== Reference ==
http://technet.microsoft.com/en-us/library/ee692850.aspx#EDAA

[[Category:Windows]]

Logging Application Usage - Revision history

Ledhed: Created page with 'As an admin from time to time you have a need to log application time. For example you are asked by HR to monitor how many hours an employee spends playing games. Here is a VBScr...'