リソースモニターの内容をファイルに保存する(VBS)

メモリの使用量を長期にわたって保存する必要がでてきた。
リソースモニターを開いたときの各プロセスのメモリの値をファイル保存する。

スクリプトをタスク スケジューラに登録して定期的に実行するようにした。

ResourceLog.vbs

'各プロセスのメモリ使用率をCSVで保存する
'ファイル名は"PerfLog_yyyyMMdd_HHmmss.csv""
Const savePath = "D:\"

Dim oClassSet
Dim oClass
Dim oLocator
Dim oService
Dim sMesStr

Dim oRange()
Dim oRangeA()
Dim oRangeB()
Dim i
Dim j
Dim iRow
Dim cpuPercent

Set oLocator = CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer

iRow = 0


'1回目の計測
Set oClassSet = oService.ExecQuery("SELECT * FROM Win32_PerfRawData_PerfProc_Process")

ReDim oRangeA(oClassSet.Count - 1, 10)

i = 0
For Each oClass In oClassSet

    oRangeA(i, 0) = oClass.Name
    oRangeA(i, 1) = oClass.IDProcess
    oRangeA(i, 2) = oClass.PageFaultsPersec
    oRangeA(i, 3) = oClass.PrivateBytes / 1024
    oRangeA(i, 4) = oClass.WorkingSet / 1024
    oRangeA(i, 5) = (oClass.WorkingSet - oClass.WorkingSetPrivate) / 1024
    oRangeA(i, 6) = oClass.WorkingSetPrivate / 1024
    oRangeA(i, 7) = oClass.PercentPrivilegedTime
    oRangeA(i, 8) = oClass.PercentUserTime
    oRangeA(i, 9) = oClass.Timestamp_Sys100NS
    
    i = i + 1
Next

Set oClass = Nothing
Set oClassSet = Nothing


'1秒の待ち
WScript.Sleep 1000


'2回目の計測
Set oClassSet = oService.ExecQuery("SELECT * FROM Win32_PerfRawData_PerfProc_Process")

ReDim oRangeB(oClassSet.Count - 1, 10)

i = 0
For Each oClass In oClassSet

    oRangeB(i, 0) = oClass.Name
    oRangeB(i, 1) = oClass.IDProcess
    oRangeB(i, 2) = oClass.PageFaultsPersec
    oRangeB(i, 3) = oClass.PrivateBytes / 1024
    oRangeB(i, 4) = oClass.WorkingSet / 1024
    oRangeB(i, 5) = (oClass.WorkingSet - oClass.WorkingSetPrivate) / 1024
    oRangeB(i, 6) = oClass.WorkingSetPrivate / 1024
    oRangeB(i, 7) = oClass.PercentPrivilegedTime
    oRangeB(i, 8) = oClass.PercentUserTime
    oRangeB(i, 9) = oClass.Timestamp_Sys100NS
    
    i = i + 1
Next

Set oClass = Nothing
Set oClassSet = Nothing


Set oService = Nothing
Set oLocator = Nothing


On Error Resume Next

ReDim oRange(1 + UBound(oRangeB), 10)

oRange(0, 0) = "名称"
oRange(0, 1) = "プロセスID"
oRange(0, 2) = "コミット(KB)"
oRange(0, 3) = "ワーキングセット(KB)"
oRange(0, 4) = "共有可能(KB)"
oRange(0, 5) = "プライベート(KB)"
oRange(0, 6) = "CPU使用率(%)"

For i = 0 To UBound(oRangeB)

    cpuPercent = 0
    For j = 0 To UBound(oRangeA)
        If oRangeB(i, 0) = oRangeA(j, 0) And oRangeB(i, 1) = oRangeA(j, 1) Then
        
            cpuPercent = ((CDbl(oRangeB(i, 7)) + CDbl(oRangeB(i, 8))) - (CDbl(oRangeA(j, 7)) + CDbl(oRangeA(j, 8)))) / (CDbl(oRangeB(i, 9)) - CDbl(oRangeA(j, 9)))
            
            Exit For
        End If
    Next
    
    oRange(1 + i, 0) = oRangeB(i, 0)
    oRange(1 + i, 1) = oRangeB(i, 1)
    oRange(1 + i, 2) = oRangeB(i, 3)
    oRange(1 + i, 3) = oRangeB(i, 4)
    oRange(1 + i, 4) = oRangeB(i, 5)
    oRange(1 + i, 5) = oRangeB(i, 6)
    oRange(1 + i, 6) = FormatNumber(cpuPercent, 2, -1, 0, 0)
Next


Dim oFs
Dim oText
Dim sPath
Dim sText()

ReDim sText(UBound(oRange, 2))

sPath = savePath & "\PerfLog_" & FormatDay() & ".csv"

Set oFs = CreateObject("Scripting.FileSystemObject")
Set oText = oFs.CreateTextFile(sPath, True)

For i = 0 To UBound(oRange)
    For j = 0 To UBound(sText)
        sText(j) = oRange(i, j)
    Next
    oText.Write Join(sText, ",") & vbCrLf
Next

oText.Close

Set oText = Nothing
Set oFs = Nothing

Function FormatDay()

    Dim sDate, dtNow

    dtNow = Now
    sDate = FormatDateTime(dtNow, vbShortDate) & " " & Right("0" & FormatDateTime(dtNow, vbLongTime), 8)
    FormatDay = Replace(Replace(Replace(sDate, "/", ""), ":", ""), " ", "_")

End Function