USBHDDを監視してスピンダウンするスクリプト

spindownhdd.vbs

' USBHDDを監視してスピンダウンするスクリプト
'
' 一定間隔で Win32_PerfRawData_PerfDisk_PhysicalDisk->DiskBytesPerSec
' を監視して、変化がなければHDDの回転を停止する。
'
' Win32_PerfRawData_PerfDisk_PhysicalDisk->DiskBytesPerSec は実は累計、
' 秒ごとの値ではないので linux の /proc/diskstats みたいに使える。
'
' ※イベントログに「ソース: hddspindown」で出力したいので、本スクリプト実行前に
'   "管理者権限で" 下記コマンドを1回実行しておくこと。
'  「eventcreate /T INFORMATION /ID 1 /L APPLICATION /SO hddspindown /D test」
'   1回実行するとレジストリに「ソース: hddspindown」が登録され、以降は一般ユーザー
'   権限でも「ソース: hddspindown」でイベント書き込みできるようになる。


Const DEBUG_MODE = False


' 監視対象のドライブレター
strDriveLetter = "I:"

'監視間隔 (ミリ秒)
interval =  60000

'アクセスなしからspindownするまでの時間(ミリ秒) 10min -> 600000
time_dulation = 600000


' sdparm command for windows
' http://sg.danny.cz/sg/sdparm.html
' 
' cmd_cmd_SDPARM = d:\downloads\sdparm_64.exe
' sdparm.exe/sdparm_64.exe がこのスクリプトと同じフォルダにあると想定。
cmd_SDPARM = getScriptDir() & "\sdparm" & makesuffix6432() & ".exe"


Const vbHide = 0             'ウィンドウを非表示
Const vbVisible = 1          'ウィンドウを表示
set objWShell = CreateObject("WScript.Shell")

str_message = "開始: spindownhdd.vbs" & vbNewLine & _
      "監視対象: " &  strDriveLetter & vbNewLine & _
      "HDD停止までの時間(ミリ秒): " & time_dulation & vbNewLine & _
      "監視間隔(ミリ秒): " & interval & vbNewLine & _
      ""
logevent(str_message)

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
set objRefresher = CreateObject("WbemScripting.SWbemRefresher")

Set colDisks = objRefresher.AddEnum _
    (objWMIService, "Win32_PerfRawData_PerfDisk_PhysicalDisk"). _
        objectSet

isSpindown = False
time_remain = time_dulation

while(true)
  objRefresher.Refresh
  For Each objDisk in colDisks
    if InStr(objDisk.Name, strDriveLetter) <> 0 then
      if DEBUG_MODE = True then
        Wscript.Echo "Name: " & vbTab &  objDisk.Name
        Wscript.Echo "Disk Bytes Per Second: " & vbTab &  objDisk.DiskBytesPerSec
        Wscript.Echo "time_remain: " & time_remain
      end if
 
      '前回監視時からアクセスがあったか確認
      if last_DiskBytesPerSec = objDisk.DiskBytesPerSec then
        time_remain = time_remain - interval

        'アクセスなしが 一定期間続いたら spindown
        if time_remain <= 0 then
          ' 桁あふれ防止のため、0 にリセット
          time_remain = 0
          if isSpinDown = False then
            logevent("HDD stop: " & strDriveLetter)
            doSpindownCommand(strDriveLetter)
            isSpinDown = True
          end if
        end if
      else
        'アクセスありの場合 残り時間リセット
        time_remain = time_dulation

        'アクセスあり & 前回監視時 stop の場合 イベントログに通知
        if (isSpinDown = True) then
          isSpinDown = False
          logevent("HDD busy: " & strDriveLetter)
        end if
      end if
      last_DiskBytesPerSec = objDisk.DiskBytesPerSec
    end if
  Next
  Wscript.Sleep interval
wend


function doSpindownCommand(strDriveLetter)
  if DEBUG_MODE = True then
    Wscript.Echo "do spindown"
  end if

  cmd1 = cmd_SDPARM & " --quiet --command=sync " & strDriveLetter
  cmd2 = cmd_SDPARM & " --quiet --readonly --command=stop " & strDriveLetter

  objWShell.Run cmd1, vbHide, False
  objWShell.Run cmd2, vbHide, False

end function


function logevent(strMessage)
  ' ※注意: イベントログに「ソース: hddspindown」で出力するためには、
  ' "事前に" "管理者権限で" 下記コマンドを一回実行しておく必要がある
  ' 「eventcreate /T INFORMATION /ID 1 /L APPLICATION /SO hddspindown /D test」
  logevent  = logevent_(strMessage, "INFORMATION", "APPLICATION", "spindownhdd", "1")
end function

function logevent_(strMessage, strType, strLog, strEventsource, strId)
  'eventcreate.exe のメッセージ内で改行するにはLFに置き換える。
  strMessage_lf = replace(replace(strMessage, vbNewLine, vbLf), """", "\""")

  cmd1 = "eventcreate /T " & strType & " /ID " & strId & " /L " & strLog & " /SO " & strEventsource &" /D " & """" & strMessage_lf & """"
  ret = objWShell.Run(cmd1, vbHide, True)

  if DEBUG_MODE = True then
    Wscript.Echo cmd1
    Wscript.Echo "logevent: " & """" & strMessage & """" & vbNewLine & _
        "logevent: cmdexec return: " & ret
  end if

  logevent_ = ret
end function


' 64環境なら "_64" を返す関数
function makesuffix6432()
  set objWShell = CreateObject("WScript.Shell")
  strMode = objWShell.Environment("Process").Item("PROCESSOR_ARCHITECTURE")

  If UCase(strMode) = "X86" Then
    ret = ""
  Else
    ret = "_64"
  End If
  set objWShell = Nothing
  makesuffix6432 = ret
end function

' スクリプトが置かれているフォルダーパスを返す関数
function getScriptDir()
  Set objFSO = CreateObject("Scripting.FileSystemObject")  
  Set objFile = objFSO.GetFile(Wscript.ScriptFullName)  
  strFolder = objFSO.GetParentFolderName(objFile)

  Set objFSO = Nothing
  set objFile = Nothing
  getScriptDir = strFolder
end function