Родительский контроль для XP.

Намедни ко мне обратился товарищ с просьбой помочь ограничить время, которое его ребенок проводит за компьютером. Родительский контроль не в счет - у него XP, кроме того было необходимо не задавать часы использования, а контролировать время в совокупности за день. Немного погуглив, я к своему удивлению не обнаружил бесплатных решений, после чего решил собрать свой "велосипед", о чем и поведу речь в настоящей статье. Уважаемые папы и мамы, приготовьте блокнот и ручки...

1. Найдем количество времени с момента последней загрузки компьютера. Открываем блокнот, пишем ручками :).

Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
For Each obj In GetObject("winmgmts:\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_OperatingSystem")
 dateTime.Value = obj.LastBootUpTime 
 MsgBox "Со времени последней загрузки прошло " &  DateDiff("n",dateTime.GetVarDate(),Now()) & " мин."
Next

Сохраняем файл с именем DateDiff.vbs. Запускаем... (здесь и далее весь код запускаем от имени учетной записи, обладающей правами администратора).

2. Для хранения данных создадим WMI-класс в пространстве имен "root\default".

Const ClassName = "MySuperClass"

Set objDefault = GetObject("winmgmts:\\.\root\default")

'MsgBox ClassExists(objDefault)
MsgBox ClassCreate(objDefault)
'MsgBox ClassDelete(objDefault)

'наличие класса
Function ClassExists(objDefault)
 On Error Resume Next
 For Each objClass In objDefault.SubclassesOf()   
  If InStr(objClass.Path_.Path, ClassName) Then
   ClassExists = True
   Exit Function
  End If
 Next
End Function

'создаем класс
Function ClassCreate(objDefault)
 On Error Resume Next
 Const Created = "Created" 'дата создания
 Const LastBootUpDate = "LastBootUpDate" 'дата последней загрузки
 Const MinuteCount = "MinuteCounter" 'счетчик отработанных минут
 Const MinutePermited = "MinutePermited" 'количество разрешенных минут
 With objDefault.Get()
  .Path_.Class = ClassName
  'добавляем свойства
  .Properties_.Add Created, 101
  .Properties_.Add LastBootUpDate, 101 
  .Properties_.Add MinuteCount, 19
  .Properties_.Add MinutePermited, 19
  'значения свойств
  Set dateTime = CreateObject("WbemScripting.SWbemDateTime")  
  dateTime.SetVarDate Now(),True  
  .Properties_(Created) = dateTime.Value  
  .Properties_(LastBootUpDate) = dateTime.Value
  .Properties_(MinuteCount) = 0
  .Properties_(MinutePermited) = 3 'для теста достаточно 3-х минут
  'пишем класс в репозиторий
  .Put_
 End With
 If Err.Number = 0 Then
  ClassCreate = True
 End If 
End Function
 
'удаляем класс
Function ClassDelete(objDefault) 
 On Error Resume Next
 With objDefault.Get()
  .Path_.Class = ClassName
  .Put_
 End With
 objDefault.Delete ClassName
 If Err.Number = 0 Then
  ClassDelete = True
 End If
End Function

Называем файл Class.vbs. Тестируем путем раскомментирования-закомментирования MsgBox-ов.

3. Пишем скрипт, который будет выполняться каждую минуту. Назовем его Go.vbs.

On Error Resume Next
Const ClassName = "MySuperClass" 'имя класса
Const LastBootUpDate = "LastBootUpDate" 'дата последней загрузки
Const MinuteCount = "MinuteCounter" 'счетчик отработанных минут
Const MinutePermited = "MinutePermited" 'количество разрешенных минут
Set objDefault = GetObject("winmgmts:\\.\root\default:" & ClassName)

If ClassExists(objDefault) Then
 'проверим, не пора ли обнулить счетчик
 Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
 dateTime.Value = objDefault.Properties_(LastBootUpDate)
 'если наступил следующий день
 If DateValue(dateTime.GetVarDate()) <> Date() Then
  dateTime.SetVarDate Now(),True
  With objDefault
   .Properties_(LastBootUpDate) = dateTime.Value
   .Properties_(MinuteCount) = 0
   .Put_
  End With
 End If

 'проверим, не пора ли выключать компьютер
 With objDefault
  .Properties_(MinuteCount) = .Properties_(MinuteCount) + 1
  .Put_  
  If .Properties_(MinuteCount) >= .Properties_(MinutePermited) Then Shutdown  
 End With
End If

'наличие класса
Function ClassExists(objDefault)
 On Error Resume Next
 For Each objClass In objDefault.SubclassesOf()   
  If InStr(objClass.Path_.Path, ClassName) Then
   ClassExists = True
   Exit Function
  End If
 Next
End Function

Sub Shutdown()
 On Error Resume Next
 For Each obj In GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_OperatingSystem")    
  obj.Win32Shutdown(12) 'Forced Power Off (8 + 4)
 Next
End Sub

Создаем WMI-класс и запускаем скрипт первый раз, второй, третий...

4. Включаем компьютер, входим в систему. Копируем Go.vbs в каталог "C:\temp". Создаем постоянную подписку WMI.

Const TimerId = "MySuperTimer"
Const ConsumerTimer = "MySuperConsumer"
Const FilterTimer = "MySuperFilter"

Set objSubscription = GetObject("winmgmts:\\.\root\subscription")

'MsgBox ScriptConsumerExists(objSubscription)
'MsgBox SubscriptionExists(objSubscription)
MsgBox SubscriptionCreate(objSubscription)
'MsgBox SubscriptionDelete(objSubscription)

'проверка регистрации ActiveScriptEventConsumer
Function ScriptConsumerExists(objSubscription)
 On Error Resume Next
 If objSubscription.ExecQuery( _
   "SELECT * FROM __Provider WHERE Name='ActiveScriptEventConsumer'").Count Then
  ScriptConsumerExists = True
 End If
End Function

'наличие подписки
Function SubscriptionExists(objSubscription)
 On Error Resume Next
 If objSubscription.ExecQuery("SELECT * FROM ActiveScriptEventConsumer WHERE Name = '" & ConsumerTimer & "'").Count Then   
  SubscriptionExists = True
 End If
End Function

'создаем подписку
Function SubscriptionCreate(objSubscription)
 On Error Resume Next
 Dim sTime
 sTime = 60000 'миллисекунд для таймера 
 'создание таймера и его конфигурирование
 With objSubscription.Get("__IntervalTimerInstruction").SpawnInstance_()
  .TimerId = TimerId
  .IntervalBetweenEvents = sTime 'миллисекунд
  .SkipIfPassed = True 'пропустить, если событие прошло
  .Put_
 End With
 
 'создание фильтра таймера
 With objSubscription.Get("__EventFilter").SpawnInstance_()
  .Name = FilterTimer
  .QueryLanguage = "WQL"
  .Query = "SELECT * FROM __TimerEvent WHERE TimerId = '" & TimerId & "'"
  Set objFilterPath = .Put_()
 End With
 
 'создание потребителя события таймера
 With objSubscription.Get("ActiveScriptEventConsumer").SpawnInstance_()
  .Name = ConsumerTimer
  .ScriptingEngine = "VBScript"
  .KillTimeout = 10
  .ScriptFileName = "C:\temp\Go.vbs" 'для проверки
  Set objConsumerPath = .Put_()
 End With
 
 'связка фильтра и потребителя
 With objSubscription.Get("__FilterToConsumerBinding").SpawnInstance_()
  .Filter = objFilterPath
  .Consumer = objConsumerPath
  .Put_
 End With
 
 If Err.Number = 0 Then
        SubscriptionCreate = True
    End If
End Function

'удаляем подписку
Function SubscriptionDelete(objSubscription)
    On Error Resume Next 
    'удаляем фильтр таймера
    Set colFilters = objSubscription.ExecQuery("SELECT * FROM __EventFilter WHERE Name='" & FilterTimer & "'")
    If colFilters.Count Then
        For Each objFilter In colFilters
            objFilter.Delete_
        Next
    End If
    Set colFilters = Nothing
  
    'удаляем потребителя таймера
    Set colConsumers = objSubscription.ExecQuery("SELECT * FROM ActiveScriptEventConsumer WHERE Name='" & ConsumerTimer & "'")
    If colConsumers.Count Then
        For Each objConsumer In colConsumers
            objConsumer.Delete_
        Next
    End If
    Set colConsumers = Nothing
  
    Set colTimers = objSubscription.ExecQuery("SELECT * FROM __IntervalTimerInstruction WHERE TimerId='" & TimerId & "'")
    If colTimers.Count Then
        For Each objTimer In colTimers
            objTimer.Delete_
        Next
    End If
    Set colTimers = Nothing
  
    If Err.Number = 0 Then
        SubscriptionDelete = True
    End If
End Function

Называем файл Subscription.vbs. Запускаем, ждем 3 минуты...

5. Продолжаем разговор. Для того, чтобы удалить нашу подписку, сразу после входа в систему запускаем блокнот, закомментируем строку "MsgBox SubscriptionCreate(objSubscription)", раскомментируем строку "MsgBox SubscriptionDelete(objSubscription)" и запускаем скрипт (или меняем системную дату, или удаляем файл Go.vbs из каталога "C:\temp", после чего удаляем подписку без суеты).

Преобразуем код файла Go.vbs в строку, закидываем ее в переменную и добавляем потребителю событий свойство ScriptText со значением в лице полученной переменной, после чего удаляем (в коде закомментировано для наглядности) свойство ScriptFileName.

Const TimerId = "MySuperTimer"
Const ConsumerTimer = "MySuperConsumer"
Const FilterTimer = "MySuperFilter"

Set objSubscription = GetObject("winmgmts:\\.\root\subscription")

'MsgBox ScriptConsumerExists(objSubscription)
'MsgBox SubscriptionExists(objSubscription)
MsgBox SubscriptionCreate(objSubscription)
'MsgBox SubscriptionDelete(objSubscription)

'проверка регистрации ActiveScriptEventConsumer
Function ScriptConsumerExists(objSubscription)
 On Error Resume Next
 If objSubscription.ExecQuery( _
   "SELECT * FROM __Provider WHERE Name='ActiveScriptEventConsumer'").Count Then
  ScriptConsumerExists = True
 End If
End Function

'наличие подписки
Function SubscriptionExists(objSubscription)
 On Error Resume Next
 If objSubscription.ExecQuery("SELECT * FROM ActiveScriptEventConsumer WHERE Name = '" & ConsumerTimer & "'").Count Then   
  SubscriptionExists = True
 End If
End Function

'создаем подписку
Function SubscriptionCreate(objSubscription)
 On Error Resume Next
 Dim sTime
 sTime = 60000 'миллисекунд для таймера 
 'создание таймера и его конфигурирование
 With objSubscription.Get("__IntervalTimerInstruction").SpawnInstance_()
  .TimerId = TimerId
  .IntervalBetweenEvents = sTime 'миллисекунд
  .SkipIfPassed = True 'пропустить, если событие прошло
  .Put_
 End With
 
 'создание фильтра таймера
 With objSubscription.Get("__EventFilter").SpawnInstance_()
  .Name = FilterTimer
  .QueryLanguage = "WQL"
  .Query = "SELECT * FROM __TimerEvent WHERE TimerId = '" & TimerId & "'"
  Set objFilterPath = .Put_()
 End With
 
 'собираем текст скрипта
 varrr = "On Error Resume Next" & vbCrLf & "Const ClassName = ""MySuperClass""" & vbCrLf & "Const LastBootUpDate = ""LastBootUpDate""" & vbCrLf & "Const MinuteCount = ""MinuteCounter""" & vbCrLf & "Const MinutePermited = ""MinutePermited""" & vbCrLf & "Set objDefault = GetObject(""winmgmts:\\.\root\default:"" & ClassName)" & vbCrLf & "If ClassExists(objDefault) Then" & vbCrLf & "Set dateTime = CreateObject(""WbemScripting.SWbemDateTime"")" & vbCrLf & "dateTime.Value = objDefault.Properties_(LastBootUpDate)" & vbCrLf & "If DateValue(dateTime.GetVarDate()) <> Date() Then" & vbCrLf
 varrr = varrr & "dateTime.SetVarDate Now(),True" & vbCrLf & "With objDefault" & vbCrLf & ".Properties_(LastBootUpDate) = dateTime.Value" & vbCrLf & ".Properties_(MinuteCount) = 0" & vbCrLf & ".Put_" & vbCrLf & "End With" & vbCrLf & "End If" & vbCrLf & "With objDefault" & vbCrLf & ".Properties_(MinuteCount) = .Properties_(MinuteCount) + 1" & vbCrLf & ".Put_  " & vbCrLf & "If .Properties_(MinuteCount) >= .Properties_(MinutePermited) Then Shutdown" & vbCrLf
 varrr = varrr & "End With" & vbCrLf & "End If" & vbCrLf & "Function ClassExists(objDefault)" & vbCrLf & "On Error Resume Next" & vbCrLf & "For Each objClass In objDefault.SubclassesOf()" & vbCrLf & "If InStr(objClass.Path_.Path, ClassName) Then" & vbCrLf & "ClassExists = True" & vbCrLf & "Exit Function" & vbCrLf & "End If" & vbCrLf & "Next" & vbCrLf & "End Function" & vbCrLf
 varrr = varrr & "Sub Shutdown()" & vbCrLf & "On Error Resume Next" & vbCrLf & "For Each obj In GetObject(""winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2"").ExecQuery(""SELECT * FROM Win32_OperatingSystem"")" & vbCrLf & "obj.Win32Shutdown(12)" & vbCrLf & "Next" & vbCrLf & "End Sub"
 
 'создание потребителя события таймера
 With objSubscription.Get("ActiveScriptEventConsumer").SpawnInstance_()
  .Name = ConsumerTimer
  .ScriptingEngine = "VBScript"
  .KillTimeout = 10
  '.ScriptFileName = "C:\temp\Go.vbs" 'для проверки
  .ScriptText = varrr
  Set objConsumerPath = .Put_()
 End With
 
 'связка фильтра и потребителя
 With objSubscription.Get("__FilterToConsumerBinding").SpawnInstance_()
  .Filter = objFilterPath
  .Consumer = objConsumerPath
  .Put_
 End With
 
 If Err.Number = 0 Then
        SubscriptionCreate = True
    End If
End Function

'удаляем подписку
Function SubscriptionDelete(objSubscription)
    On Error Resume Next 
    'удаляем фильтр таймера
    Set colFilters = objSubscription.ExecQuery("SELECT * FROM __EventFilter WHERE Name='" & FilterTimer & "'")
    If colFilters.Count Then
        For Each objFilter In colFilters
            objFilter.Delete_
        Next
    End If
    Set colFilters = Nothing
  
    'удаляем потребителя таймера
    Set colConsumers = objSubscription.ExecQuery("SELECT * FROM ActiveScriptEventConsumer WHERE Name='" & ConsumerTimer & "'")
    If colConsumers.Count Then
        For Each objConsumer In colConsumers
            objConsumer.Delete_
        Next
    End If
    Set colConsumers = Nothing
  
    Set colTimers = objSubscription.ExecQuery("SELECT * FROM __IntervalTimerInstruction WHERE TimerId='" & TimerId & "'")
    If colTimers.Count Then
        For Each objTimer In colTimers
            objTimer.Delete_
        Next
    End If
    Set colTimers = Nothing
  
    If Err.Number = 0 Then
        SubscriptionDelete = True
    End If
End Function

Запускаем скрипт. Файл "C:\temp\Go.vbs" нам больше не понадобится. Ждем 3 минуты...

6. После очередного входа в систему повторяем манипуляции с удалением подписки. Похожим образом удаляем WMI-класс.
Приступаем к сборке "велосипеда". Открываем блокнот, пишем теми же ручками :).

<html>
<head>
 <title>TR</title> 
 <meta http-equiv=content-type content="text-html; charset=windows-1251">
    <meta http-equiv=MSThemeCompatible content=yes>
    <hta:application             
  icon=keymgr.dll
        scroll=no
  maximizebutton=no
  version="1.0"
    >
</head>
<style type="text/css"> 
 #btn{width:100px;}
 #min{width:35px;}
</style>
<script language="VBScript">
 Const ClassName = "MySuperClass" 
 Const TimerId = "MySuperTimer"
 Const ConsumerTimer = "MySuperConsumer"
 Const FilterTimer = "MySuperFilter"
 
 Sub window_onload()
  window.resizeTo 230, 90
  window.moveTo 20, 20  
  window.setTimeout "afterLoad",10, "vbscript"
 End Sub
 
 Sub afterLoad()
  Const MinutePermited = "MinutePermited"
  Set objDefault = GetObject("winmgmts:\\.\root\default")
  If ClassExists(objDefault) Then   
   min.Value = objDefault.Get(ClassName).Properties_(MinutePermited) 'читаем значение свойства
   Set objSubscription = GetObject("winmgmts:\\.\root\subscription")
   If SubscriptionExists(objSubscription) Then    
    btn.Value = "Удалить"
   Else
    btn.Value = "Установить"    
   End If
   Set objSubscription = Nothing
  Else
   btn.Value = "Установить"
  End If
  Set objDefault = Nothing
 End Sub
 
 Sub btn_onclick()
  Set objSubscription = GetObject("winmgmts:\\.\root\subscription")
  If Me.Value = "Установить" Then
   If min.Value = vbNullString Or Not IsNumeric(min.Value) Then
    MsgBox "Введите количество минут"
   Else
    If InstallTR Then Me.Value = "Удалить"
   End If   
  Else
   If DeleteTR Then
    Me.Value = "Установить"
    min.Value = ""
   End If
  End If
  Set objSubscription = Nothing
 End Sub 
 
 Function InstallTR()
  On Error Resume Next
  Set objDefault = GetObject("winmgmts:\\.\root\default")
  If ClassCreate(objDefault) Then
   Set objSubscription = GetObject("winmgmts:\\.\root\subscription")
   If ScriptConsumerExists(objSubscription) Then
    If SubscriptionCreate(objSubscription) Then InstallTR = True
   End If
   Set objSubscription = Nothing
  End If
  Set objDefault = Nothing
 End Function
 
 Function DeleteTR()
  On Error Resume Next
  Set objSubscription = GetObject("winmgmts:\\.\root\subscription")
  If SubscriptionDelete(objSubscription) Then
   Set objDefault = GetObject("winmgmts:\\.\root\default")
   If ClassDelete(objDefault) Then DeleteTR = True
   Set objDefault = Nothing
  End If
  Set objSubscription = Nothing
 End Function
 
 '***** Класс *****
 'наличие класса
 Function ClassExists(objDefault)
  On Error Resume Next
  For Each objClass In objDefault.SubclassesOf()   
   If InStr(objClass.Path_.Path, ClassName) Then
    ClassExists = True
    Exit Function
   End If
  Next
 End Function

 'создаем класс
 Function ClassCreate(objDefault)
  On Error Resume Next
  Const Created = "Created" 'дата создания
  Const LastBootUpDate = "LastBootUpDate" 'дата последней загрузки
  Const MinuteCount = "MinuteCounter" 'счетчик отработанных минут
  Const MinutePermited = "MinutePermited" 'количество разрешенных минут
  With objDefault.Get()
   .Path_.Class = ClassName
   'добавляем свойства
   .Properties_.Add Created, 101
   .Properties_.Add LastBootUpDate, 101 
   .Properties_.Add MinuteCount, 19
   .Properties_.Add MinutePermited, 19
   'значения свойств
   Set dateTime = CreateObject("WbemScripting.SWbemDateTime")  
   dateTime.SetVarDate Now(),True  
   .Properties_(Created) = dateTime.Value  
   .Properties_(LastBootUpDate) = dateTime.Value
   .Properties_(MinuteCount) = 0
   .Properties_(MinutePermited) = min.Value
   'пишем класс в репозиторий
   .Put_
  End With
  If Err.Number = 0 Then
   ClassCreate = True
  End If 
 End Function
  
 'удаляем класс
 Function ClassDelete(objDefault) 
  On Error Resume Next
  With objDefault.Get()
   .Path_.Class = ClassName
   .Put_
  End With
  objDefault.Delete ClassName
  If Err.Number = 0 Then
   ClassDelete = True
  End If
 End Function
 '********************
 
 '***** Подписка *****
 'проверка регистрации ActiveScriptEventConsumer
 Function ScriptConsumerExists(objSubscription)
  On Error Resume Next
  If objSubscription.ExecQuery( _
    "SELECT * FROM __Provider WHERE Name='ActiveScriptEventConsumer'").Count Then
   ScriptConsumerExists = True
  End If
 End Function

 'наличие подписки
 Function SubscriptionExists(objSubscription)
  On Error Resume Next
  If objSubscription.ExecQuery("SELECT * FROM ActiveScriptEventConsumer WHERE Name = '" & ConsumerTimer & "'").Count Then   
   SubscriptionExists = True
  End If
 End Function

 'создаем подписку 
 Function SubscriptionCreate(objSubscription)
  On Error Resume Next
  Dim sTime
  sTime = 60000 'миллисекунд для таймера 
  'создание таймера и его конфигурирование
  With objSubscription.Get("__IntervalTimerInstruction").SpawnInstance_()
   .TimerId = TimerId
   .IntervalBetweenEvents = sTime 'миллисекунд
   .SkipIfPassed = True 'пропустить, если событие прошло
   .Put_
  End With
  
  'создание фильтра таймера
  With objSubscription.Get("__EventFilter").SpawnInstance_()
   .Name = FilterTimer
   .QueryLanguage = "WQL"
   .Query = "SELECT * FROM __TimerEvent WHERE TimerId = '" & TimerId & "'"
   Set objFilterPath = .Put_()
  End With
  
  'собираем текст скрипта
  varrr = "On Error Resume Next" & vbCrLf & "Const ClassName = ""MySuperClass""" & vbCrLf & "Const LastBootUpDate = ""LastBootUpDate""" & vbCrLf & "Const MinuteCount = ""MinuteCounter""" & vbCrLf & "Const MinutePermited = ""MinutePermited""" & vbCrLf & "Set objDefault = GetObject(""winmgmts:\\.\root\default:"" & ClassName)" & vbCrLf & "If ClassExists(objDefault) Then" & vbCrLf & "Set dateTime = CreateObject(""WbemScripting.SWbemDateTime"")" & vbCrLf & "dateTime.Value = objDefault.Properties_(LastBootUpDate)" & vbCrLf & "If DateValue(dateTime.GetVarDate()) <> Date() Then" & vbCrLf
  varrr = varrr & "dateTime.SetVarDate Now(),True" & vbCrLf & "With objDefault" & vbCrLf & ".Properties_(LastBootUpDate) = dateTime.Value" & vbCrLf & ".Properties_(MinuteCount) = 0" & vbCrLf & ".Put_" & vbCrLf & "End With" & vbCrLf & "End If" & vbCrLf & "With objDefault" & vbCrLf & ".Properties_(MinuteCount) = .Properties_(MinuteCount) + 1" & vbCrLf & ".Put_  " & vbCrLf & "If .Properties_(MinuteCount) >= .Properties_(MinutePermited) Then Shutdown" & vbCrLf
  varrr = varrr & "End With" & vbCrLf & "End If" & vbCrLf & "Function ClassExists(objDefault)" & vbCrLf & "On Error Resume Next" & vbCrLf & "For Each objClass In objDefault.SubclassesOf()" & vbCrLf & "If InStr(objClass.Path_.Path, ClassName) Then" & vbCrLf & "ClassExists = True" & vbCrLf & "Exit Function" & vbCrLf & "End If" & vbCrLf & "Next" & vbCrLf & "End Function" & vbCrLf
  varrr = varrr & "Sub Shutdown()" & vbCrLf & "On Error Resume Next" & vbCrLf & "For Each obj In GetObject(""winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2"").ExecQuery(""SELECT * FROM Win32_OperatingSystem"")" & vbCrLf & "obj.Win32Shutdown(12)" & vbCrLf & "Next" & vbCrLf & "End Sub"
  
  'создание потребителя события таймера
  With objSubscription.Get("ActiveScriptEventConsumer").SpawnInstance_()
   .Name = ConsumerTimer
   .ScriptingEngine = "VBScript"
   .KillTimeout = 10 'завершить выполнение через 10 секунд  
   '.ScriptFileName = "C:\temp\Go.vbs" 'для проверки
   .ScriptText = varrr
   Set objConsumerPath = .Put_()
  End With
  
  'связка фильтра и потребителя
  With objSubscription.Get("__FilterToConsumerBinding").SpawnInstance_()
   .Filter = objFilterPath
   .Consumer = objConsumerPath
   .Put_
  End With
  
  If Err.Number = 0 Then
   SubscriptionCreate = True
  End If
 End Function

 'удаляем подписку
 Function SubscriptionDelete(objSubscription)
  On Error Resume Next 
  'удаляем фильтр таймера
  Set colFilters = objSubscription.ExecQuery("SELECT * FROM __EventFilter WHERE Name='" & FilterTimer & "'")
  If colFilters.Count Then
   For Each objFilter In colFilters
    objFilter.Delete_
   Next
  End If
  Set colFilters = Nothing
  
  'удаляем потребителя таймера
  Set colConsumers = objSubscription.ExecQuery("SELECT * FROM ActiveScriptEventConsumer WHERE Name='" & ConsumerTimer & "'")
  If colConsumers.Count Then
   For Each objConsumer In colConsumers
    objConsumer.Delete_
   Next
  End If
  Set colConsumers = Nothing
  
  Set colTimers = objSubscription.ExecQuery("SELECT * FROM __IntervalTimerInstruction WHERE TimerId='" & TimerId & "'")
  If colTimers.Count Then
   For Each objTimer In colTimers
    objTimer.Delete_
   Next
  End If
  Set colTimers = Nothing
  
  If Err.Number = 0 Then
   SubscriptionDelete = True
  End If
 End Function
 '******************** 
</script>
<body>
 <input id="btn" type="button"/> <input id="min" type="text"/> минут
</body>
</html>

Сохраняем файл с именем TimeRestriction.hta.
Осталось выдать ребенку учетную запись с ограниченными правами с целью предотвращения изменения системной даты и установить ограничение.
Если впоследствии станет известно о прецеденте обхода ограничения... я бы подумал "...а гриб то вырос..." :).

P.S. Наверняка мое повествование может заинтересовать не только родителей :).