1 Тема от The gray Cardinal

  • The gray Cardinal
  • Разработчик
  • Неактивен

Тема: 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.

Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.

2 Ответ от The gray Cardinal

  • The gray Cardinal
  • Разработчик
  • Неактивен

Re: VBScript: создание иконки в системном трее

Развитие предыдущего примера.
Потребуются библиотеки dynwrap.dll и AutoItX3.dll.
Скрипт отслеживает несколько событий WMI в асинхронном режиме с формированием иконок в трее, каждая из которых соответствует своему потоку отслеживания. По мере обнаружения событий осуществляется изменение всплывающего комментария к соответствующей иконке и запись протокола, находящегося в каталоге скрипта. Чтобы остановить отслеживание, требуется удерживать клавишу ESC некоторое время и ответить на появившиеся вопросы в диалогах.

'----------------- Без гарантий!Используете на свой страх и риск! ------------------------

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

'-----------------------------------------------------------------------------------------
'Win98 4.10.2222A и выше ,WScript 5.6
'-----------------------------------------------------------------------------------------
'Language:            VBScript
'Используется             библиотека dynwrap.dll
'Используется вспомогательная     библиотека AutoItX3.dll,v3.2.0.1
'-----------------------------------------------------------------------------------------
    'Объявление общих констант и переменных
    '---------------------------------------------------------------------------------
    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    =&H405
    Const VK_ESCAPE        =&H1B

    'Структуры для трэй иконок
    '---------------------------------------------------------------------------------
    Public NOTIFYICONDATA1
    Public NOTIFYICONDATA2
    '---------------------------------------------------------------------------------
    Public WbemAsyncHandler1    'Асинхронный обработчик событий WMI
    Public WbemAsyncHandler2    'Асинхронный обработчик событий WMI
    Public AsyncHandler1Cnt        'Счетчик событий
    Public AsyncHandler2Cnt        'Счетчик событий
    Public StopFlag
    Public hTray,hwnd
    
    'Создание общих объектов
    '----------------------------------------------------------------------------------
    Set GetAsyncKeyState_Call    =CreateObject("DynamicWrapper")
    GetAsyncKeyState_Call.Register    "USER32.DLL","GetAsyncKeyState","i=l","f=s","r=l"
    '----------------------------------------------------------------------------------
    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"
    '----------------------------------------------------------------------------------    
    Set LoadLibraryA_Call        =CreateObject("DynamicWrapper")
    LoadLibraryA_Call.Register    "KERNEL32.DLL","LoadLibraryA","i=s","f=s","r=l"
    '----------------------------------------------------------------------------------
    Set LoadImageA_Call        =CreateObject("DynamicWrapper")
    LoadImageA_Call.Register    "USER32.DLL","LoadImageA","i=llllll","f=s","r=l"
    '----------------------------------------------------------------------------------
    Set FreeLibrary_Call        =CreateObject("DynamicWrapper")
    FreeLibrary_Call.Register    "KERNEL32.DLL","FreeLibrary","i=l","f=s"
    '----------------------------------------------------------------------------------
    WScript.Sleep(100)
    Set ax3=CreateObject("AutoItX3.Control")
        ax3.Opt "WinTitleMatchMode",    4
        ax3.Opt "MouseCoordMode",    1
        hTray    =ax3.ControlGetHandle("classname=Shell_TrayWnd","","TrayNotifyWnd1")
    '---------------------------------------------------------------------------------
    WScript.Sleep(100)
    Set wShell    =CreateObject("WScript.Shell")
    WScript.Sleep(100)
    Set fsObj    =CreateObject("Scripting.FileSystemObject")
    WScript.Sleep(100)
    Set objRegExp     =CreateObject("VBScript.RegExp")
    '---------------------------------------------------------------------------------

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

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


'--------------------------------- Создание класса структуры ------------------------------

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,iOffset)
        RtlMoveMemory_Call.RtlMovememory init+iOffset,GetBSTRPtr(Data),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

'--------------------------------- Создание трей иконки------------------------------------

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

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

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

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

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

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


End Function

'------------------------------ Модификация подсказки трей иконки-------------------------

Function TrayIconModify(byVal STRUCT,byVal ToolTip)
    With STRUCT

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

'--------------------------------- Уничтожение трей иконки---------------------------------

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

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

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

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

        ax3.MouseMove X,Y,1
End Function

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

Function RunWMIScan_1()

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

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

Function RunWMIScan_2()

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

'------------- Обработчик событий объекта WbemAsyncHandler1 --------------------------------

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

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

    AsyncHandler1Cnt=AsyncHandler1Cnt+1
    WScript.Sleep(100)

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

'------------- Обработчик событий объекта WbemAsyncHandler2 --------------------------------

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

    AsyncHandler2Cnt=AsyncHandler2Cnt+1
    WScript.Sleep(100)

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


    'Запуск сканеров и отслежвание нажатия ESC для остановки

    RunWMIScan_1()
    RunWMIScan_2()

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

    If hState<>0 Then WScript.Sleep(1000)

    If hState<>0 Then
    hState=0

        'Запрос на завершение работы первого сканера
        '---------------------------------------------------------------------------
        If StopFlag=2 Or StopFlag=0 Then
        iQuest1=wShell.PopUp("Остановить осмотр запуска процессов?",5, _
            "Завершение работы",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

        'Запрос на завершение работы второго сканера
        '---------------------------------------------------------------------------
        If StopFlag=1 Or StopFlag=0 Then
        iQuest2=wShell.PopUp("Остановить осмотр создания потоков?",5, _
            "Завершение работы",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
        '---------------------------------------------------------------------------
    End If

        If StopFlag=3 then 
                Flow.Close()
            WScript.Sleep(200)
                wShell.PopUp "Работа сканера завершена.",5,"Завершение работы",vbInformation
            WScript.Sleep(200)
                WScript.Quit()
        End If
    Wend
    '-----------------------------------------------------------------------------------

Автор примера - Poltergeyst.

Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.

3 Ответ от The gray Cardinal

  • The gray Cardinal
  • Разработчик
  • Неактивен

Re: VBScript: создание иконки в системном трее

Развитие предыдущего примера, скрипт находится во вложении этого поста.
Потребуется установленный LangMF 7.7, см. комментарии в коде скрипта.
Скрипт предназначен для отслеживания нескольких событий WMI в асинхронном режиме с формированием иконок в трее, каждая из которых соответствует своему потоку отслеживания. По мере обнаружения событий осуществляется изменение всплывающего комментария к соответствующей иконке и запись протоколов в каталоге скрипта. Для остановки отслеживания и просмотра статистики используйте контекстное меню трей-иконок.
Отличается от предыдущего улучшенной работой с иконками в трее: теперь у иконок есть контекстное меню.
Автор примера - Poltergeyst.

Post's attachments

2LMLauncher.zip 3.8 kb, 407 downloads since 2008-05-25 

You don't have the permssions to download the attachments of this post.
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.