Option Explicit
Dim objWMIService
Dim objSWbemSink
Dim strScreenSaver_exe
Dim boolState
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objSWbemSink = WScript.CreateObject("WbemScripting.SWbemSink","SWbemSink_")
strScreenSaver_exe = GetScreenSaver()
If Len(strScreenSaver_exe) = 0 Then
QuitInfo "Screen Saver not defined! Exiting...", 1, 3
End If
objWMIService.ExecNotificationQueryAsync objSWbemSink, _
"SELECT * FROM __InstanceOperationEvent WITHIN 1 " & _
"WHERE TargetInstance ISA 'Win32_Process' " & _
"AND TargetInstance.Name = '" & strScreenSaver_exe & "'"
Do
If boolState Then
WScript.Echo Now(), "ScreenSaver is executing."
' Что-то делаем
Else
WScript.Echo Now(), "ScreenSaver is not executing."
' Прекращаем что-то делать
End If
WScript.Sleep 500
Loop
WScript.Quit 0
'=============================================================================
'=============================================================================
Function GetScreenSaver()
Const HKEY_CURRENT_USER = &H80000001
Const strPath2PolicyOfParameters = "Software\Policies\Microsoft\Windows\Control Panel\Desktop"
Const strPath2Parameters = "Control Panel\Desktop"
Dim objStdRegProv
Dim strScreenSaveActive
Dim strSCRNSAVE_EXE_Path
Set objStdRegProv = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
GetScreenSaver = ""
' Задана политика хранителя экрана?
If objStdRegProv.GetStringValue(HKEY_CURRENT_USER, strPath2PolicyOfParameters, "ScreenSaveActive", strScreenSaveActive) = 0 Then
If strScreenSaveActive = "1" Then ' Политика хранителя экрана задана
' Задан ли путь к исполняемому файлу хранителя экрана?
If objStdRegProv.GetStringValue(HKEY_CURRENT_USER, strPath2PolicyOfParameters, "SCRNSAVE.EXE", strSCRNSAVE_EXE_Path) = 0 Then
If Len(strSCRNSAVE_EXE_Path) <> 0 Then ' Путь к исполняемому файлу хранителя экрана задан
GetScreenSaver = Mid(strSCRNSAVE_EXE_Path, InStrRev(strSCRNSAVE_EXE_Path, "\") + 1)
Exit Function
End If
End If
End If
End If
' Хранитель экрана задан?
If objStdRegProv.GetStringValue(HKEY_CURRENT_USER, strPath2Parameters, "ScreenSaveActive", strScreenSaveActive) = 0 Then
If strScreenSaveActive = "1" Then ' Хранитель экрана задан
' Задан ли путь к исполняемому файлу хранителя экрана?
If objStdRegProv.GetStringValue(HKEY_CURRENT_USER, strPath2Parameters, "SCRNSAVE.EXE", strSCRNSAVE_EXE_Path) = 0 Then
If Len(strSCRNSAVE_EXE_Path) <> 0 Then ' Путь к исполняемому файлу хранителя экрана задан
GetScreenSaver = Mid(strSCRNSAVE_EXE_Path, InStrRev(strSCRNSAVE_EXE_Path, "\") + 1)
Exit Function
End If
End If
End If
End If
Set objStdRegProv = Nothing
End Function
'=============================================================================
'=============================================================================
Sub SWbemSink_OnObjectReady(objLatestEvent, objAsyncContext)
' Какое именно событие произошло?
Select Case objLatestEvent.Path_.Class
Case "__InstanceCreationEvent"
' Хранитель экрана вызван операционной системой?
' (хранитель экрана также может быть исполнен «вручную» или из \Панель управления\Экран\Заставка)
If StrComp(GetProcessNameByPID(objLatestEvent.TargetInstance.ParentProcessID), "winlogon.exe") = 0 Then
boolState = True
End If
Case "__InstanceModificationEvent"
' Nothing to do
Case "__InstanceDeletionEvent"
' Хранитель экрана вызван операционной системой?
' (хранитель экрана также может быть исполнен «вручную» или из \Панель управления\Экран\Заставка)
If StrComp(GetProcessNameByPID(objLatestEvent.TargetInstance.ParentProcessID), "winlogon.exe") = 0 Then
boolState = False
End If
Case Else
End Select
End Sub
'=============================================================================
'=============================================================================
Function GetProcessNameByPID(PID)
Dim objProcess
Dim collProcesses
Set collProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where ProcessID = '" & PID & "'")
For Each objProcess in collProcesses
GetProcessNameByPID = objProcess.Name
Exit For
Next
Set collProcesses = Nothing
End Function
'=============================================================================
'=============================================================================
Sub QuitInfo(strInfo, intErrorlevel, intPause)
With WScript
If Len(strInfo) <> 0 Then
.Echo strInfo
End If
If intPause <> 0 Then
.Sleep intPause * 1000
End If
.Quit intErrorlevel
End With
End Sub
'=============================================================================
В качестве примера. Реализация будет сильно зависеть от типа основной задачи, вплоть до смены типа событий, на которые происходит подписка.
P.S. Коллеги, кто-нибудь помнит, в каком ключе реестре хранится значение, в течение которого операционная система не будет блокировать (Lock) рабочий стол пользователя после того, как будет запущен хранитель экрана [если он задан, конечно]. В течение этого времени, произведя какие-либо манипуляции с мышкой/клавиатурой, можно всё ещё отменить блокировку рабочего стола пользователя. Единственное, что помню, значение по умолчанию — 5 секунд.