VBscript to monitor system performance leaks memory

Question

I have a simple script that monitors processes' different performance statistics in Windows XP in a loop until it is terminated.
Despite my efforts, the script's memory footprint increases in size over time.
Any advice is greatly appreciated.

    Set fso = CreateObject("Scripting.FileSystemObject")
logFileDirectory = "C:\POSrewrite\data\logs"
Dim output
Dim filePath

filePath = "\SCOPerformance-" & Day(Now()) & Month(Now()) & Year(Now()) & ".log"

IF fso.FolderExists(logFileDirectory) THEN

ELSE
    Set objFolder = fso.CreateFolder(logFileDirectory)
END IF

logFilePath = logFileDirectory + filePath + ""

IF (fso.FileExists(logFilePath)) THEN
    set logFile = fso.OpenTextFile(logFilePath, 8, True)
    output = VBNewLine
    output = output & (FormatDateTime(Now()) + " Open log file." & VBNewLine)

ELSE
    set logFile = fso.CreateTextFile(logFilePath)
    output = output & (FormatDateTime(Now()) + " Create log file." & VBNewLine)
END IF

output = output & (FormatDateTime(Now()) + " Begin Performance Log data." & VBNewLine)
output = output & ( "(Process) (Percent Processor Time) (Working Set(bytes)) (Page Faults Per Second) (PrivateBytes) (PageFileBytes)" & VBNewLine)

WHILE (True)
    On Error Resume NEXT
    IF Err = 0 THEN 

        strComputer = "."
        Set objRefresher = CreateObject("WbemScripting.SWbemRefresher")
        Set objServicesCimv2 = GetObject("winmgmts:\\" _
            & strComputer & "\root\cimv2")
        Set objRefreshableItem = _
            objRefresher.AddEnum(objServicesCimv2 , _
            "Win32_PerfFormattedData_PerfProc_Process")
        objRefresher.Refresh
        ' Loop through the processes three times to locate  
        '    and display all the process currently using 
        '    more than 1 % of the process time. Refresh on each pass.

        FOR i = 1 TO 3

            objRefresher.Refresh 
            FOR Each Process in objRefreshableItem.ObjectSet
                IF Process.PercentProcessorTime > 1 THEN
                    output = output & (FormatDateTime(Now()) & "," &  i ) & _
                        ("," & Process.Name & _
                        +","  & Process.PercentProcessorTime & "%") & _
                        ("," & Process.WorkingSet) & ("," & Process.PageFaultsPerSec) & _
                        "," & Process.PrivateBytes & "," & Process.PageFileBytes & VBNewLine
                END IF
            NEXT
        NEXT
    ELSE
            logFile.WriteLine(FormatDateTime(Now()) + Err.Description)
    END IF
    logFile.Write(output)
    output = Empty
    set objRefresher = Nothing
    set objServicesCimv2 = Nothing
    set objRefreshableItem = Nothing
    set objFolder = Nothing
    WScript.Sleep(10000)
Wend

Answer 1

I think the main problem with your script is that you initialize WMI objects inside the loop, that is, on every iteration of the loop, even though these objects are always the same:

strComputer = "."
Set objRefresher = CreateObject("WbemScripting.SWbemRefresher")
Set objServicesCimv2 = GetObject("winmgmts:\\" _
    & strComputer & "\root\cimv2")
Set objRefreshableItem = _
    objRefresher.AddEnum(objServicesCimv2 , _
    "Win32_PerfFormattedData_PerfProc_Process")

You need to move this code out of the loop, e.g., at the beginning of the script.

Other tips and suggestions:

• Use Option Explicit and explicitly declare all variables used in your script. Declared variables are slightly faster than undeclared ones.

• Use FileSystemObject.BuildPath to combine multiple parts of the path. The useful thing about this method is that it inserts the necessary path separators for you.

  logFileDirectory = "C:\POSrewrite\data\logs"
  filePath = "SCOPerformance-" & Day(Now) & Month(Now) & Year(Now) & ".log"
  logFilePath = fso.BuildPath(logFileDirectory, filePath)
  

• The objFolder variable isn't used in your script, so there's no need to create it. Also, you can make the FolderExists check more readable by rewriting it as follows:

  If Not fso.FolderExists(logFileDirectory) Then
      fso.CreateFolder logFileDirectory
  End If
  

• Move repeated code into subroutines and functions for easier maintenance:

  Function DateTime
      DateTime = FormatDateTime(Now)
  End Function
  ...
  output = output & DateTime & " Open log file." & vbNewLine
  

• Usually you don't need parentheses when concatenating strings:

  output = output & DateTime & "," & i & _
      "," & Process.Name & _
      "," & Process.PercentProcessorTime & "%" & _
      "," & Process.WorkingSet   & "," & Process.PageFaultsPerSec & _
      "," & Process.PrivateBytes & "," & Process.PageFileBytes & vbNewLine
  

Answer 2

I would recommend against running the script in a permanent loop within the script unless you actually need such a tight loop. I would suggest a single iteration within in the script, called from Scheduled tasks.

Answer 3

In this article, Eric Lippert (Literally worked on designing and building VBScript at Microsoft) indicates that the order in which you dispose of things may be important. Maybe you are running into one of these bugs?

I'll let you read the rest...

When Are You Required To Set Objects To Nothing?