From LedHed's Wiki
Jump to: navigation, search

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