VBscript to monitor system performance leaks memory - memory-leaks

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

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?

Answer 3

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 4

I have run into the exact same issue, using it for a procmon-style attempt to capture a rogue process that appears to be respawning.
Narrowing it all down, it appears to be the objRefresher.Refresh and there simply appears to be no way around it
What I did to overcome this was use a for...next to run it 100 times, then immediately afterwards run the following, which would simply respawn the script and shutdown:
CreateObject("Wscript.Shell").Run """" & WScript.ScriptFullName & """", 0, False
So I would watch the memory crawl from 5Mb to 40Mb, then drop back down to 5Mb