VBscript to monitor system memory leak

I have a simple script that monitors various performance statistics in Windows XP in a loop until it completes.
Despite my efforts, the amount of script memory increases over time.
Any advice is 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
+3
source share
4 answers

I think the main problem with your script is that you initialize the WMI objects inside the loop, i.e. at each iteration of the loop, although 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 from the loop, for example, at the beginning of the script.


Other tips and suggestions:

  • Option Explicit , script. , .

  • FileSystemObject.BuildPath, . , .

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

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

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

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

( VBScript Microsoft) , , , . , ?

...

?

+3

script script, . script, .

0

, procmon- , , , .

, objRefresher.Refresh, .

, , ..., 100 , , script :

CreateObject("Wscript.Shell").Run """" & WScript.ScriptFullName & """", 0, False

So, I would look like a memory scan from 5Mb to 40Mb, and then drop to 5Mb

0
source

Source: https://habr.com/ru/post/1759364/


All Articles