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