Windowsのメモリ負荷テストツールをVBSで自作する

10月 6, 2018

Windowsサーバでメモリ負荷テストをするとき使ってるVBSのツール。

元のソースが見つからず、ちょこちょこいじってるのでひとまず公開。

メモリ負荷ツールの使い方

ソースをコピーしてローカルに保存する。（mem_panic.vbsなど）
ダブルクリックで実行してメモリに負荷をかける。
intMemEatの値を適宜変更する。
ポップアップメッセージを閉じるとメモリ負荷を開放する。

Option Explicit

'参照カウンタを使用して循環参照させる
Dim intLoopCnt 'ループカウンタ
Dim intMemEat 'メモリを食う容量

intMemEat = 5000

'5000:空きメモリが50MB減る
'10000:空きメモリが100MB減る
'20000:空きメモリが200MB減る
'100000:空きメモリが1.5GBぐらい減る ←えっ

For intLoopCnt = 1 To intMemEat
    Call subMain()
Next

MsgBox "メモリ負荷完了。タスクマネージャーで確認ください。" _
& vbCrlf & "このメッセージボックスを閉じるとメモリは開放されます。", vbInformation, "メモリ負荷ツール"

Sub subMain()
    Dim x
    Dim y

    Set x = CreateObject("Scripting.Dictionary") '連想配列オブジェクト(X)
    Set y = CreateObject("Scripting.Dictionary") '連想配列オブジェクト(Y)

    Call x.Add("a", y) '配列に書き込みメモリを食う
    Call y.Add("b", x) '配列に書き込みメモリを食う

End Sub

Option Explicit

'参照カウンタを使用して循環参照させる

Dim intLoopCnt 'ループカウンタ

Dim intMemEat 'メモリを食う容量

intMemEat = 5000

'5000:空きメモリが50MB減る

'10000:空きメモリが100MB減る

'20000:空きメモリが200MB減る

'100000:空きメモリが1.5GBぐらい減る ←えっ

For intLoopCnt = 1 To intMemEat

Call subMain()

MsgBox "メモリ負荷完了。タスクマネージャーで確認ください。" _

& vbCrlf & "このメッセージボックスを閉じるとメモリは開放されます。", vbInformation, "メモリ負荷ツール"

Sub subMain()

Dim x

Dim y

Set x = CreateObject("Scripting.Dictionary") '連想配列オブジェクト(X)

Set y = CreateObject("Scripting.Dictionary") '連想配列オブジェクト(Y)

Call x.Add("a", y) '配列に書き込みメモリを食う

Call y.Add("b", x) '配列に書き込みメモリを食う

End Sub

メモリ負荷ツール解説

面倒なのでソースに書いちゃいました。

ソースが汚くなるから解説入れたくないけど、どの現場行っても「あ、これなんだっけか」みたいになるから。

そう難しいことでもないので、ひとまずこのまま公開する。

著作権について

商用利用以外であれば著作権フリーです。

過去、どこかの現場で必要になり家で作りました。
（なんせ現場で作らせてもらえませんでしたからね）

無料公開している理由

今でもよく現場で使うことがあって、一元管理したいのでここに残します。

あとあと直すかもと思いコメント入れまくったけど全然直さないし。

バグってたら教えてください。

ソースは汚くて恥ずかしいけど、僕プログラマーじゃないし（言い訳）