Заинтересовала тема обработки событий окна - onmouseover, onkeydown и пр. - на VBS - у автора реализовано на JS.
Следующая реинкарнация кода:
<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 = "#"
Const strHeader = "Объем свободных ресурсов"
Const strDll = "WinPos.dll"
'--- запросы
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, intRet
Dim objWMI, wshShell
Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
Set wshShell = CreateObject("WScript.Shell")
Sub Window_OnLoad()
Dim objSetTop
window.resizeTo 245,80
window.moveTo screen.availWidth-255, screen.availHeight-90
'устанавливаем обработку событий
SetUpEventHandler()
'пытаемся зарегистрировать библиотеку
intRet = RegLib(True)
If intRet Then
'создаем экземпляр класса из либы = strDll
Set objSetTop = CreateObject("WinPos.WPClass")
'делаем окно поверх всех окон
objSetTop.SetTop document.title
'удаляем ссылку
Set objSetTop = Nothing
Else
wshShell.PopUp "Не удалось зарегистрировать библиотеку " & strDll,1,"Ошибка регистрации",48
End If
'заголовок приложения
header.Innertext = strHeader
window.setTimeout "UpdateInfo", 1, "vbscript"
End Sub
'***************** Обработка событий окна приложения *****************
Sub SetUpEventHandler()
Dim ClosebtnOnclick, MouseOverClose, OnKeydownEvent
Set ClosebtnOnclick = GetRef("OnClickCloseSub")
closebtn.attachEvent "onclick", ClosebtnOnclick
Set MouseOverClose = GetRef("MouseOverCloseSub")
closebtn.attachEvent "onmouseover", MouseOverClose
Set OnKeydownEvent = GetRef("MoveWindow")
document.attachEvent "onkeydown", OnKeydownEvent
End Sub
Sub OnClickCloseSub
'window.close
Window_OnUnload
End Sub
Sub MouseOverCloseSub
closebtn.Style.Cursor = "hand"
End Sub
Sub MoveWindow()
Dim z
'ловим нажатие на Ctrl
If window.event.ctrlKey Then
'двигаем окно
If window.event.keyCode=37 Then
z = window.screenTop
window.moveTo window.screenLeft-10,z
ElseIf window.event.keyCode=39 Then
z = window.screenTop
window.moveTo window.screenLeft+10,z
ElseIf window.event.keyCode=38 Then
z = window.screenLeft
window.moveTo z,window.screenTop-10
ElseIf window.event.keyCode=40 Then
z = window.screenLeft
window.moveTo z,window.screenTop+10
End If
End If
End Sub
'***********************************************************************
Sub Window_OnUnload()
intRet = RegLib(False)
Set wshShell = Nothing
Set objWMI = Nothing
window.close
End Sub
Sub UpdateInfo()
'информация из Win32_OperatingSystem: свободная физическая память,
'свободная виртуальная память, полный объем виртуальной памяти
intOSInfo = GetOSInfo()
intTotal = GetTotalMemorySize() 'полный объем физической памяти
intPFUInfo = GetPFUInfo() 'информация о файле подкачки
intProcRate = GetProcRate() 'процент свободного времени процессоров
'процент свободной памяти в масштабе изменения RGB
intFreePart = Round(intOSInfo(0)/intTotal*255) 'физической
intFreePartV = Round(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, вариант от синего к красному
window.document.getElementById("pRAM").style.backgroundColor = strHash & _
GetStrHex(255-intFreePart) & GetStrHex(0) & GetStrHex(intFreePart)
'вариант от зеленого к красному, прочие варианты - по аналогии
window.document.getElementById("vRAM").style.backgroundColor = strHash & _
GetStrHex(255-intFreePartV) & GetStrHex(intFreePartV) & GetStrHex(0)
'снова от синего - подкачка
window.document.getElementById("swap").style.backgroundColor = strHash & _
GetStrHex(255-intFreePartP) & GetStrHex(0) & GetStrHex(intFreePartP)
'снова от зеленого - процессор
window.document.getElementById("proc").style.backgroundColor = strHash & _
GetStrHex(255-intFreePartProc) & GetStrHex(intFreePartProc) & GetStrHex(0)
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) = Round(.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" & Hex(i)
Else
GetStrHex = Hex(i)
End If
End Function
'регистрация библиотеки, True - регистрируем, False - разрегистрируем
Function RegLib(bWha)
Dim strWha
If bWha Then
strWha = "regsvr32.exe /i /s "
Else
strWha = "regsvr32.exe u/ /i /s "
End If
'MsgBox "qwe"
intRet = wshShell.Run(strWha & strDll )
If intRet = 0 Then 'если удалось зарегистрировать - True
RegLib = True
Else
RegLib = False
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>Добавил крестик для завершения работы приложения. При наведении мыши на крестик изменяется курсор.
Кроме того Ctrl+стрелки перемещают окно по экрану. Приятные мелочи 
.
Не знаю как запустить процесс мониторинга в отдельном потоке, чтобы не подтормаживали манипуляции с окном.
Если ловить события через __InstanceCreationEvent - бесконечный цикл, тоже все висит.
Как-нибудь расставить приоритеты, чтобы код для манипуляций с интерфейсом был "круче", чем прочий.
Может снова через API как-нибудь можно сообразить?
Надеюсь кому-нибудь это интересно, а то похоже, что я тут сам с собой
