Тема: WSH,VBS,JS: VB.NET (Framework) интерактивное оповещение в трее
Программа создавалась для темы
https://forum.script-coding.com/viewtop … 63#p163063
Для оповещения слежения :
"Дисковое пространство", во время сбоя, или исправления его
Для слежения свободной/занятой памяти при защите uwfmgr.exe
При этом, было желание, сделать программу exe , такую, что бы в неё, можно было посылать
оповещения от VBS скрипта, т.к. он быстро исправляемый и не подлежит компиляции.
Основная проблема было подружить, разные языки. А из-за того что у VBS все данные имеют тип variant, то все объекты которые засылались из VBS в exe Framework-а не виделись.
Основа программы для трея был взят VBS скрипт.
https://forum.script-coding.com/viewtop … 57#p163057
Скрипт, полностью мной был пересобран. И отделён от VBS фалов и VB.NET файлов.
Компилирование exe , с помощью ком строки.
1
файл Program.vb
Option Explicit
'--------------------------------------
'-- это атрибутика подкачки библиотек
'--------------------------------------
Imports System.Windows.Forms
Imports System.Management
Imports System.IO
Imports System
Imports Microsoft.VisualBasic
Imports System.Timers
Module Program
Public Const A_2 As String = "A_2" '"Время_отображения_текста" '-моргание
Public Const A_3 As String = "A_3" '"Отображать\скрывать"
Public Const A_4 As String = "A_4" '"Путь_к_картинки"
Public Const A_5 As String = "A_5" '"Текст_процесса"
Public Const A_6 As String = "A_6" '"Текст_результата"
Public checkProcessTimer_ As System.Timers.Timer
Public checkProcessTimer As System.Timers.Timer
Public Timer_Scaner_ as integer= 60000 '--- 1 минута или 60 секунд
Public NewTimer_ as integer=3000 '--- 40 секунд
Public NewBalloon_ as integer=0
Public NewVisible_ as Byte=1
Public NewPathIcon_ as String=Path.GetDirectoryName(Application.ExecutablePath) & "\start.ico"
Public NewProcess_ as String="СЛЕЖЕНИЕ"
Public NewMessage_ as String="запущено"
Public name_ as String = "storage"
Public x_ as Byte = 0
'--------------------------------------
'-- процедура для поиска hwnd проги
'--------------------------------------
Function GetScriptProcessId(scriptPath As String, x As String) As Integer
Dim query As String = "SELECT ProcessId, CommandLine FROM Win32_Process WHERE Name ='" & x & "'"
Dim searcher As New ManagementObjectSearcher(query)
For Each proc As ManagementObject In searcher.Get()
Dim cmd As String = proc("CommandLine")
If Not cmd Is Nothing Then
cmd = cmd.ToLower()
If cmd.Contains(scriptPath.ToLower()) Then
Return Convert.ToInt32(proc("ProcessId"))
End If
End If
Next
Return -1
End Function
'--------------------------------------
'-- запуск модуля всегда будет с Main, как и в VB6
'--------------------------------------
Sub Main()
Application.EnableVisualStyles()
Application.SetCompatibleTextRenderingDefault(False)
checkProcessTimer_ = New System.Timers.Timer(Timer_Scaner_)
AddHandler checkProcessTimer_.Elapsed, AddressOf CheckParentProcess_Global
checkProcessTimer_.Start()
'--------------------------------------
'-- Получение номера процеса выполняющей проги
'-- для того что бы его использовать в классе, для закрытия проги по меню
'--------------------------------------
Dim scriptPath As String = Application.ExecutablePath
Dim fi As New IO.FileInfo(scriptPath)
Dim pid As Integer = GetScriptProcessId(scriptPath,fi.Name)
If pid = -1 Then
MessageBox.Show("Could not find process for: " & scriptPath)
Return
End If
'--------------------------------------
'-- объявление внутри себя библиотеки
'-- Это объявление библиотеки запускается с аргументами
'--------------------------------------
Dim trayApp As New TrayApp(pid)
'--------------------------------------
'-- запуск себя
'--------------------------------------
Application.Run()
End Sub
'===программа выполнения по таймеру опроса проводника и ======================
' - перебор объекта Dictionsry с чтением в нём всех параметров
'--------------------------------------
Private Sub CheckParentProcess_Global(sender As Object, e As ElapsedEventArgs)
Dim ShellWindow as Object
Dim ShellWindows as Object = CreateObject("Shell.Application").Windows
For Each ShellWindow in ShellWindows
if Instr(1,ShellWindow.StatusText,name_) = 1 Then
NewBalloon_ = Cint(ShellWindow.GetProperty(A_2))
if NewVisible_=1 then
NewVisible_ = Cbyte(ShellWindow.GetProperty(A_3))
end if
NewPathIcon_ = CStr(ShellWindow.GetProperty(A_4))
NewProcess_ = CStr(ShellWindow.GetProperty(A_5))
NewMessage_ = CStr(ShellWindow.GetProperty(A_6))
x_=0
Exit Sub
end if
Next
End Sub
'===============================
End Module
2
файл TrayApp.vb
Imports System
Imports System.Drawing
Imports System.IO
Imports System.Windows.Forms
Imports System.Diagnostics
Imports System.Timers
Imports Microsoft.VisualBasic
'-------------------------
'- объявляется класс
'-------------------------
Public Class TrayApp
'-------------------------
'- назначаем имя переменной для hwnd этой проги
'-------------------------
Private parentPID As Integer
'-------------------------
'- назначаем имя переменной для отслеживания каталога
'-------------------------
Private fileWatcher As FileSystemWatcher
'-------------------------
'- назначаем имя объекту иконки, которая будет появляться как иконка программы
'- которую мы потом будем по желанию програмно менять
'-------------------------
Private trayIcon As NotifyIcon
'-------------------------
'- назначаем имя объекту меню, которое будет появляться после
'-щёлкания по иконке проги правкнп мышии
'-------------------------
Private trayMenu As ContextMenuStrip
'-------------------------
'- назначаем имя таймеру который будет по времени опрашивать "проводник"
'-------------------------
' Private checkProcessTimer As System.Timers.Timer
'-------------------------
'-------------------------
'- Эту процедуру я закоментировал. Она будет вам показывать как для этой проги можно посылать аргумены
'- сами аргументы прописаны в файле program.vb, при команде run
'- в моём варианте мы запускаем прогу без аргументов
'- процедура NEW всегда запускается когда идёт выполнение класса. При этом ЭТО класс
'- а класс всегда при объявлении его запускает именно эту процедуру
'-------------------------
' Public Sub New(vbsFullPath As String, pid As Integer)
'-------------------------
'- запуск класса с одним аргументом аргументом, это hwnd проги
'-------------------------
Public Sub New(pid As Integer)
'-------------------------
'- сразу передаём этот hwnd проги в переменную
'-------------------------
parentPID = pid
'-------------------------
'- назначение переменной для меню
'- и с разу же назначения имён самих меню
'- и прикрепление к ним имена процедур при выполнении этих меню
'-------------------------
trayMenu = New ContextMenuStrip()
trayMenu.Items.Add("Что было", Nothing, AddressOf ShowLog)
trayMenu.Items.Add("Выход", Nothing, AddressOf ExitApp)
'-------------------------
'- назначение переменной для иконки
'- и тут же назначение переменной для пока надписи когда на неё будет наведена мыша
'-------------------------
trayIcon = New NotifyIcon()
trayIcon.Text = NewProcess_
'-------------------------
'- назначение переменной иконки из файла
'- при этом сам файл может быть огромный по размеру и по формату
'- внутреннии функции её сами обрежут до нужнго размера и формата
'- разрешается слать файлы любых форматов картинок/фоток
'---путь к картинке и саму картинку мы будем менять програмно
'-------------------------
Dim bmp as System.Drawing.Bitmap= System.Drawing.Image.FromFile(NewPathIcon_, true)
Dim hitcon as Integer = bmp.GetHicon()
Dim ico as System.Drawing.Icon = System.Drawing.Icon.FromHandle(hitcon)
trayIcon.Icon = ico
'-------------------------
'- если вы будите слать только иконки(файл *.ico), то напишите только так
'-------------------------
' trayIcon.Icon = New System.Drawing.Icon("Y:\111\1.ico")
'-------------------------
'-------------------------
'- назначение меню на нажатие на иконку
'-------------------------
trayIcon.ContextMenuStrip = trayMenu
trayIcon.Visible = True
'-------------------------
'- назначение исполнительной процедуры по 2-ойму клику мыши на иконку
'-------------------------
AddHandler trayIcon.DoubleClick, AddressOf OnTrayIconDoubleClick
'-------------------------
'-------------------------
'- назначение перемееной на таймере с его установленным временем
'-------------------------
checkProcessTimer = New System.Timers.Timer(NewTimer_)
'-------------------------
'- назначение срабатывания процедуры при окончания таймера по врмени
'-------------------------
AddHandler checkProcessTimer.Elapsed, AddressOf CheckParentProcess
checkProcessTimer.Start()
'-------------------------
'- конец стартовой процедуре
'-------------------------
End Sub
'-------------------------
'-------------------------
'- меню "Что было"
'-------------------------
Private Sub ShowLog(sender As Object, e As EventArgs)
if NewProcess_<>"" and NewMessage_<> "" then
trayIcon.BalloonTipTitle = NewProcess_
trayIcon.BalloonTipText = NewMessage_
trayIcon.ShowBalloonTip(NewBalloon_)
end if
End Sub
'-------------------------
'- сама исполнительная процедура при нажатии на меню "Выход"
'-------------------------
Private Sub ExitApp(sender As Object, e As EventArgs)
Try
Dim parentProc As Process = Process.GetProcessById(parentPID)
parentProc.Kill()
Catch ex As Exception
End Try
trayIcon.Visible = False
' If fileWatcher IsNot Nothing Then fileWatcher.EnableRaisingEvents = False
If checkProcessTimer IsNot Nothing Then checkProcessTimer.Stop()
Application.Exit()
End Sub
'-------------------------
'-------------------------
'-Процедура по двойному клику по иконке------------------
'- Изменяет ключ по отключению появления мессяг и наоборот
'-------------------------
Private Sub OnTrayIconDoubleClick(sender As Object, e As EventArgs)
If NewVisible_=1 then
NewVisible_=0
x_=3
trayIcon.Icon = New System.Drawing.Icon(Path.GetDirectoryName(Application.ExecutablePath) & "\stop.ico")
ElseIf NewVisible_=0 then
NewVisible_=1
x_=0
trayIcon.Icon = New System.Drawing.Icon(Path.GetDirectoryName(Application.ExecutablePath) & "\start.ico")
end if
End Sub
'-------------------------
'-------------------------
'-Процедура по выполнению по времени по таймеру------------------
'-------------------------
Private Sub CheckParentProcess(sender As Object, e As ElapsedEventArgs)
Try
if x_< 3 then
If NewVisible_=1 then
trayIcon.Icon = New System.Drawing.Icon(NewPathIcon_)
trayIcon.BalloonTipTitle = NewProcess_
trayIcon.BalloonTipText = NewMessage_
trayIcon.ShowBalloonTip(NewBalloon_)
end if
x_ = x_ + 1
end if
' Threading.Thread.Sleep(1000)
Catch ex As Exception
End Try
End Sub
End Class
3
ком строка запуск от админа для компиляции VB.NET
cd /d Полный_путь_где_лежат_все_файлы
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727\vbc.exe" /target:winexe /reference:System.Management.dll /out:"TrayApp.exe" "Program.vb" "TrayApp.vb"
Строка в одну строчку, никаких переносов не должно быть.
Применил сборку версии 2.0 Framework
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727\vbc.exe"
Вы можете поменять на свою версию.
Я компилировал от 2.0 до 4.0 никаких ошибок нет.
.. Можете запусктить прогу сразу. Она появиться в трее. В каталоге где лежат файлы есть ещё
3-и иконки, для отображения состояния. Иконки также могут динамически меняться в зависимости от оповещения, через VBS.
При запуске, прога сразу оповестит что запущен сканер оповещения. И будет ожидать послания.
В скриптах vb все подписаны процедуры и данные... например время оповещения, и время сканирования сервера "проводник".
Вся связь, от VBS до VB.NET (ехе), осуществляется через "проводник".
Скрип для связи взят и переделан от сюда-->
https://forum.script-coding.com/viewtop … 34#p162734
4
Сам файл VBS start.vbs
Option Explicit
'=========== запуск от админа скрипта
'dim ObjShell,WshShell
'Set WshShell = WScript.CreateObject("WScript.Shell")
'If WScript.Arguments.Length = 0 Then
' Set ObjShell = CreateObject("Shell.Application")
' ObjShell.ShellExecute "wscript.exe" _
' , """" & WScript.ScriptFullName & """ RunAsAdministrator", , "runas", 1
' WScript.Quit
'End if
' ===================================================================
Const NameApp_ = "TrayApp.exe"
Const A_2 = "A_2" '"Время_отображения_текста" '-моргание
Const A_3 = "A_3" '"Отображать\скрывать"
Const A_4 = "A_4" '"Путь_к_картинки"
Const A_5 = "A_5" '"Текст_процесса"
Const A_6 = "A_6" '"Текст_результата"
Dim B_2, B_3, B_4, B_5, B_6
Dim name_ :name_= "storage"
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
B_2 = 100 ' -- по умолчанию - моргание
B_3 = 1 '-- 1-видно/0 - не видно
B_4 = fso.GetFile(WScript.ScriptFullName).ParentFolder & "\alarm.ico" '-- локальный путь
B_5 = "Поцесс такой то" '-- результат какого процесса будет отображаться
B_6 = "Результат процесса такой то" '-- отображение результата
WScript.Sleep 100
OpenContainer name_
Dim ShellWindow, ShellWindows
Sub OpenContainer(name)
Set ShellWindows = CreateObject("Shell.Application").Windows
For Each ShellWindow in ShellWindows
if Instr(1,ShellWindow.StatusText,name) = 1 Then
ShellWindow.PutProperty A_2 , B_2
ShellWindow.PutProperty A_3 , B_3
ShellWindow.PutProperty A_4 , B_4
ShellWindow.PutProperty A_5 , B_5
ShellWindow.PutProperty A_6 , B_6
Exit Sub
end if
Next
Set ShellWindows = nothing
WScript.Sleep 100
Set ShellWindows = GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}")
ShellWindows.StatusText = name
ShellWindows.PutProperty A_2 , B_2
ShellWindows.PutProperty A_3 , B_3
ShellWindows.PutProperty A_4 , B_4
ShellWindows.PutProperty A_5 , B_5
ShellWindows.PutProperty A_6 , B_6
End Sub
WScript.Sleep 1000
'----------------------
Dim sTrayExePath: sTrayExePath = fso.GetFile(WScript.ScriptFullName).ParentFolder & "\" & NameApp_ & ""
If fso.FileExists(sTrayExePath) Then
if GrtProcess_(NameApp_)=false then
Dim shell: Set shell = CreateObject("WScript.Shell")
shell.Run """" & sTrayExePath & """" , 0, False
End If
else
WScript.echo "Файла " & NameApp_ & " нет"
End If
'-------GET PROCESS запущен ли ЕХЕ файл? ---------------
Function GrtProcess_(Byval Myapp_)
Dim objWMIService, objProcessList, objProcess
Dim strComputer
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objProcessList = objWMIService.ExecQuery("Select * from Win32_Process")
For Each objProcess In objProcessList
If LCase(objProcess.Name) = LCase(Myapp_) Then
GrtProcess_= True
Exit For
else
GrtProcess_= False
End If
Next
End function
В этот код добавляются процессы для слежения. В переменную
B_4 = fso.GetFile(WScript.ScriptFullName).ParentFolder & "\alarm.ico" '-- локальный путь
B_5 = "Поцесс такой то" '-- результат какого процесса будет отображаться
B_6 = "Результат процесса такой то" '-- отображение результата
передаются данные от слежения, + иконка, которая должна сфокусировать внимание юзера.
Само оповещение , моргает 3 раза. Потом замолкает. Но по клику exe правой конпкой мыши появляется меню "Что было" и "Выход". При нажатии на "Выход" , прога закрывается.
Но она может запуститься от VBS, который отслеживает, запущенна ли эта прога или нет. Если нет, то запускает её. Я собираюсь эту VBS поместить в плнировщик задач, который будет запускать этот VBS по времени. А т.к. я могу в срипте менять сразу что угодно, то оповещение сразу будет реагировать на изменения параметров.
По умолчанию, я выбрал сканер "проводника",
Timer_Scaner_ as integer= 60000 '--- 1 минута или 60 секунд
и сканер внутреннего оповещателя в exe
NewTimer_ as integer=3000 '--- 3 секунды
Вы можете все временные и другие параметры поменять на свои.
Что ещё?
Если нажать на exe левой кнопкой мыши 2-а раза, то поменяется иконка, свидетельствующая о том, что прога умолкает , но сканирует. Она просто молчит и не треводит юзера. При повторном 2-ом нажатии прога опять просыпается, и продолжает напоминать юзеру.
Этот напоминальщик, можно употребить например для будильника.
Меню "Что было". Служит на тот момент, когда юзер заставил прогу заснуть, а процессы продолжались. Тогда при нажатии этого меню, будет появляться то что было послений раз при сканировании. В принципе можно замутить и запись лога, всех напоминлок и просмотр по этому меню их всех , которые были во время сна проги.
В RAR файле выкладываю все файлы. Кроме exe , вы сами его скомпилируете.
Принцип работы прост.
При загрузки вина запускается процесс в планировщике VBS. Скрипт, проверяет, запущена ли exe , Если да то не запускает её, если нет, то запускает её вкаталоге где находиться сам VBS скрипт. Там же лежать иконки, которые цепляются скриптом и exe.
Иконки можете класть любые и в VBS их менять. Они будут отправляться в exe.
Под иконки, можно применять и файлы огромные jpg. Прога exe сама их уменьшит и превратит в иконку. Хоть фотку, проге пофиг. Т.к. планировщик, будет заточен на зупуск, по времени, то по времени будет запускаться VBS делать свои сканирующие прогоны, и выдадвать результат в exe через "проводник". Проводник в данном случае служит как "сервер" пересылщик между VBS и VB.NET
В файле install.txt код который вставляется в терминал ком строки.
При перезагрузки "проводника", через "диспетчер задач", проводник очищается от всех данных. Как будто вы только что вошли в вин.
И ещё. Для отображения кирилицы в сообщениях, сохраняйте все файлы скриптов в ANSI кодировке.
