Option Explicit
On Error Resume Next
' Const conBPSReceived = "BytesReceivedPersec"
' Const conBPSSent = "BytesSentPersec"
' Const conBPSTotal = "BytesTotalPersec"
Const conInterval = 1200 ' 时间间隔(秒)
Const conSpeedMax = 20000 ' 网速上限bps(bits/s)
Const conFrequency = 5000 ' 监控网速间隔(毫秒)
Const conShowWindow = True ' 是否显示窗口;显示=True, 隐藏=False

Main

Sub Main()
  On Error Resume Next
  RunasAdmin
  If conShowWindow Then
    RunasScriptHost "cscript.exe"
  Else
    RunasScriptHost "wscript.exe"
  End If

  Dim strComputer, objWMIService, objRefresher, objShell, dtm1, dtm2, speed, stack
  Dim objRefreshableItem1, objPerfNetworkInterface
  strComputer = "."
  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  Set objRefresher = CreateObject("WbemScripting.SWbemRefresher")
  Set objShell = CreateObject("WScript.Shell")
  ' 先设置standby-timeout = 0
  objShell.Run "powercfg.exe /change standby-timeout-ac 0", 0, True
  objShell.Run "powercfg.exe /change standby-timeout-dc 0", 0, True
  ' addrefresh
  dtm1 = Now
  stack = 0
  Set objRefreshableItem1 = objRefresher.AddEnum(objWMIService, "Win32_PerfFormattedData_Tcpip_NetworkInterface")
  
  Do
    objRefresher.Refresh
    speed = 0
    If objRefreshableItem1.IsSet Then
      For Each objPerfNetworkInterface In objRefreshableItem1.ObjectSet
        speed = speed + objPerfNetworkInterface.BytesReceivedPersec
      Next
    Else
      speed = speed + objRefreshableItem1.Object.BytesReceivedPersec
    End If
    speed = speed * 8
    If conShowWindow Then
      WScript.Echo "speed = " & FormatBps(speed)
    End If
    If speed > conSpeedMax Then
      stack = 0
    Else
      If stack = 0 Then
        dtm1 = Now
        stack = 1
      End If
      dtm2 = Now
      ' WScript.Echo "min = " & DateDiff("s", dtm1, dtm2)
      If DateDiff("s", dtm1, dtm2) >= conInterval Then ' 超过指定时间,设置睡眠时间3
        objShell.Run "powercfg.exe /change standby-timeout-ac 3", 0, True
        objShell.Run "powercfg.exe /change standby-timeout-dc 3", 0, True
        Exit Do
      End If
    End If
    WScript.Sleep conFrequency
  Loop
  Set objShell = Nothing
  Set objRefresher = Nothing
  Set objWMIService = Nothing
End Sub
Function FormatBps(ByVal bps) ' As String
  On Error Resume Next
  If bps < 1000 Then
    FormatBps = FormatNumber(bps, 0) & "b/s"
  ElseIf bps < 1000000 Then
    FormatBps = FormatNumber(bps / 1000, 0) & "kb/s"
  ElseIf bps < 1000000000 Then
    FormatBps = FormatNumber(bps / 1000000, 0) & "mb/s"
  Else
    FormatBps = FormatNumber(bps / 1000000000, 0) & "gb/s"
  End If
End Function

Sub RunasScriptHost(strWSH)
  ' runas cscript.exe or wscript.exe
  On Error Resume Next
  If IsNull(strWSH) Or Not (StrComp(strWSH,"cscript.exe",vbTextCompare) = 0 Or StrComp(strWSH,"wscript.exe",vbTextCompare) = 0) Then
    Exit Sub
  End If
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  If StrComp(fso.GetFileName(WScript.FullName),strWSH,vbTextCompare) <> 0  Then
    Dim str,arg,shell
    Set shell = CreateObject("Shell.Application")
    str = ""
    For Each arg In WScript.Arguments
      str = str & " """ & arg & """"
    Next
    shell.ShellExecute strWSH,"//nologo """ & WScript.ScriptFullName & """ " & str, "", "open", 1
    Set shell = Nothing
    Set fso = Nothing
    WScript.Quit
  Else
    Set fso = Nothing
  End If
End Sub

Sub RunasAdmin()
  On Error Resume Next
  If Not IsVista(".") Then Exit Sub
  Dim wshell
  Set wshell = CreateObject("WScript.Shell")
  wshell.RegRead "HKEY_USERS\S-1-5-19\Environment\TEMP"
  If Err.Number <> 0 Then
    Dim str,arg,shell
    str = ""
    Set shell = CreateObject("Shell.Application")
    For Each arg In WScript.Arguments
      str = str & " """ & arg & """"
    Next
    shell.ShellExecute WScript.FullName,"//nologo """ & WScript.ScriptFullName & """ " & str, "", "runas", 1
    Set shell = Nothing  
    Set wshell = Nothing
    WScript.Quit
  Else
    Set wshell = Nothing
  End If
End Sub

Function IsVista(strComputer)
  On Error Resume Next
  IsVista = False
  Dim objWMIService, colOperationSystems, objOperationSystem
  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  Set colOperationSystems = objWMIService.ExecQuery("Select Version from Win32_OperatingSystem")
  For Each objOperationSystem In colOperationSystems
    If CInt(Left(objOperationSystem.Version, InStr(1,objOperationSystem.Version,".") - 1)) > 5 Then
      IsVista = True
      Exit For
    End If
  Next
  Set colOperationSystems = Nothing
  Set objWMIService = Nothing
End Function
复制代码