<?xml version="1.0" encoding="utf-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
	<channel>
		<title><![CDATA[Серый форум &mdash; VBScript: создание иконки в системном трее]]></title>
		<link>https://forum.script-coding.com/viewtopic.php?id=1444</link>
		<atom:link href="https://forum.script-coding.com/extern.php?action=feed&amp;tid=1444&amp;type=rss" rel="self" type="application/rss+xml" />
		<description><![CDATA[Недавние сообщения в теме «VBScript: создание иконки в системном трее».]]></description>
		<lastBuildDate>Sun, 25 May 2008 16:32:32 +0000</lastBuildDate>
		<generator>PunBB</generator>
		<item>
			<title><![CDATA[Re: VBScript: создание иконки в системном трее]]></title>
			<link>https://forum.script-coding.com/viewtopic.php?pid=11062#p11062</link>
			<description><![CDATA[<p>Развитие предыдущего примера, скрипт находится во вложении этого поста.<br />Потребуется установленный <a href="http://www.script-coding.com/LangMF.html">LangMF 7.7</a>, см. комментарии в коде скрипта.<br />Скрипт предназначен для отслеживания нескольких событий WMI в асинхронном режиме с формированием иконок в трее, каждая из которых соответствует своему потоку отслеживания. По мере обнаружения событий осуществляется изменение всплывающего комментария к соответствующей иконке и запись протоколов в каталоге скрипта. Для остановки отслеживания и просмотра статистики используйте контекстное меню трей-иконок.<br />Отличается от предыдущего улучшенной работой с иконками в трее: теперь у иконок есть контекстное меню.<br />Автор примера - <strong>Poltergeyst</strong>.</p>]]></description>
			<author><![CDATA[null@example.com (The gray Cardinal)]]></author>
			<pubDate>Sun, 25 May 2008 16:32:32 +0000</pubDate>
			<guid>https://forum.script-coding.com/viewtopic.php?pid=11062#p11062</guid>
		</item>
		<item>
			<title><![CDATA[Re: VBScript: создание иконки в системном трее]]></title>
			<link>https://forum.script-coding.com/viewtopic.php?pid=10882#p10882</link>
			<description><![CDATA[<p>Развитие предыдущего примера.<br />Потребуются библиотеки <a href="http://www.script-coding.com/dynwrap.html">dynwrap.dll</a> и <a href="http://www.script-coding.com/AutiItX.html">AutoItX3.dll</a>.<br />Скрипт отслеживает несколько событий WMI в асинхронном режиме с формированием иконок в трее, каждая из которых соответствует своему потоку отслеживания. По мере обнаружения событий осуществляется изменение всплывающего комментария к соответствующей иконке и запись протокола, находящегося в каталоге скрипта. Чтобы остановить отслеживание, требуется удерживать клавишу ESC некоторое время и ответить на появившиеся вопросы в диалогах.<br /></p><div class="codebox"><pre><code>&#039;----------------- Без гарантий!Используете на свой страх и риск! ------------------------

&#039;Скрипт предназначен для отслеживания нескольких событий WMI в асинхронном режиме
&#039;с формированием иконок в трее,каждая из которых соответствует своему потоку 
&#039;отслеживания.По мере обнаружения событий осуществляется изменение всплывающего
&#039;комментария к соответствующей иконке и запись протокола,находящегося в каталоге
&#039;скрипта.Чтобы остановить отслеживание требуется удержать клавишу ESC некоторое
&#039;время и ответить на сопутствующие диалоги.

&#039;-----------------------------------------------------------------------------------------
&#039;Win98 4.10.2222A и выше ,WScript 5.6
&#039;-----------------------------------------------------------------------------------------
&#039;Language:            VBScript
&#039;Используется             библиотека dynwrap.dll
&#039;Используется вспомогательная     библиотека AutoItX3.dll,v3.2.0.1
&#039;-----------------------------------------------------------------------------------------
    &#039;Объявление общих констант и переменных
    &#039;---------------------------------------------------------------------------------
    Const NIM_ADD         =0
    Const NIM_DELETE     =2
    Const NIM_MODIFY    =1 
    Const NIF_ICON         =2
    Const NIF_TIP         =4
    Const NIF_MESSAGE     =1
    Const IMAGE_ICON    =1
    Const WM_SHELLNOTIFY    =&amp;H405
    Const VK_ESCAPE        =&amp;H1B

    &#039;Структуры для трэй иконок
    &#039;---------------------------------------------------------------------------------
    Public NOTIFYICONDATA1
    Public NOTIFYICONDATA2
    &#039;---------------------------------------------------------------------------------
    Public WbemAsyncHandler1    &#039;Асинхронный обработчик событий WMI
    Public WbemAsyncHandler2    &#039;Асинхронный обработчик событий WMI
    Public AsyncHandler1Cnt        &#039;Счетчик событий
    Public AsyncHandler2Cnt        &#039;Счетчик событий
    Public StopFlag
    Public hTray,hwnd
    
    &#039;Создание общих объектов
    &#039;----------------------------------------------------------------------------------
    Set GetAsyncKeyState_Call    =CreateObject(&quot;DynamicWrapper&quot;)
    GetAsyncKeyState_Call.Register    &quot;USER32.DLL&quot;,&quot;GetAsyncKeyState&quot;,&quot;i=l&quot;,&quot;f=s&quot;,&quot;r=l&quot;
    &#039;----------------------------------------------------------------------------------
    Set Shell_NotifyIcon_Call    =CreateObject(&quot;DynamicWrapper&quot;)
    Shell_NotifyIcon_Call.Register &quot;SHELL32.dll&quot;,&quot;Shell_NotifyIcon&quot;,&quot;f=s&quot;,&quot;i=ll&quot;,&quot;r=l&quot;
    &#039;----------------------------------------------------------------------------------
    Set CreateWindowExA_CALL    =CreateObject(&quot;DynamicWrapper&quot;)
    CreateWindowExA_CALL.Register    &quot;USER32.DLL&quot;,&quot;CreateWindowExA&quot;,&quot;i=lsslllllllll&quot;,&quot;f=s&quot;,&quot;r=h&quot;
    &#039;----------------------------------------------------------------------------------    
    Set LoadLibraryA_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    LoadLibraryA_Call.Register    &quot;KERNEL32.DLL&quot;,&quot;LoadLibraryA&quot;,&quot;i=s&quot;,&quot;f=s&quot;,&quot;r=l&quot;
    &#039;----------------------------------------------------------------------------------
    Set LoadImageA_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    LoadImageA_Call.Register    &quot;USER32.DLL&quot;,&quot;LoadImageA&quot;,&quot;i=llllll&quot;,&quot;f=s&quot;,&quot;r=l&quot;
    &#039;----------------------------------------------------------------------------------
    Set FreeLibrary_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    FreeLibrary_Call.Register    &quot;KERNEL32.DLL&quot;,&quot;FreeLibrary&quot;,&quot;i=l&quot;,&quot;f=s&quot;
    &#039;----------------------------------------------------------------------------------
    WScript.Sleep(100)
    Set ax3=CreateObject(&quot;AutoItX3.Control&quot;)
        ax3.Opt &quot;WinTitleMatchMode&quot;,    4
        ax3.Opt &quot;MouseCoordMode&quot;,    1
        hTray    =ax3.ControlGetHandle(&quot;classname=Shell_TrayWnd&quot;,&quot;&quot;,&quot;TrayNotifyWnd1&quot;)
    &#039;---------------------------------------------------------------------------------
    WScript.Sleep(100)
    Set wShell    =CreateObject(&quot;WScript.Shell&quot;)
    WScript.Sleep(100)
    Set fsObj    =CreateObject(&quot;Scripting.FileSystemObject&quot;)
    WScript.Sleep(100)
    Set objRegExp     =CreateObject(&quot;VBScript.RegExp&quot;)
    &#039;---------------------------------------------------------------------------------

    &#039;Открытие файла протокола
    &#039;---------------------------------------------------------------------------------
    WScript.Sleep(100)
    Set Flow=fsObj.OpenTextFile(    wShell.CurrentDirectory &amp; &quot;\WMISCAN.LOG&quot;, _
                    8,True,0) 

    &#039;Параметры объекта регулярных выражений
    &#039;---------------------------------------------------------------------------------
    objRegExp.Global     =True
    objRegExp.MultiLine    =True    
    objRegExp.Pattern = &quot;[\cJ\cL]&quot;
    &#039;---------------------------------------------------------------------------------


&#039;--------------------------------- Создание класса структуры ------------------------------

Class Struct    
&#039;-----------------------------------------------------------------------------------------
    Private     RtlMoveMemory_Call, _
            lstrcat_Call, _
            HeapAlloc_Call, _
            GetProcessHeap_Call, _
            HeapFree_Call
    Private     hHeap,init
&#039;-----------------------------------------------------------------------------------------
    Public         iOfs 
&#039;-----------------------------------------------------------------------------------------
Private Sub Class_Initialize    &#039;Запуск класса

    &#039;---------------------------------------------------------------------------------
    Set RtlMoveMemory_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    RtlMoveMemory_Call.Register     &quot;KERNEL32.DLL&quot;,&quot;RtlMoveMemory&quot;,&quot;f=s&quot;,&quot;i=lll&quot;,&quot;r=l&quot;
    &#039;---------------------------------------------------------------------------------
    Set lstrcat_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    lstrcat_Call.Register         &quot;KERNEL32.DLL&quot;,&quot;lstrcat&quot;,&quot;f=s&quot;,&quot;i=ws&quot;,&quot;r=l&quot; 
    &#039;---------------------------------------------------------------------------------
    Set HeapAlloc_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    HeapAlloc_Call.Register     &quot;KERNEL32.DLL&quot;,&quot;HeapAlloc&quot;,&quot;f=s&quot;,&quot;i=lll&quot;,&quot;r=l&quot;
    &#039;---------------------------------------------------------------------------------
    Set GetProcessHeap_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    GetProcessHeap_Call.Register    &quot;KERNEL32.DLL&quot;,&quot;GetProcessHeap&quot;,&quot;f=s&quot;,&quot;r=l&quot;
    &#039;---------------------------------------------------------------------------------
    Set HeapFree_Call        =CreateObject(&quot;DynamicWrapper&quot;)
    HeapFree_Call.Register        &quot;KERNEL32.DLL&quot;,&quot;HeapFree&quot;,&quot;f=s&quot;,&quot;i=lll&quot;,&quot;r=l&quot;
    &#039;---------------------------------------------------------------------------------
    &#039;Локализация кучи
    hHeap=GetProcessHeap_Call.GetProcessHeap()
End Sub 

&#039;-----------------------------------------------------------------------------------------
Private Sub Class_Terminate    &#039;Уничтожение класса
    HeapFree_Call.HeapFree hHeap,0,init
End Sub
&#039;-----------------------------------------------------------------------------------------
&#039;-----------------------------------------------------------------------------------------
&#039;[Инициализация структуры]    
    Public Sub initStruct(structSize)
        &#039;Локализация структуры
        init=HeapAlloc_Call.HeapAlloc(hHeap,0,structSize)
    End Sub
&#039;-----------------------------------------------------------------------------------------
&#039;[Возврат базового адреса]
    Public Property Get baseAddr
        &#039;Базовый адрес
        baseAddr=init
    End Property
&#039;-----------------------------------------------------------------------------------------
&#039;*[Добавление dword данных в структуру]
    Public Function SetDataDWORD(Data)
        Dim lW,hW,ConvertedData
            hW=Fix(Data/65536)
            lW=Data mod 65536 
            ConvertedData=ChrW(lW) &amp; ChrW(hW) 
        RtlMoveMemory_Call.RtlMovememory init+iOfs,GetBSTRPtr(ConvertedData),4
        iOfs=iOfs+4
    End Function
&#039;-----------------------------------------------------------------------------------------
&#039;*[Добавление текстовых данных в структуру]
    Public Function SetDataTEXT(iSize,Data,iOffset)
        RtlMoveMemory_Call.RtlMovememory init+iOffset,GetBSTRPtr(Data),iSize
    End Function
&#039;-----------------------------------------------------------------------------------------
&#039;*[Получение локального указателя добавляемых данных]
    Public Function GetBSTRPtr(ByRef sData)
        Dim pSource 
        Dim pDest
            pSource=lstrcat_Call.lstrcat(sData,&quot;&quot;)
            pDest=lstrcat_Call.lstrcat(GetBSTRPtr,&quot;&quot;)
            GetBSTRPtr=CLng(GetBSTRPtr)
        RtlMoveMemory_Call.RtlMovememory pDest+8,pSource+8,4
    End Function
&#039;-----------------------------------------------------------------------------------------
End Class

&#039;--------------------------------- Создание трей иконки------------------------------------

Function TrayIconInit(byVal STRUCT,byVal ToolTip,byVal ShIndex)

    &#039;Создание невидимого родительского окна для трэя
    &#039;----------------------------------------------------------------------------------    
    If Not hwnd Then
    hwnd=CreateWindowExA_CALL.CreateWindowExA(    0, _
                            &quot;#32770&quot;, _
                            &quot;Scanner&quot;, _
                            0, _
                            0,0,0,0, _
                            0,0,0,0)

    End If
    &#039;Загрузка иконки из библиотеки Shell32
    &#039;----------------------------------------------------------------------------------
        WScript.Sleep(100)
    hLib    =LoadLibraryA_Call.LoadLibraryA(&quot;SHELL32.DLL&quot;)
    hIcon    =LoadImageA_Call.LoadImageA(hLib,ShIndex,IMAGE_ICON,16,16,0)        
    FreeLibrary_Call.FreeLibrary hLib

    &#039;Заполнение структуры
    &#039;----------------------------------------------------------------------------------
        WScript.Sleep(100)
    iOfs=0
    With STRUCT
        .SetDataDWORD 88                &#039;Размер структуры
        .SetDataDWORD hwnd                &#039;Дескриптор родительского окна
        .SetDataDWORD 23                &#039;Идентификатор
        .SetDataDWORD NIF_TIP+NIF_ICON+NIF_MESSAGE    &#039;Флаги отображения
        .SetDataDWORD WM_SHELLNOTIFY            &#039;Параметр обработки WM_COMMAND
        .SetDataDWORD hIcon                &#039;Дескриптор иконки

    &#039;Формирование массива для текста подсказки
    &#039;----------------------------------------------------------------------------------
    For i=1 To Len(ToolTip)+1
        .SetDataTEXT 1,Mid(ToolTip,i,1),23+i            &#039;Текст подсказки    
    Next
    End With

    &#039;Создание трэй иконки
    &#039;----------------------------------------------------------------------------------
        WScript.Sleep(100)
    Shell_NotifyIcon_Call.Shell_NotifyIcon NIM_ADD,STRUCT.baseAddr


End Function

&#039;------------------------------ Модификация подсказки трей иконки-------------------------

Function TrayIconModify(byVal STRUCT,byVal ToolTip)
    With STRUCT

        &#039;Формирование массива для текста подсказки
        &#039;-------------------------------------------------------------------------
        For i=1 To Len(ToolTip)+1
            .SetDataTEXT 1,Mid(ToolTip,i,1),23+i            &#039;Текст подсказки    
        Next
    End With
    
    &#039;Модификация подсказки(пока только латинские символы)
    &#039;----------------------------------------------------------------------------------
        WScript.Sleep(100)
    Shell_NotifyIcon_Call.Shell_NotifyIcon NIM_MODIFY,STRUCT.baseAddr
End Function

&#039;--------------------------------- Уничтожение трей иконки---------------------------------

Function TrayIconDelete(byVal STRUCT)
    Shell_NotifyIcon_Call.Shell_NotifyIcon NIM_DELETE,STRUCT.baseAddr
        WScript.Sleep(100)

    &#039;Пока не удалось найти ничего лучшего как применить тривиальное
    &#039;перемещение мыши над трэй-иконкой для подтверждения её исчезновения.
    &#039;----------------------------------------------------------------------------------
        X=ax3.MouseGetPosX()
        Y=ax3.MouseGetPosY()

        tWidth    =ax3.WinGetPosWidth    (&quot;handle=&quot; &amp; hTray,&quot;&quot;)
        tHeight    =ax3.WinGetPosHeight    (&quot;last&quot;)
        tX    =ax3.WinGetPosX        (&quot;last&quot;)
        tY    =ax3.WinGetPosY        (&quot;last&quot;)

        ax3.MouseMove tX     ,tY+tHeight/2,1
        ax3.MouseMove tX+tWidth    ,tY+tHeight/2,10

        ax3.MouseMove X,Y,1
End Function

&#039;---------------- Запуск первого сканера WMI [отслеживание запуска процесса]----------------

Function RunWMIScan_1()

Set WbemService1    =GetObject(&quot;winmgmts:{authenticationLevel=pktPrivacy,impersonationLevel=Impersonate}!\\.\Root\CIMV2&quot;)
    WScript.Sleep(100)
Set WbemAsyncHandler1    =WScript.CreateObject(&quot;WbemScripting.SWbemSink&quot;,&quot;AsyncEvent1_&quot;)
    WScript.Sleep(100)
EventSource1        =WbemService1.ExecNotificationQueryAsync(WbemAsyncHandler1, _
            &quot;SELECT * FROM __InstanceCreationEvent WITHIN 5 WHERE TargetInstance ISA &#039;Win32_Process&#039;&quot;)
    WScript.Sleep(100)
&#039;------------------------------------------------
AsyncHandler1Cnt=0    &#039;Счетчик событий
Set     NOTIFYICONDATA1=new Struct
    NOTIFYICONDATA1.initStruct(88)
    WScript.Sleep(100)
    TrayIconInit NOTIFYICONDATA1,&quot;Process Scan Ready&quot;,147
End Function

&#039;---------------- Запуск второго сканера WMI [отслеживание создания потока]------------------

Function RunWMIScan_2()

Set WbemService2    =GetObject(&quot;winmgmts:{authenticationLevel=pktPrivacy,impersonationLevel=Impersonate}!\\.\Root\CIMV2&quot;)
    WScript.Sleep(100)
Set WbemAsyncHandler2    =WScript.CreateObject(&quot;WbemScripting.SWbemSink&quot;,&quot;AsyncEvent2_&quot;)
    WScript.Sleep(100)
EventSource2        =WbemService2.ExecNotificationQueryAsync(WbemAsyncHandler2, _
            &quot;SELECT * FROM __InstanceCreationEvent WITHIN 5 WHERE TargetInstance ISA &#039;Win32_Thread&#039;&quot;)
    WScript.Sleep(100)
&#039;------------------------------------------------
AsyncHandler2Cnt=0    &#039;Счетчик событий
Set     NOTIFYICONDATA2=new Struct
    NOTIFYICONDATA2.initStruct(88)
    WScript.Sleep(100)
TrayIconInit NOTIFYICONDATA2,&quot;Thread Scan Ready&quot;,171
End Function

&#039;------------- Обработчик событий объекта WbemAsyncHandler1 --------------------------------

Function AsyncEvent1_OnObjectReady(EventNotifier,EventValueSet)
    &#039;----------------------------------------------------------------------------------
    Flow.WriteLine     &quot;--------------------------------------------------------------&quot;     &amp; vbCRLF &amp; _
            &quot;Обнаружен запуск процесса:&quot;                         &amp; vbCRLF &amp; _
            objRegExp.Replace(EventNotifier.GetObjectText_(),vbCRLF)         &amp; vbCRLF

    &#039;Можно также использовать wShell.LogEvent для создания протокола в системном журнале Win NT

    AsyncHandler1Cnt=AsyncHandler1Cnt+1
    WScript.Sleep(100)

    &#039;Модификация всплывающей подсказки трэй-иконки
    TrayIconModify NOTIFYICONDATA1,&quot;Process Scan: &quot; &amp; AsyncHandler1Cnt &amp; &quot; new processes detected...&quot;
End Function

&#039;------------- Обработчик событий объекта WbemAsyncHandler2 --------------------------------

Function AsyncEvent2_OnObjectReady(EventNotifier,EventValueSet)
    Flow.WriteLine     &quot;--------------------------------------------------------------&quot;     &amp; vbCRLF &amp; _
            &quot;Обнаружено создание потока:&quot;                         &amp; vbCRLF &amp; _
            objRegExp.Replace(EventNotifier.GetObjectText_(),vbCRLF)         &amp; vbCRLF

    AsyncHandler2Cnt=AsyncHandler2Cnt+1
    WScript.Sleep(100)

    &#039;Модификация всплывающей подсказки трэй-иконки
    TrayIconModify NOTIFYICONDATA2,&quot;Thread Scan: &quot; &amp; AsyncHandler2Cnt &amp; &quot; new threads detected...&quot;
End Function
&#039;-------------------------------------------------------------------------------------------


    &#039;Запуск сканеров и отслежвание нажатия ESC для остановки

    RunWMIScan_1()
    RunWMIScan_2()

    Set CreateWindowExA_CALL    =Nothing
    Set LoadLibraryA_Call        =Nothing
    Set LoadImageA_Call        =Nothing
    Set FreeLibrary_Call        =Nothing
    &#039;-----------------------------------------------------------------------------------
    While 1    
        WScript.Sleep(1000)
        hState=GetAsyncKeyState_Call.GetAsyncKeyState(VK_ESCAPE)

    If hState&lt;&gt;0 Then WScript.Sleep(1000)

    If hState&lt;&gt;0 Then
    hState=0

        &#039;Запрос на завершение работы первого сканера
        &#039;---------------------------------------------------------------------------
        If StopFlag=2 Or StopFlag=0 Then
        iQuest1=wShell.PopUp(&quot;Остановить осмотр запуска процессов?&quot;,5, _
            &quot;Завершение работы&quot;,vbYesNo+vbQuestion)
            If iQuest1=vbYes then 
            WScript.Sleep(200)
                WbemAsyncHandler1.Cancel()
            WScript.Sleep(200)
                StopFlag=StopFlag+1
            WScript.Sleep(200)
                TrayIconDelete NOTIFYICONDATA1
            WScript.Sleep(200)
                Set NOTIFYICONDATA1=Nothing
            End If
        End If

        &#039;Запрос на завершение работы второго сканера
        &#039;---------------------------------------------------------------------------
        If StopFlag=1 Or StopFlag=0 Then
        iQuest2=wShell.PopUp(&quot;Остановить осмотр создания потоков?&quot;,5, _
            &quot;Завершение работы&quot;,vbYesNo+vbQuestion)
            If iQuest2=vbYes then 
            WScript.Sleep(200)
                WbemAsyncHandler2.Cancel()
            WScript.Sleep(200)
                StopFlag=StopFlag+2
            WScript.Sleep(200)
                TrayIconDelete NOTIFYICONDATA2
            WScript.Sleep(200)
                Set NOTIFYICONDATA2=Nothing
            End If
        End If
        &#039;---------------------------------------------------------------------------
    End If

        If StopFlag=3 then 
                Flow.Close()
            WScript.Sleep(200)
                wShell.PopUp &quot;Работа сканера завершена.&quot;,5,&quot;Завершение работы&quot;,vbInformation
            WScript.Sleep(200)
                WScript.Quit()
        End If
    Wend
    &#039;-----------------------------------------------------------------------------------</code></pre></div><p>Автор примера - <strong>Poltergeyst</strong>.</p>]]></description>
			<author><![CDATA[null@example.com (The gray Cardinal)]]></author>
			<pubDate>Mon, 12 May 2008 16:27:30 +0000</pubDate>
			<guid>https://forum.script-coding.com/viewtopic.php?pid=10882#p10882</guid>
		</item>
		<item>
			<title><![CDATA[VBScript: создание иконки в системном трее]]></title>
			<link>https://forum.script-coding.com/viewtopic.php?pid=10859#p10859</link>
			<description><![CDATA[<p>Пример отслеживает запуск нового процесса с формированием иконки в трее.<br />Потребуется библиотека <a href="http://www.script-coding.com/dynwrap.html">dynwrap.dll</a>.<br /></p><div class="codebox"><pre><code>&#039;------------------------------------------------------------------------------------------
&#039;--------------------------------- Создание класса структуры ----------------------
&#039;------------------------------------------------------------------------------------------
Class Struct    
&#039;-----------------------------------------------------------------------------------------
    Private     RtlMoveMemory_Call, _
            lstrcat_Call, _
            HeapAlloc_Call, _
            GetProcessHeap_Call, _
            HeapFree_Call
    Private     hHeap,init
&#039;-----------------------------------------------------------------------------------------
    Public         iOfs 
&#039;-----------------------------------------------------------------------------------------
Private Sub Class_Initialize    &#039;Запуск класса

&#039;---------------------------------------------------------------------------------
Set RtlMoveMemory_Call        =CreateObject(&quot;DynamicWrapper&quot;)
RtlMoveMemory_Call.Register &quot;kernel32.dll&quot;,&quot;RtlMoveMemory&quot;,&quot;f=s&quot;,&quot;i=lll&quot;,&quot;r=l&quot;
&#039;---------------------------------------------------------------------------------
Set lstrcat_Call        =CreateObject(&quot;DynamicWrapper&quot;)
lstrcat_Call.Register &quot;kernel32.dll&quot;,&quot;lstrcat&quot;,&quot;f=s&quot;,&quot;i=ws&quot;,&quot;r=l&quot; 
&#039;---------------------------------------------------------------------------------
Set HeapAlloc_Call        =CreateObject(&quot;DynamicWrapper&quot;)
HeapAlloc_Call.Register     &quot;KERNEL32.DLL&quot;,&quot;HeapAlloc&quot;,&quot;f=s&quot;,&quot;i=lll&quot;,&quot;r=l&quot;
&#039;---------------------------------------------------------------------------------
Set GetProcessHeap_Call        =CreateObject(&quot;DynamicWrapper&quot;)
GetProcessHeap_Call.Register    &quot;KERNEL32.DLL&quot;,&quot;GetProcessHeap&quot;,&quot;f=s&quot;,&quot;r=l&quot;
&#039;---------------------------------------------------------------------------------
Set HeapFree_Call        =CreateObject(&quot;DynamicWrapper&quot;)
HeapFree_Call.Register        &quot;KERNEL32.DLL&quot;,&quot;HeapFree&quot;,&quot;f=s&quot;,&quot;i=lll&quot;,&quot;r=l&quot;
&#039;---------------------------------------------------------------------------------
&#039;Локализация кучи
hHeap=GetProcessHeap_Call.GetProcessHeap()
End Sub 
&#039;-----------------------------------------------------------------------------------------
Private Sub Class_Terminate    &#039;Уничтожение класса
    HeapFree_Call.HeapFree hHeap,0,init
End Sub
&#039;-----------------------------------------------------------------------------------------
&#039;-----------------------------------------------------------------------------------------
&#039;[Инициализация структуры]    
    Public Sub initStruct(structSize)
        &#039;Локализация структуры
        init=HeapAlloc_Call.HeapAlloc(hHeap,0,structSize)
    End Sub
&#039;-----------------------------------------------------------------------------------------
&#039;[Возврат базового адреса]
    Public Property Get baseAddr
        &#039;Базовый адрес
        baseAddr=init
    End Property
&#039;-----------------------------------------------------------------------------------------
&#039;*[Добавление dword данных в структуру]
    Public Function SetDataDWORD(Data)
        Dim lW,hW,ConvertedData
            hW=Fix(Data/65536)
            lW=Data mod 65536 
            ConvertedData=ChrW(lW) &amp; ChrW(hW) 
RtlMoveMemory_Call.RtlMovememory init+iOfs,GetBSTRPtr(ConvertedData),4
        iOfs=iOfs+4
    End Function
&#039;-----------------------------------------------------------------------------------------
&#039;*[Добавление текстовых данных в структуру]
    Public Function SetDataTEXT(iSize,Data)
    RtlMoveMemory_Call.RtlMovememory init+iOfs,GetBSTRPtr(Data),iSize
        iOfs=iOfs+iSize
    End Function
&#039;-----------------------------------------------------------------------------------------
&#039;*[Получение локального указателя добавляемых данных]
    Public Function GetBSTRPtr(ByRef sData)
        Dim pSource 
        Dim pDest
            pSource=lstrcat_Call.lstrcat(sData,&quot;&quot;)
            pDest=lstrcat_Call.lstrcat(GetBSTRPtr,&quot;&quot;)
            GetBSTRPtr=CLng(GetBSTRPtr)
        RtlMoveMemory_Call.RtlMovememory pDest+8,pSource+8,4
    End Function
&#039;-----------------------------------------------------------------------------------------
End Class


&#039;------------------------------------------------------------------------------------------
&#039;--------------------------------- Создание класса трей иконки---------------------
&#039;------------------------------------------------------------------------------------------
    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    =&amp;H405
&#039;-----------------------------------------------------------------------------------------
Class TrayIcon

Private Shell_NotifyIcon_Call
Private NOTIFYICONDATA
&#039;-----------------------------------------------------------------------------------------
Private Sub Class_Initialize
    
    Set NOTIFYICONDATA=new Struct
    NOTIFYICONDATA.initStruct(88)

&#039;----------------------------------------------------------------------------------
Set Shell_NotifyIcon_Call    =CreateObject(&quot;DynamicWrapper&quot;)
Shell_NotifyIcon_Call.Register &quot;SHELL32.dll&quot;,&quot;Shell_NotifyIcon&quot;,&quot;f=s&quot;,&quot;i=ll&quot;,&quot;r=l&quot;
&#039;----------------------------------------------------------------------------------
Set CreateWindowExA_CALL    =CreateObject(&quot;DynamicWrapper&quot;)
CreateWindowExA_CALL.Register    &quot;USER32.DLL&quot;,&quot;CreateWindowExA&quot;, _
&quot;i=lsslllllllll&quot;,&quot;f=s&quot;,&quot;r=h&quot;
&#039;----------------------------------------------------------------------------------    
hwnd=CreateWindowExA_CALL.CreateWindowExA(    0, _
                            &quot;#32770&quot;, _
                            &quot;&quot;, _
                            0, _
                            0,0,0,0, _
                            0,0,0,0)
&#039;----------------------------------------------------------------------------------
    ToolTip=&quot;Process Scan is activated...&quot; &#039;Текст подсказки
    ShIndex=147                                    &#039;Индекс иконки в SHELL32.DLL
&#039;----------------------------------------------------------------------------------
Set LoadLibraryA_Call        =CreateObject(&quot;DynamicWrapper&quot;)
LoadLibraryA_Call.Register    &quot;KERNEL32.DLL&quot;,&quot;LoadLibraryA&quot;,&quot;i=s&quot;,&quot;f=s&quot;,&quot;r=l&quot;
hLib=LoadLibraryA_Call.LoadLibraryA(&quot;SHELL32.DLL&quot;)
&#039;----------------------------------------------------------------------------------
Set LoadImageA_Call        =CreateObject(&quot;DynamicWrapper&quot;)
LoadImageA_Call.Register    &quot;USER32.DLL&quot;,&quot;LoadImageA&quot;,&quot;i=llllll&quot;,&quot;f=s&quot;,&quot;r=l&quot;
hIcon=LoadImageA_Call.LoadImageA(hLib,ShIndex,IMAGE_ICON,16,16,0)        
&#039;----------------------------------------------------------------------------------
iOfs=0
With NOTIFYICONDATA
.SetDataDWORD 88                &#039;Размер структуры
.SetDataDWORD hwnd                &#039;Дескриптор окна
.SetDataDWORD 23                &#039;Идентификатор иконки 
.SetDataDWORD NIF_TIP+NIF_ICON+NIF_MESSAGE    &#039;Флаги отображения
.SetDataDWORD WM_SHELLNOTIFY            &#039;Сообщение реакции
.SetDataDWORD hIcon                &#039;Дескриптор иконки
&#039;----------------------------------------------------------------------------------
&#039;Формирование массива для текста подсказки
For i=1 To Len(ToolTip)+1
    .SetDataTEXT 1,Mid(ToolTip,i,1)                
Next
End With
&#039;----------------------------------------------------------------------------------
Shell_NotifyIcon_Call.Shell_NotifyIcon NIM_ADD,NOTIFYICONDATA.baseAddr
End Sub
&#039;------------------------------------------------------------------------------------------
Private Sub Class_Terminate
Shell_NotifyIcon_Call.Shell_NotifyIcon NIM_DELETE,NOTIFYICONDATA.baseAddr
End Sub
&#039;------------------------------------------------------------------------------------------
End Class

&#039;------------------------------------------------------------------------------------------
&#039;------------- Обработчик событий объекта WbemAsyncHandler -----------------
&#039;------------------------------------------------------------------------------------------
Function AsyncEvent_OnObjectReady(EventNotifier,EventValueSet)
    iQuest=MsgBox(    &quot;Обнаружен запуск процесса:&quot; &amp; vbCR &amp; vbCR &amp; _
            EventNotifier.GetObjectText_() &amp; vbCR &amp; vbCR &amp; _
            &quot;Продолжить осмотр?&quot;, _
            vbYesNo+vbQuestion,&quot;Обнаружен запуск процесса&quot;)
    If iQuest=vbNo then 
        Set Tray=Nothing
        WScript.Quit(0)
    End If
End Function
&#039;------------------------------------------------------------------------------------------
&#039;-------------- Общие инструкции ----------------------------------------------------
&#039;------------------------------------------------------------------------------------------

Set Tray=New TrayIcon
&#039;------------------------------------------------------------------------------------------
    WScript.Sleep(500)
Set WbemService        =GetObject( _
&quot;winmgmts:{authenticationLevel=pktPrivacy,&quot; &amp; _
&quot;impersonationLevel=Impersonate}!\\.\Root\CIMV2&quot;)

Set WbemAsyncHandler    =WScript.CreateObject( _
&quot;WbemScripting.SWbemSink&quot;,&quot;AsyncEvent_&quot;)

EventSource    =WbemService.ExecNotificationQueryAsync( _
WbemAsyncHandler, _
&quot;SELECT * FROM __InstanceCreationEvent&quot; &amp; _
&quot; WITHIN 5 WHERE TargetInstance ISA &#039;Win32_Process&#039;&quot;)
    WScript.Sleep(500)
&#039;------------------------------------------------------------------------------------------
While 1    
    WScript.Sleep(1000)
Wend</code></pre></div><p>Дополнительные источники:<br /><a href="http://forum.codenet.ru/showthread.php?t=10401">http://forum.codenet.ru/showthread.php?t=10401</a><br /><a href="http://forums.hardlabs.net/index.php?showtopic=654&amp;mode=threaded">http://forums.hardlabs.net/index.php?sh … e=threaded</a><br /><a href="http://www.wasm.ru/print.php?article=1001023">http://www.wasm.ru/print.php?article=1001023</a><br />Автор примера - <strong>Poltergeyst</strong>.</p>]]></description>
			<author><![CDATA[null@example.com (The gray Cardinal)]]></author>
			<pubDate>Sun, 11 May 2008 17:04:28 +0000</pubDate>
			<guid>https://forum.script-coding.com/viewtopic.php?pid=10859#p10859</guid>
		</item>
	</channel>
</rss>
