Файл лога располагается в папке где скрипт.
Public strPrevent ' флаг запрета запуска
Public arrProcesses ' массив процессов
Public LogFile
Const ForAppending = 8
Const HKEY_CURRENT_USER = &H80000001
strPause=3000 ' значение паузы 3 секунды
strPauseTime="00:00:03" ' тоже самое в формате времени
TimeLimit="00:45:00" ' ограничение шпильного времени 45 минут
strKeyPath = "Software\proc_monitor" ' ветка реестра где будет производиться учёт
Set FileSytemObject = CreateObject("Scripting.FileSystemObject")
ParentFolderName = FileSytemObject.GetParentFolderName(Wscript.ScriptFullName)
LogFile = FileSytemObject.BuildPath(ParentFolderName,"PlayTime.log")
arrProcesses=Array("IceAge2pc.exe","dirt2.exe","DiRT.exe","speed.exe","Game.exe","iceage3.exe","Tumblebugs.exe","FarmFrenzy3_America.wrp.exe","FerrariVR.exe","MTX.exe","FarmFrenzy3.wrp.exe","motogp2.exe","TmForever.exe","FarmFrenzy3_Arctica.exe")
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set WshShell = CreateObject("WScript.Shell")
On Error Resume Next ' включаем обработку ошибок
WshShell.RegRead "HKEY_CURRENT_USER\Software\proc_monitor\" ' проверяем, есть ли такая ветка реестра
If Err.Number<>0 Then
Err.Clear
On Error Goto 0 ' отключаем обработку ошибок
oReg.CreateKey HKEY_CURRENT_USER,strKeyPath ' если нет - то создаём ветку
oReg.CreateKey HKEY_CURRENT_USER,strKeyPath & "\CurrDate" ' создаём веточку для даты
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath & "\CurrDate","strDate",CStr(DateValue(Date)) ' прописываем сегоднящнюю дату
End If
' сейчас будем синхронизировать список процессов в скрипте и реестре
strValue = "00:00:00" ' нулевое время
oReg.EnumValues HKEY_CURRENT_USER, strKeyPath,arrValueNames
If IsNull(arrValueNames) Then ' в реестре всё пусто, надо заполнять списком
For Each Process in arrProcesses
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,Process,strValue
Next
Else ' если учёт ранее вёлся
' Синхронизация реестра к массиву
' лишнее из реестра удаляется
For r=0 to UBound(arrValueNames)
strFlag=0 ' флаг совпадения наименования процесса
For n=0 to UBound(arrProcesses)
If arrValueNames(r)=arrProcesses(n) Then
strFlag=1
Exit For
End If
Next
If strFlag=0 Then ' если совпадения нет - то удаляем
oReg.DeleteValue HKEY_CURRENT_USER,strKeyPath,arrValueNames(r)
End If
Next
' Синхронизация массива к реестру
' недостающие процессы дописываются в реестр
For r=0 to UBound(arrProcesses)
strFlag=0 ' флаг совпадения наименования процесса
For n=0 to UBound(arrValueNames)
If arrProcesses(r)=arrValueNames(n) Then
strFlag=1
Exit For
End If
Next
If strFlag=0 Then ' если совпадения нет - то дописываем в реестр
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,arrProcesses(r),strValue
End If
Next
End if
' ОСНОВНОЙ ЦИКЛ
' асинхронный обработчик на создание процесса
Set SINKC = WScript.CreateObject("WbemScripting.SWbemSink","SINKC_")
objWMIService.ExecNotificationQueryAsync SINKC, "SELECT * FROM __InstanceCreationEvent WITHIN 3 WHERE TargetInstance ISA 'Win32_Process'"
' асинхронный обработчик на удаление процесса
Set SINKT = WScript.CreateObject("WbemScripting.SWbemSink","SINKT_")
objWMIService.ExecNotificationQueryAsync SINKT, "SELECT * FROM __InstanceDeletionEvent WITHIN 3 WHERE TargetInstance ISA 'Win32_Process'"
Do While 1=1
' I считывание, сравнение даты, обнуление счётчиков при смене даты
oReg.GetStringValue HKEY_CURRENT_USER,strKeyPath & "\CurrDate","strDate",strDate ' считываем дату последнего учёта
If DateValue(strDate)<>DateValue(Date) Then ' если даты не совпадают
For Each Process in arrProcesses
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,Process,strValue ' то обнуляем счётчики отработанного времени у всех процессов
Next
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath & "\CurrDate","strDate",CStr(DateValue(Date)) ' прописываем сегоднящнюю дату
' логируем смену даты
Set LogF = FileSytemObject.OpenTextFile(LogFile, ForAppending, True)
LogF.WriteLine String(25,"-") & " " & DateValue(Date) & " " & String(25,"-")
LogF.Close
End If
' II расчёт суммарного шпильного времени
sumTime="00:00:00"
For Each Process in arrProcesses
oReg.GetStringValue HKEY_CURRENT_USER,strKeyPath,Process,strTime
sumTime=TimeValue(sumTime) + TimeValue(strTime)
Next
' III сравниваем "выработанное" время с лимитным и устанавливаем флаг запрета шпиля
If TimeValue(sumTime)>=TimeValue(TimeLimit) Then
strPrevent=1 ' ЗАПРЕЩЕНО
Else
strPrevent=0 ' РАЗРЕШЕНО
End If
' IV учёт времени работы процессов из списка и убивание процессов при выставленном флаге
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process")
For Each objItem in colItems
strOut=0 ' обнуление флага выхода из цклов в начале первичного цикла For
For Each Process in arrProcesses
If LCase(objItem.Name)=LCase(Process) Then ' если процесс из списка работает
' если флаг запрета запуска выставлен - то убиваем процессы из списка
If strPrevent=1 Then
objItem.Terminate
' здесь логируем здесь логируем принудительно закрытый процесс
Set LogF = FileSytemObject.OpenTextFile(LogFile, ForAppending, True)
LogF.WriteLine Now & " принудительно закрыт процесс: " & LCase(Process)
LogF.Close
Exit For
Else
oReg.GetStringValue HKEY_CURRENT_USER,strKeyPath,Process,strTime
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,Process,CStr(TimeValue(strTime)+TimeValue(strPauseTime)) ' то к его времени прибавляем время паузы
strOut=1 ' флаг выхода из цикла вложенного For при встрече любого первого процесса
Exit For
End If
End If
Next
If strOut=1 Then ' в соответствии с флагом выхода выходим из первичного цикла For
Exit For
End If
Next
Wscript.Sleep strPause
Loop
' асинхронный убийца при запуске
Sub SINKC_OnObjectReady(objLatestEvent, objAsyncContext)
For Each Process in arrProcesses
If LCase(Process)=LCase(objLatestEvent.TargetInstance.Name) Then
If strPrevent=1 Then ' при запуске убиваем процессы из списка при запрещающем флаге
objLatestEvent.TargetInstance.Terminate
' здесь логируем предотвращённый запуск
Set LogF = FileSytemObject.OpenTextFile(LogFile, ForAppending, True)
LogF.WriteLine Now & " предотвращен запуск: " & objLatestEvent.TargetInstance.Name
LogF.Close
Exit Sub
End If
' здесь логируем разрешённый запуск
Set LogF = FileSytemObject.OpenTextFile(LogFile, ForAppending, True)
LogF.WriteLine Now & " запущен процесс: " & objLatestEvent.TargetInstance.Name
LogF.Close
End If
Next
End Sub
' логирование при закрытии процесса
Sub SINKT_OnObjectReady(objLatestEvent, objAsyncContext)
For Each Process in arrProcesses
If LCase(Process)=LCase(objLatestEvent.TargetInstance.Name) Then
If strPrevent<>1 Then ' если этот флаг не учитывать - то будет проходить двойное логирование (принудительное и потом нормальное)
Set LogF = FileSytemObject.OpenTextFile(LogFile, ForAppending, True)
LogF.WriteLine Now & " нормально закрыт процесс: " & objLatestEvent.TargetInstance.Name
LogF.Close
End If
End If
Next
End Sub
Вроде бы мелкософт для таких целей и делал эту технологию ? А в политиках можно много чего понастраивать.
частично подходит решение... (ИМХО - рефрешер рулит)
)
- как нацарапаю решение 
- не то учитываете.... 
