[решено] Ограничение времени работы избранного процесса

[mapisic]

Нашел тут скрипт который проверяет время работы процесса и если оно превысило заданный - убивает.



Set WshShell = CreateObject("Wscript.Shell")
Dim InfoTime, StartTime, EndGame, Game

Game = "notepad.exe"

InfoTime = InputBox("Введите количество игровых минут", "Game's killer", "60") ' час времени на игру
Set oWmi = GetObject("WinMgmts:{impersonationLevel=impersonate}!//./root/cimv2")

WScript.Sleep 60000 ' Время, чтобы успеть включить игру (1 минута)
StartTime = Now
WshShell.RegWrite "HKCU\Test\StartTime", StartTime, "REG_SZ"
WshShell.RegWrite "HKCU\Test\InfoTime", InfoTime, "REG_SZ"
EndGame = False ' Завершена игра или еще нет. False - не завершена

While (True)
Call IsTheEndOfGame()

If EndGame<>True Then ' Все еще играем?
InfoTime = CLng(WshShell.RegRead("HKCU\Test\InfoTime"))
If ( InfoTime < 0) Then
Call KillGame()
Else
InfoTime = InfoTime + DateDiff("n",now,WshShell.RegRead("HKCU\Test\StartTime"))
WshShell.RegWrite "HKCU\Test\InfoTime", InfoTime, "REG_SZ"
End If
Else
' Вдруг выход из игры, а время еще есть
Call WaitGame()
End If

WScript.Sleep 15000 ' пауза на 15 секунд
Wend

Sub IsTheEndOfGame()
EndGame = True
For Each Process In oWmi.ExecQuery("SELECT * FROM Win32_Process")
If Process.Name=Game Then
s = Process.Name
EndGame = False
End If
Next
End Sub

Sub KillGame()
For Each Process In oWmi.ExecQuery("SELECT * FROM Win32_Process")
If Process.Name=Game Then
' Выдаем окошко с предупреждением, что время истекло.
' (Чтобы можно было сохранить достижения в игре. Иначе обидно будет)
Window = WshShell.Popup("Через минуту игра закончится, сохранись!",10,"Game's killer",16)
WScript.Sleep 50000
Process.Terminate ' Завершаем работу игрушки
End If
Next
End Sub

Sub WaitGame()
For Each Process In oWmi.ExecQuery("SELECT * FROM Win32_Process")
If Process.Name<>Game Then
EndGame = False
End If
Next
End Sub



Ни как не могу переделать под свои нужды. А нужно всё тоже самое, только без всяких записей в реестр и т.п.
Т.е. если время работы процесса > N sec. then kill


process = programm.exe
time = 60sec
While 1
If time > 60sec Then
Process.Terminate
Wend
Т.е. скрипт работает, запускаем programm.exe, если время работы процесса больше N сек. - закрываем его, если потом снова запустить programm.exe то скрипт его снова закрывает если превышено время

[Iska]

если потом снова запустить programm.exe то скрипт его снова закрывает »
Если снова запустить — то пойдёт новый отсчёт времени, с нуля.

Ну, например, вот так:
Option Explicit

Dim strProcessName
Dim intDuration
Dim intPolling

Dim strComputer

Dim objSWbemObjectEx
Dim objSWbemDateTime


strProcessName = "Notepad.exe"
intDuration = 15
intPolling = 5

strComputer = "."

With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(strComputer, "root\cimv2")
Set objSWbemDateTime = WScript.CreateObject("WbemScripting.SWbemDateTime")

Do
For Each objSWbemObjectEx In .ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & strProcessName & "'")
objSWbemDateTime.Value = objSWbemObjectEx.CreationDate

If DateAdd("s", intDuration, objSWbemDateTime.GetVarDate()) < Now() Then
objSWbemObjectEx.Terminate
End If
Next

WScript.Sleep intPolling * 1000
Loop

Set objSWbemDateTime = Nothing
End With

WScript.Quit 0

«strProcessName» — имя процесса, «intDuration» — ограничение на продолжительность работы указанного процесса (в секундах), «intPolling» — период опроса процессов (в секундах).

[mapisic]

Благодарствую. То что нужно.
UPD. если два процесса с одинаковым именем, то таймер для каждого свой?

[Iska]

UPD. если два процесса с одинаковым именем, то таймер для каждого свой? »
Именно так. Только не «таймер», а время создания процесса.