Тема: VBScript: создание иконки в системном трее
Пример отслеживает запуск нового процесса с формированием иконки в трее.
Потребуется библиотека dynwrap.dll.
'------------------------------------------------------------------------------------------
'--------------------------------- Создание класса структуры ----------------------
'------------------------------------------------------------------------------------------
Class Struct
'-----------------------------------------------------------------------------------------
Private RtlMoveMemory_Call, _
lstrcat_Call, _
HeapAlloc_Call, _
GetProcessHeap_Call, _
HeapFree_Call
Private hHeap,init
'-----------------------------------------------------------------------------------------
Public iOfs
'-----------------------------------------------------------------------------------------
Private Sub Class_Initialize 'Запуск класса
'---------------------------------------------------------------------------------
Set RtlMoveMemory_Call =CreateObject("DynamicWrapper")
RtlMoveMemory_Call.Register "kernel32.dll","RtlMoveMemory","f=s","i=lll","r=l"
'---------------------------------------------------------------------------------
Set lstrcat_Call =CreateObject("DynamicWrapper")
lstrcat_Call.Register "kernel32.dll","lstrcat","f=s","i=ws","r=l"
'---------------------------------------------------------------------------------
Set HeapAlloc_Call =CreateObject("DynamicWrapper")
HeapAlloc_Call.Register "KERNEL32.DLL","HeapAlloc","f=s","i=lll","r=l"
'---------------------------------------------------------------------------------
Set GetProcessHeap_Call =CreateObject("DynamicWrapper")
GetProcessHeap_Call.Register "KERNEL32.DLL","GetProcessHeap","f=s","r=l"
'---------------------------------------------------------------------------------
Set HeapFree_Call =CreateObject("DynamicWrapper")
HeapFree_Call.Register "KERNEL32.DLL","HeapFree","f=s","i=lll","r=l"
'---------------------------------------------------------------------------------
'Локализация кучи
hHeap=GetProcessHeap_Call.GetProcessHeap()
End Sub
'-----------------------------------------------------------------------------------------
Private Sub Class_Terminate 'Уничтожение класса
HeapFree_Call.HeapFree hHeap,0,init
End Sub
'-----------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------
'[Инициализация структуры]
Public Sub initStruct(structSize)
'Локализация структуры
init=HeapAlloc_Call.HeapAlloc(hHeap,0,structSize)
End Sub
'-----------------------------------------------------------------------------------------
'[Возврат базового адреса]
Public Property Get baseAddr
'Базовый адрес
baseAddr=init
End Property
'-----------------------------------------------------------------------------------------
'*[Добавление dword данных в структуру]
Public Function SetDataDWORD(Data)
Dim lW,hW,ConvertedData
hW=Fix(Data/65536)
lW=Data mod 65536
ConvertedData=ChrW(lW) & ChrW(hW)
RtlMoveMemory_Call.RtlMovememory init+iOfs,GetBSTRPtr(ConvertedData),4
iOfs=iOfs+4
End Function
'-----------------------------------------------------------------------------------------
'*[Добавление текстовых данных в структуру]
Public Function SetDataTEXT(iSize,Data)
RtlMoveMemory_Call.RtlMovememory init+iOfs,GetBSTRPtr(Data),iSize
iOfs=iOfs+iSize
End Function
'-----------------------------------------------------------------------------------------
'*[Получение локального указателя добавляемых данных]
Public Function GetBSTRPtr(ByRef sData)
Dim pSource
Dim pDest
pSource=lstrcat_Call.lstrcat(sData,"")
pDest=lstrcat_Call.lstrcat(GetBSTRPtr,"")
GetBSTRPtr=CLng(GetBSTRPtr)
RtlMoveMemory_Call.RtlMovememory pDest+8,pSource+8,4
End Function
'-----------------------------------------------------------------------------------------
End Class
'------------------------------------------------------------------------------------------
'--------------------------------- Создание класса трей иконки---------------------
'------------------------------------------------------------------------------------------
Const NIM_ADD =0
Const NIM_DELETE =2
Const NIF_ICON =2
Const NIF_TIP =4
Const NIF_MESSAGE =1
Const IMAGE_ICON =1
Const WM_SHELLNOTIFY =&H405
'-----------------------------------------------------------------------------------------
Class TrayIcon
Private Shell_NotifyIcon_Call
Private NOTIFYICONDATA
'-----------------------------------------------------------------------------------------
Private Sub Class_Initialize
Set NOTIFYICONDATA=new Struct
NOTIFYICONDATA.initStruct(88)
'----------------------------------------------------------------------------------
Set Shell_NotifyIcon_Call =CreateObject("DynamicWrapper")
Shell_NotifyIcon_Call.Register "SHELL32.dll","Shell_NotifyIcon","f=s","i=ll","r=l"
'----------------------------------------------------------------------------------
Set CreateWindowExA_CALL =CreateObject("DynamicWrapper")
CreateWindowExA_CALL.Register "USER32.DLL","CreateWindowExA", _
"i=lsslllllllll","f=s","r=h"
'----------------------------------------------------------------------------------
hwnd=CreateWindowExA_CALL.CreateWindowExA( 0, _
"#32770", _
"", _
0, _
0,0,0,0, _
0,0,0,0)
'----------------------------------------------------------------------------------
ToolTip="Process Scan is activated..." 'Текст подсказки
ShIndex=147 'Индекс иконки в SHELL32.DLL
'----------------------------------------------------------------------------------
Set LoadLibraryA_Call =CreateObject("DynamicWrapper")
LoadLibraryA_Call.Register "KERNEL32.DLL","LoadLibraryA","i=s","f=s","r=l"
hLib=LoadLibraryA_Call.LoadLibraryA("SHELL32.DLL")
'----------------------------------------------------------------------------------
Set LoadImageA_Call =CreateObject("DynamicWrapper")
LoadImageA_Call.Register "USER32.DLL","LoadImageA","i=llllll","f=s","r=l"
hIcon=LoadImageA_Call.LoadImageA(hLib,ShIndex,IMAGE_ICON,16,16,0)
'----------------------------------------------------------------------------------
iOfs=0
With NOTIFYICONDATA
.SetDataDWORD 88 'Размер структуры
.SetDataDWORD hwnd 'Дескриптор окна
.SetDataDWORD 23 'Идентификатор иконки
.SetDataDWORD NIF_TIP+NIF_ICON+NIF_MESSAGE 'Флаги отображения
.SetDataDWORD WM_SHELLNOTIFY 'Сообщение реакции
.SetDataDWORD hIcon 'Дескриптор иконки
'----------------------------------------------------------------------------------
'Формирование массива для текста подсказки
For i=1 To Len(ToolTip)+1
.SetDataTEXT 1,Mid(ToolTip,i,1)
Next
End With
'----------------------------------------------------------------------------------
Shell_NotifyIcon_Call.Shell_NotifyIcon NIM_ADD,NOTIFYICONDATA.baseAddr
End Sub
'------------------------------------------------------------------------------------------
Private Sub Class_Terminate
Shell_NotifyIcon_Call.Shell_NotifyIcon NIM_DELETE,NOTIFYICONDATA.baseAddr
End Sub
'------------------------------------------------------------------------------------------
End Class
'------------------------------------------------------------------------------------------
'------------- Обработчик событий объекта WbemAsyncHandler -----------------
'------------------------------------------------------------------------------------------
Function AsyncEvent_OnObjectReady(EventNotifier,EventValueSet)
iQuest=MsgBox( "Обнаружен запуск процесса:" & vbCR & vbCR & _
EventNotifier.GetObjectText_() & vbCR & vbCR & _
"Продолжить осмотр?", _
vbYesNo+vbQuestion,"Обнаружен запуск процесса")
If iQuest=vbNo then
Set Tray=Nothing
WScript.Quit(0)
End If
End Function
'------------------------------------------------------------------------------------------
'-------------- Общие инструкции ----------------------------------------------------
'------------------------------------------------------------------------------------------
Set Tray=New TrayIcon
'------------------------------------------------------------------------------------------
WScript.Sleep(500)
Set WbemService =GetObject( _
"winmgmts:{authenticationLevel=pktPrivacy," & _
"impersonationLevel=Impersonate}!\\.\Root\CIMV2")
Set WbemAsyncHandler =WScript.CreateObject( _
"WbemScripting.SWbemSink","AsyncEvent_")
EventSource =WbemService.ExecNotificationQueryAsync( _
WbemAsyncHandler, _
"SELECT * FROM __InstanceCreationEvent" & _
" WITHIN 5 WHERE TargetInstance ISA 'Win32_Process'")
WScript.Sleep(500)
'------------------------------------------------------------------------------------------
While 1
WScript.Sleep(1000)
Wend
Дополнительные источники:
http://forum.codenet.ru/showthread.php?t=10401
http://forums.hardlabs.net/index.php?sh … e=threaded
http://www.wasm.ru/print.php?article=1001023
Автор примера - Poltergeyst.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.