Последние записи
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
23rd
Дек
Пишем HTML-приложение для мониторинга ресурсов Windows
Posted by Chas under Basic, Статьи
Однажды, в студеную зимнюю… заинтересовал меня вопрос мониторинга ресурсов Windows, а конкретно (хочется добавить «чисто» конкретно) мониторинга объема свободной памяти (физической и виртуальной), процента использования файла подкачки и загрузки процессоров.
автор: dab00
Казалось бы — ничего особенного — для этого существуют соответствующие классы WMI. Однако заинтересовал меня этот вопрос потому, что необходимо было реализовать «игру цветом», т.е. в случае уменьшения объема ресурса цвет индикатора должен был измениться на «более красный».
Итак. В этой статье я предлагаю Вам отправиться в увлекательное путешествие по изучению изменения цвета окна . Поехали? Открываем блокнот. Пишем HTA:
<head>
<title>ResMon</title>
<HTA:APPLICATION
ID = "ResMon"
APPLICATIONNAME="ResMon"
SINGLEINSTANCE="yes"
MAXIMIZEBUTTON = "no"
SCROLL="no"
ShowInTaskbar ="no"
BORDER="none"
Version = "1.0">
</HTA:APPLICATION>
</head>
<script language="VBScript">
Sub Window_OnLoad()
window.setTimeout "SetColor "&amp;amp; 0 &amp;amp; "," &amp;amp; 0 &amp;amp; "," &amp;amp; 255,1, "vbscript"
End Sub
'переводим число из RGB в Hex для HTML
Function GetStrHex(i)
If i < 16 Then
GetStrHex = "0" &amp;amp; Hex(i)
Else
GetStrHex = Hex(i)
End If
End Function
'рекурсивная процедура изменения цвета
Sub SetColor(x,y,z)
window.document.body.style.background = "#" &amp;amp; GetStrHex(x) &amp;amp; GetStrHex(y) &amp;amp; GetStrHex(z)
x = x + 1
z = z - 1
If z <> 0 Then window.setTimeout _
"SetColor " &amp;amp; x &amp;amp; "," &amp;amp; y &amp;amp; "," &amp;amp; z,5, "vbscript"
End Sub
</script>
<body></body>
</html>
Сохраняем, запускаем… Правда красиво? Кажется наше путешествие заканчивается, не успев начаться , а чтобы сделать его «увлекательным» я опишу алгоритм.
При загрузке окна мы запускаем рекурсивную процедуру изменения цвета SetColor, которая и выставляет цвет окна — window.document.body.style.backgrou nd используя функцию перевода RGB в Hex GetStrHex. Начинаем с 0,0,255 — «радикально синего» цвета . Далее, в процессе рекурсии, каждые 5 миллисекунд процедура SetColor добаляет «красного» — x = x + 1, и убавляет «синего» — z = z — 1, до тех пор, пока цвет окна не станет «радикально красным» — If z <> 0 Then.
А теперь давайте попробуем изменить палитру — начать с зеленого. Для этого достаточно изменить пару строчек:
window.setTimeout «SetColor «& 0 & «,» & 255 & «,» & 0,1, «vbscript» — чтобы начать с зеленого цвета,
и y = y — 1 вместо z = z — 1 — чтобы убавлять «зеленый».
Теперь, когда у нас есть алгоритм изменения цвета мы можем приступить к реализации алгоритма мониторинга целевых ресурсов.
Для мониторинга процента загрузки процессоров используем WMI-класс Win32_Processor, файла подкачки — Win32_PageFileUsage, свободной физической и виртуальной памяти — Win32_OperatingSystem, объема физической памяти — Win32_PhysicalMemory.
Открываем блокнот, пишем не более сложный чем прежде код:
<html>
<head>
<title>ResMon</title>
<HTA:APPLICATION
ID = "ResMon"
APPLICATIONNAME="ResMon"
SINGLEINSTANCE="yes"
MAXIMIZEBUTTON = "no"
SCROLL="no"
ShowInTaskbar ="no"
BORDER="none"
SELECTION="no"
Version = "1.0">
</HTA:APPLICATION>
</head>
<style type="text/css">
html, body{
margin:1px;
text-align: center;
font:bold 12 sans-serif;
border-style: outset;
color: #ffffff;
}
#menu{
background-color: #800000;
}
#closebtn{
position: absolute;
top: 1px;
right: 1px;
}
/* Цвета по умолчанию */
#pRAM,#swap{
background-color: #0000ff;
}
#vRAM,#proc{
background-color: #00ff00;
}
</style>
<script language="VBScript">
Option Explicit
Const strHash = "#"
'----- WMI-запросы -----
Const strOSQ = "Select FreePhysicalMemory, FreeVirtualMemory, TotalVirtualMemorySize From Win32_OperatingSystem"
Const strPMQ = "Select Capacity From Win32_PhysicalMemory"
Const strPFUQ = "Select AllocatedBaseSize, CurrentUsage From Win32_PageFileUsage"
Const strPQ = "Select LoadPercentage From Win32_Processor"
Const intPSF = 48 'флаг полусинхронности
'-----------------------
Dim objItem
Dim intTotal, intFreePart, intFreePartV, intFreePartP, intProcRate, intFreePartProc
Dim intOSInfoArr(2), intOSInfo
Dim intPFUInfoArr(1), intPFUInfo
Dim i
Dim objWMI, wshShell
Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
Set wshShell = CreateObject("WScript.Shell")
Sub Window_OnLoad()
'устанавливаем размер о позицию приложения
window.resizeTo 245,80
window.moveTo screen.availWidth-255, screen.availHeight-90
'устанавливаем обработку событий окна
SetUpEventHandler()
'устанавливаем заголовок приложения
header.Innertext = ResMon.APPLICATIONNAME
'запускаем процедуру обновления информации
window.setTimeout "UpdateInfo", 1, "vbscript"
End Sub
'----- Обработка событий окна приложения -----
Sub SetUpEventHandler()
Dim ClosebtnOnclick, MouseOverClose, MouseOutClose
'закрываем окно
Set ClosebtnOnclick = GetRef("OnClickCloseSub")
closebtn.attachEvent "onclick", ClosebtnOnclick
Set MouseOverClose = GetRef("MouseOverCloseSub")
closebtn.attachEvent "onmouseover", MouseOverClose
Set MouseOutClose = GetRef("MouseOutCloseSub")
closebtn.attachEvent "onmouseout", MouseOutClose
End Sub
'---------------------------------------------
'----- Закрыть -----
Sub OnClickCloseSub()
Window_OnUnload
End Sub
Sub MouseOverCloseSub()
closebtn.Style.Cursor = "hand"
closebtn.style.backgroundColor = "#ff8c00"
End Sub
Sub MouseOutCloseSub()
closebtn.style.backgroundColor = "#800000"
End Sub
'--------------------
Sub Window_OnUnload()
Set wshShell = Nothing
Set objWMI = Nothing
window.close
End Sub
Sub UpdateInfo()
'информация из Win32_OperatingSystem: свободная физическая память,
'свободная виртуальная память, полный объем виртуальной памяти
intOSInfo = GetOSInfo()
intTotal = GetTotalMemorySize() 'полный объем физической памяти
intPFUInfo = GetPFUInfo() 'информация о файле подкачки
intProcRate = GetProcRate() 'процент свободного времени процессоров
'процент свободных ресурсов в масштабе изменения RGB
intFreePart = Int(intOSInfo(0)/intTotal*255) 'физической
intFreePartV = Int(intOSInfo(1)/intOSInfo(2)*255) 'виртуальной
intFreePartP = Int(intPFUInfo(0)/intPFUInfo(1)*255) 'подкачки
intFreePartProc = Int(intProcRate*2.55) 'процессоры
'выводим количество ресурсов
fpRAM.Innertext = intOSInfo(0)
tpRAM.Innertext = intTotal
fvRAM.Innertext = intOSInfo(1)
tvRAM.Innertext = intOSInfo(2)
fswap.Innertext = intPFUInfo(0)
tswap.Innertext = intPFUInfo(1)
procrate.Innertext = intProcRate
'выставляем цвет окна: "#" + R + G + B, вариант от синего к красному
pRAM.style.backgroundColor = strHash &amp;amp; _
GetStrHex(255-intFreePart) &amp;amp; GetStrHex(0) &amp;amp; GetStrHex(intFreePart)
'вариант от зеленого к красному, прочие варианты - по аналогии
vRAM.style.backgroundColor = strHash &amp;amp; _
GetStrHex(255-intFreePartV) &amp;amp; GetStrHex(intFreePartV) &amp;amp; GetStrHex(0)
'снова от синего - подкачка
swap.style.backgroundColor = strHash &amp;amp; _
GetStrHex(255-intFreePartP) &amp;amp; GetStrHex(0) &amp;amp; GetStrHex(intFreePartP)
'снова от зеленого - процессор
proc.style.backgroundColor = strHash &amp;amp; _
GetStrHex(255-intFreePartProc) &amp;amp; GetStrHex(intFreePartProc) &amp;amp; GetStrHex(0)
'курим 1 секунду и вызываем сами себя :)
window.SetTimeout "UpdateInfo()", 1000, "vbscript"
End Sub
'получаем объем свободной памяти
Function GetOSInfo()
Dim colOS
Set colOS = objWMI.ExecQuery(strOSQ,,intPSF)
For Each objItem In colOS
With objItem
intOSInfoArr(0) = Int(.FreePhysicalMemory/1024)
intOSInfoArr(1) = Int(.FreeVirtualMemory/1024)
intOSInfoArr(2) = Int(.TotalVirtualMemorySize/1024)
End With
Next
Set colOS = Nothing
GetOSInfo = intOSInfoArr
End Function
'получаем объем физической памяти
Function GetTotalMemorySize()
Dim colPM
Set colPM = objWMI.ExecQuery(strPMQ,,intPSF)
For Each objItem In colPM
GetTotalMemorySize = GetTotalMemorySize + Int(objItem.Capacity/1024/1024)
Next
Set colPM = Nothing
End Function
'получаем объем файла подкачки
Function GetPFUInfo()
Dim colPFL
Set colPFL = objWMI.ExecQuery(strPFUQ,,intPSF)
For Each objItem In colPFL
With objItem
'свободно = объем - использовано
intPFUInfoArr(0) = .AllocatedBaseSize - .CurrentUsage
intPFUInfoArr(1) = .AllocatedBaseSize 'объем
End With
Next
Set colPFL = Nothing
GetPFUInfo = intPFUInfoArr
End Function
'получаем процент загрузки процессоров
Function GetProcRate()
Dim colP
Set colP = objWMI.ExecQuery(strPQ,,intPSF)
i = 0
For Each objItem In colP
i = i + 1
GetProcRate = GetProcRate + objItem.LoadPercentage
Next
'вычисляем среднее арифметическое на случай, если процессоров несколько
GetProcRate = 100-(GetProcRate/i)
Set colP = Nothing
End Function
'переводим число из RGB в Hex для HTML
Function GetStrHex(i)
If i < 16 Then
GetStrHex = "0" &amp;amp; Hex(i)
Else
GetStrHex = Hex(i)
End If
End Function
</script>
<body>
<div id="menu">
<span id="header"></span><span id="closebtn">X</span>
</div>
<div id="pRAM">
Физическая память:* <span id="fpRAM"></span>* из* <span id="tpRAM"></span>* MB
</div>
<div id="vRAM">
Виртуальная память:* <span id="fvRAM"></span>* из* <span id="tvRAM"></span>* MB
</div>
<div id="swap">
Файл подкачки:* <span id="fswap"></span>* из* <span id="tswap"></span>* MB
</div>
<div id="proc">
Процессоры:* <span id="procrate"></span>* из 100%
</div>
</body>
</html>
При загрузке приложение принимает необходимый размер, выставляется в нужную позицию, устанавливает обработку события нажатия на кнопку закрытия окна и запускает рекурсивную процедуру обновления информации о целевых ресурсах UpdateInfo, которая, в свою очередь, раз в секунду выполняет WMI-запросы к заявленным выше WMI-классам и обновляет информацию окна HTA.
Сохраняем, запускаем… Вуаля.
В развитие разработки, с помощью библиотеки DAHTACOM можно установить позицию окна приложения «поверх всех», закинуть иконку приложения в область уведомлений, использовать PNG-изображение с альфа-каналом в качестве «корпуса» окна HTA… Но это уже совсем другая история…
В завершение нашего «путешествия» хочу обратить Ваше внимание на то, что для запуска полученного в результате приложения, а чисто конкретно (давно собирался использовать этот речевой оборот) для подключения к службе WMI необходимо обладать правами администратора.
Что получилось — на скриншоте и во вложении.
 |
ResMon-v1.0.ZIP (3.8 Кб) |
Случайные статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)
