如果运行时间过长，则间歇性地无法终止进程

Question

在这里或那里我发现 Cleamgr.exe 和 Ccleaner 挂了。当他们这样做时，通常 CPU 使用率会超过 90%+。挂起是间歇性的并且难以重现，但是当它们挂起时，任务管理器报告运行它们运行超过 8 小时。 99% 的 CPU 使用率通常会持续几秒钟。

所以我写了一个简短的小 vbScript 来运行应用程序，然后如果需要的时间太长就将其终止 - 我认为每个应用程序不超过 3 分钟。仅供参考，我从 WinXp 到 8.1 都快用完了，所以我真的只有 vbScript 和命令行。

第一次尝试似乎成功，但后来我发现我必须应用第二次测试，再次使用另一个计时器，但是，现在我发现当 Cleanmgr 或 CCleaner 挂起时我的脚本根本没有退出。

这开始很简单，现在很疯狂。我希望这里有人可以帮助我。我认为问题在于，该进程正在占用我的 CPU，因此我的脚本中的计时器检查无法运行...

我突然想到，我正在使用 cScript 从 cmd 文件中调用它 - 那里可能有问题吗？

有没有办法跟踪进程时间而不是从计时器？创建一个比进程优先级更高的线程，以便在挂起时终止？也许我的代码中有错误？请帮忙，我要疯了。谢谢。

Option Explicit
On Error Goto 0

Dim wshShell, sysPath, waitTime, i, str, masterTimer, mElapsed, slp
Dim apps(), paths(), params()

Set wshShell=WScript.CreateObject("wScript.Shell")
sysPath  = wshShell.ExpandEnvironmentStrings("%SystemRoot%")
waitTime = 90
slp      = 2255

ReDim apps(2)
ReDim paths(2)
ReDim params(2)

apps(0)   = "cleanmgr.exe"
paths(0)  = sysPath&"\System32"
params(0) = "/SageRun:101"
apps(1)   = "ccleaner.exe"
paths(1)  = "C:\Program Files\ccleaner"
params(1) = "/AUTO"
apps(2)   = "ccleaner64.exe"
paths(2)  = "C:\Program Files\ccleaner"
params(2) = "/AUTO"

For i=LBound(apps) to UBound(apps)
 str="cmd.exe /C taskkill.exe /im " & apps( i ) & " /f /t"
 wshShell.run str
 str="cmd.exe /C taskkill.exe /im " & apps( i ) & " /f"
 wshShell.run str
 str="cmd.exe /C tskill.exe "       & apps( i ) & " /a /v"
 wshShell.run str
 WScript.Sleep slp
  masterTimer = Timer
  mElapsed    = 0
  RunCleaner paths(i),apps(i),params(i)
 str="cmd.exe /C taskkill.exe /im " & apps( i ) & " /f /t"
 wshShell.run str
 str="cmd.exe /C taskkill.exe /im " & apps( i ) & " /f"
 wshShell.run str
 str="cmd.exe /C tskill.exe "       & apps( i ) & " /a /v"
 wshShell.run str
 Set Str=Nothing
 Wscript.sleep slp
Next

ReDim apps(0)
ReDim paths(0)
ReDim params(0)
Erase apps
Erase paths
Erase params

Set slp=Nothing
Set sysPath=Nothing
Set wshShell=Nothing
Set waitTime=Nothing

WScript.Quit(0)

Public Sub RunCleaner( strPath, prog, args )
 Dim objFSO, objWMIService, objProcess, objStartup, objConfig, colMonitoredProcesses, objLatestProcess
 Dim intProcessID, erReturn, processes, proc
 Dim fullPath, elapsed, startTime, running

 Set objFSO=CreateObject( "Scripting.FileSystemObject" )
 fullPath = "" & strpath & "\" & prog

 If objFSO.FileExists( fullPath ) Then
  Set objWMIService= GetObject( "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2" )
  Set objProcess   = GetObject( "winmgmts:root\cimv2:Win32_Process" )
  Set objStartup   = objWMIService.Get( "Win32_ProcessStartup" )
  Set objConfig    = objStartup.SpawnInstance_
  objConfig.ShowWindow = 1
  elapsed   = -1 * slp
  startTime = Timer
  Wscript.sleep slp
  erReturn  = objProcess.Create ( fullPath & " " & args, Null, objConfig, intProcessID )
  Set colMonitoredProcesses = objWMIService. _        
                               ExecNotificationQuery( "select * From __InstanceDeletionEvent " _
                               & " within 1 where TargetInstance isa 'Win32_Process'" )

  Do While ( ( elapsed < waitTime ) And ( ( mElapsed ) < waitTime ) )
   Set objLatestProcess = colMonitoredProcesses.NextEvent
    If objLatestProcess.TargetInstance.ProcessID = intProcessID Then
     Exit Do
    End If
   elapsed  = Timer - startTime
   mElapsed = Timer - masterTimer
  Loop

  WScript.sleep slp
  running   = True

  Do While ( ( running ) And ( elapsed < waitTime ) And ( mElapsed < waitTime ) )
   SET processes = GetObject( "winmgmts:" )
   running = False
   elapsed = ( Timer - startTime ) / 2
   For Each proc in processes.InstancesOf( "Win32_Process" )
    If ( StrComp( LCase( proc.Name ), LCase( prog ), vbTextCompare ) = 0 ) Then
     running = True
     Exit For
    End If
   Next
   Set processes=Nothing
   mElapsed = ( Timer - masterTimer ) / 2
  Loop

  WScript.sleep slp
  fullPath = "cmd.exe /C taskkill.exe /im " & prog & " /f /t"
  wshShell.run fullPath
  fullPath = "cmd.exe /C taskkill.exe /im " & prog & " /f"
  wshShell.run fullPath
  fullPath = "cmd.exe /C tskill.exe "       & prog & " /a /v"
  wshShell.run fullPath

  Set objWMIService=Nothing
  Set objProcess=Nothing
  Set objStartup=Nothing
  Set objConfig=Nothing
  Set objProcess=Nothing
  Set erReturn=Nothing
  Set intProcessID=Nothing
  Set colMonitoredProcesses=Nothing
  Set elapsed=Nothing
  Set startTime=Nothing
  Set objLatestProcess=Nothing
  Set running=Nothing-1 * slp
  Set proc=Nothing
  Set fullPath=Nothing
 End If
 Set objFSO=Nothing
End Sub

Answer 1

您的脚本似乎有点复杂，因为它需要做什么。试试这个。

exe 是连续执行的。如果有任何运行时间超过 3 分钟，那么它们将通过 taskkill 终止。如果您想完全取消 WMI 查询（这可能是您的脚本必须争夺 CPU 的地方），您只需为每个启动的 exe 等待三分钟，然后发送一个 taskkill 而不检查它是否仍在运行。您还可以执行任务列表而不是 WMI 查询。

Dim fso, shl, wmi
Set fso = CreateObject("Scripting.FileSystemObject")
Set shl = CreateObject("WScript.Shell")
Set wmi = GetObject("winmgmts:\\.\root\cimv2")

Dim app1, app2, app3, apps()
ReDim apps(-1)
app1 = fso.BuildPath(shl.ExpandEnvironmentStrings("%SYSTEMROOT%"), "System32\cleanmgr.exe")
app2 = "C:\Program Files\ccleaner\ccleaner.exe"
app3 = "C:\Program Files\ccleaner\ccleaner64.exe"
If fso.FileExists(app1) Then AddApp app1, "/SageRun:101"
If fso.FileExists(app2) Then AddApp app2, "/AUTO"
If fso.FileExists(app3) Then AddApp app3, "/AUTO"
If UBound(apps) < 0 Then WScript.Quit ' None of the programs exist

Dim apptorun, starttime, running, process
For Each apptorun In apps
    starttime = Now
    process = fso.GetFile(apptorun.exe).Name
    shl.Run apptorun.exe & " " &  apptorun.param, 0, False
    Do While 1
        WScript.Sleep 5000
        Set running = wmi.ExecQuery("select * from win32_process where name = """ & process & """")
        If running.Count = 0 Then Exit Do
        If DateDiff("n", starttime, Now) > 3 Then
            shl.Run "taskkill /f /im " & process, 0, True
            Exit Do
        End If
    Loop
Next


Sub AddApp(app, arg)
    ReDim Preserve apps(UBound(apps) + 1)
    Set apps(UBound(apps)) = New program
    apps(UBound(apps)).exe = app
    apps(UBound(apps)).param = arg
End Sub

Class program
    Dim exe, param
End Class