From LedHed's Wiki
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.
Contents
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