如果运行时间过长，间歇性无法杀死进程

Question

这里或那里我找到了Cleanmgr.exe和Ccleaner挂起。当他们这样做时，通常CPU使用率高达90％以上。这些挂起是间歇性的，很难再现，但是当它们挂起时，任务管理器已经报告说它们运行超过8个小时。几秒钟内99％的CPU使用率是典型的。

因此，我写了一个小小的vbScript来运行这些应用程序，如果它需要很长时间，就杀了它 - 我想每个应用程序不超过3分钟。仅供参考，从WinXp到8.1，我用完了，所以我真的只有vbScript和命令行。

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

这开始很简单，现在它是坚果。我希望有人在这里能帮助我。我认为问题是，这个过程正在咀嚼我的CPU，所以定时器检查我的脚本不能运行...

它发生在我身上，我从一个cmd文件使用cScript调用 - 可以那里有一些问题？

有没有办法跟踪处理时间，而不是从计时器？创建比进程更高优先级的线程，以便在挂起时可以终止？也许我的代码有bug？请帮助，我疯了。谢谢。

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

你的脚本看起来有点复杂，它需要做什么。尝试一下。

exes被连续执行。如果任何运行时间超过3分钟，则通过任务杀伤终止。如果你想完全消除WMI查询（这可能是你的脚本不得不为CPU争夺的地方），你可以简单地等待三分钟，然后发送一个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