SimpleScripts/ProgramCatcher.vbs at main · baalp/SimpleScripts · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
Option Explicit

Dim Shell, ShellApp, FSO, WMI

Set Shell = CreateObject("WScript.Shell")
Set ShellApp = CreateObject("Shell.Application")
Set FSO   = CreateObject("Scripting.FileSystemObject")
Set WMI   = GetObject("winmgmts:\\.\root\cimv2")

Dim ScriptName
ScriptName = "ProgramCatcher"

'Íàñòðîéêè ñêðèïòà
Dim ProgramName, CheckFrequency, RunningTime
'Îòñëåæèâàåìàÿ ïðîãðàììà
ProgramName = "notepad.exe"
'×àñòîòà ïðîâåðêè (â ms)
CheckFrequency = 1000
'Äëèòåëüíîñòü ðàáîòû (â s)
'0 = Áåñêîíå÷íî
RunningTime = 0

'---------------------------------------------------------
'Íà÷àëî ãëàâíîãî àëãîðèòìà

'Ïîäòâåðæäåíèå çàïóñêà
Dim result, message
message = "Äàííàÿ ïðîãðàììà áóäåò, â ôîíîâîì ðåæèìå, ñëåäèòü çà çàïóùåííûìè ïðèëîæåíèÿìè. "
message = message + "Îíà ñðåàãèðóåò íà çàïóñê " + ProgramName + ". "
message = message + "×òîáû çàâåðøèòü ïðîãðàììó, çàïóñòèòå " + ProgramName
message = message + " èëè çàâåðøèòå çàäà÷ó wscript.exe èç Äèñïåò÷åðà çàäà÷. " + vbCr + vbCr
message = message + "Íàæìèòå ÎÊ, ÷òîáû çàïóñòèòü ïðîãðàììó." + vbCr + "Íàæìèòå ÎÒÌÅÍÀ èëè çàêðîéòå îêíî äëÿ îòìåíû."
result = msgbox(message, 1, ScriptName)
    'OK = 1, Cancel = 2
select case result
    case 1
        'WScript.Sleep 100
    case 2
        WScript.Quit
end select

'Öèêë îòñëåæèâàíèÿ
Dim i, iterations
i = 0
if RunningTime > 0 Then
    iterations = int(RunningTime / (CheckFrequency / 1000))
Else
    iterations = 0
End If
Do
    i = i + 1
    WScript.Sleep CheckFrequency
    ProgramCatcher(ProgramName)
    if i >= iterations and iterations > 0 Then
        WScript.Quit
    End If
Loop

'Call SendToast("Shield",5000,"Äîáðî ïîæàëîâàòü!","Ìû æäàëè òåáÿ","None",5)
'Call SendToast("Shield",5000,"Äîáðî ïîæàëîâàòü!","×óâñòâóé ñåáÿ, êàê äîìà","None",5)

'---------------------------------------------------------
'Ïîèñê çàïóùåííîãî ïðèëîæåíèÿ
Sub ProgramCatcher(programName)
    Dim colItems
    Set colItems = WMI.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & ProgramName & "'")
    If colItems.Count > 0 Then
        'Åñëè ïðîãðàììà çàïóùåíà
        ShellApp.MinimizeAll
        'Call SendToast("Shield",5000,"Îòñëåæèâàíèå",ProgramName + " çàïóùåí","None",5)
        WScript.Quit
    Else
        'WScript.Sleep 100
        'Åñëè ïðîãðàììà íå çàïóùåíà
        'Call SendToast("Error",5000,"Îòñëåæèâàíèå",ProgramName + " íå çàïóùåí","None",5)
    End If
End Sub

'---------------------------------------------------------
'Îòïðàâêà Tosat-óâåäîìëåíèÿ

'Âíåøíÿÿ ôóíêöèÿ âûçîâà óâåäîìëåíèÿ
' notifyIcon - Èêîíêà îêîëî íàçâàíèÿ ïðèëîæåíèÿ
' delayMs - Äëèòåëüíîñòü ïîêàçà óâåäîìëåíèÿ (Windows ìîæåò ýòî ïðîèãíîðèðîâàòü)
' title - Çàãîëîâîê óâåäîìëåíèÿ
' text - Òåêñò óâåäîìëåíèÿ
' tipIcon - Èêîíêà ëåâåå ñàìîãî óâåäîìëåíèÿ
' timeoutSec- Äëèòåëüíîñòü æèçíè ñêðèïòà, âûçûâàþùåãî óâåäîìëåíèå
Sub SendToast(notifyIcon, delayMs, title, text, tipIcon, timeoutSec)
    Dim PSPath, Cmd
    'Ôîðìèðóåì PS-ñêðèïò ðÿäîì ñ VBS-ñêðèïòîì
    PSPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, ".")) & "ps1"
    'Ôîðìèðóåì òåêñò PS-ñêðèïòà
    Call WritePSFile(PSPath, notifyIcon, delayMs, title, text, tipIcon, timeoutSec)
    'Ôîðìèðóåì êîìàíäó çàïóñêà PowerShell.exe ñ ñîçäàííûì PS-ñêðèïòîì
    Cmd = "cmd /c PowerShell.exe -STA -ExecutionPolicy Bypass -NoProfile -File """ & PSPath & """"
    'Çàïóñêàåì ãîòîâóþ êîìàíäó
    Shell.Run Cmd, 0, True
End Sub

'Ôîðìèðîâàíèå PS-ñêðèïòà äëÿ óâåäîìëåíèÿ
Sub WritePSFile(psPath, notifyIcon, delayMs, title, text, tipIcon, timeoutSec)
    Dim f
    Set f = FSO.CreateTextFile(psPath, True)
    f.WriteLine "Add-Type -AssemblyName System.Windows.Forms"
    f.WriteLine "Add-Type -AssemblyName System.Drawing"
    f.WriteLine ""
    f.WriteLine "$notify = New-Object System.Windows.Forms.NotifyIcon"
    f.WriteLine "$notify.Icon = [System.Drawing.SystemIcons]::" & notifyIcon
    f.WriteLine "$notify.Visible = $true"
    f.WriteLine ""
    f.WriteLine "$notify.ShowBalloonTip(" & delayMs & ", """ & EscapePS(title) & """, """ & EscapePS(text) & """, [System.Windows.Forms.ToolTipIcon]::" & tipIcon & ")"
    f.WriteLine ""
    f.WriteLine "[System.Windows.Forms.Application]::DoEvents()"
    f.WriteLine "Start-Sleep -Seconds " & timeoutSec
    f.WriteLine ""
    f.WriteLine "$notify.Dispose()"
    f.WriteLine "$self = $MyInvocation.MyCommand.Path"
    f.WriteLine "Start-Sleep -Milliseconds 200"
    f.WriteLine "Remove-Item -LiteralPath $self -Force"
    f.Close
End Sub

'Ôóíêöèÿ êîððåêòíîãî ôîðìàòèðîâàíèÿ ñòðîê â êîìàíäó PS
Function EscapePS(s)
    EscapePS = Replace(s, """", "`""")
End Function

'---------------------------------------------------------