Results 1 to 14 of 14

Thread: [RESOLVED] VB6 QUESTION: how to identify processes in the systray

  1. #1

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Resolved [RESOLVED] VB6 QUESTION: how to identify processes in the systray

    Hoping you can help.

    The background is that I am creating my own dock and I need to automatically restore a minimised window when I click upon its icon and bring it to the fore.



    I have some code that enumerates all windows using EnumWindows which then extracts the process ID for each handle using GetWindowThreadProcessId, comparing that to a stored processID for a match.

    This uses the resulting matching handle to determine the top level window which I can then manipulate and bring it to the fore using SetForegroundWindow(hwnd) and ShowWindow APIs. Now, this all works and I am pleased with the result.

    However, some tools such as gpu-z (and others) allow you to minimise to the systray instead of minimising to the desktop taskbar - in this case GPU-z seems not to be really minimised at all, certainly the GetWindowThreadProcessId does not see gpu-z when my program iterates through the open/minimised windows returning a value of 0.



    I can of course see the gpu-z process in the list of processes in task manager but I do not know how to test as to whether it is in the systray.

    So, my question is, is there a way to enumerate all processes minimised to the systray or a method by which, given a processID I can determine the window handle for the systray icon and bring it to the fore?

    I hope this makes sense, I can post the code that works (below) but I think I really need a pointer to the best way to test the systray processes.

    Code:
    '---------------------------------------------------------------------------------------
    ' Procedure : fEnumWindowsCallBack
    ' Author    : beededea
    ' Date      : 08/02/2021
    ' Purpose   : call back routine that returns to fEnumWindows
    '---------------------------------------------------------------------------------------
    '
    Private Function fEnumWindowsCallBack(ByVal hwnd As Long, ByVal lParam As Long) As Long
    Dim lReturn     As Long
    Dim lExStyle    As Long
    Dim bNoOwner    As Boolean
    Dim sWindowText As String
    Dim test_pid    As Long
    Dim Thread_ID   As Long
    Dim PID   As Long
    
    '
    ' This callback function is called by Windows (from
    ' the EnumWindows API call) for EVERY window that exists.
    ' It populates the listbox with a list of windows that we
    ' are interested in.
    '
    ' Windows to display are those that:
    '   -   are not this apps
    '   -   are visible
    '   -   do not have a parent
    '   -   have no owner and are not Tool windows OR
    '       have an owner and are App windows
    '
       On Error GoTo fEnumWindowsCallBack_Error
    
    PID = lParam
    
    If hwnd <> dock.hwnd Then
            ' check if window is visible or not - not a good test as some windows are top but still hidden such as GPU-z that minimises to the systray.
            If IsWindowVisible(hwnd) Then
                                    
                ' This is a top-level window. See if it has the target instance handle.
                ' test_pid is the process ID returned for the window handle
                
                ' GetWindowThreadProcessId finds the process ID given for the thread which owns the window
                Thread_ID = GetWindowThreadProcessId(hwnd, test_pid)
                    
                ' GPU-z
                If test_pid = PID Then
                    If GetParent(hwnd) = 0 Then
                    bNoOwner = (GetWindow(hwnd, GW_OWNER) = 0)
                    lExStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
                    
                    
                    If (((lExStyle And WS_EX_TOOLWINDOW) = 0) And bNoOwner) Or _
                        ((lExStyle And WS_EX_APPWINDOW) And Not bNoOwner) Then
                            hwnd = GetAncestor(hwnd, GA_ROOT)
    
                            storeWindowHwnd = hwnd ' a bit of a kludge, a global var that carries the window handle to the calling function
                            Exit Function
                    End If
                End If
            End If
        End If
    End If
    fEnumWindowsCallBack = True
    
       On Error GoTo 0
       Exit Function
    
    fEnumWindowsCallBack_Error:
    
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fEnumWindowsCallBack of Module mdlMain"
    End Function
    PS. As with all my posts, shortly after posting my question, the answer either pops into my head spontaneously or someone shows me how to do it very easily and shows me to be the idiot I truly am...
    Last edited by Shaggy Hiker; Feb 10th, 2021 at 09:48 AM.

  2. #2
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,996

    Re: VB6 QUESTION: how to identify processes in the systray

    Quote Originally Posted by yereverluvinuncleber View Post
    However, some tools such as gpu-z (and others) allow you to minimise to the systray instead of minimising to the desktop taskbar
    The window of your program (not gpu-z) must be had set to non-visible, but it must be on the list.
    Remove 'If IsWindowVisible(hwnd) Then'.

  3. #3

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: VB6 QUESTION: how to identify processes in the systray

    Eduardo, that is, of course what I had previously tried and that seemed to work, I was hoping for reassurance that I had it right and it seems I have. Thanks for that.

    The trouble is that if I make that change and allow it to search and bring invisible windows to the fore it seem to pop up spurious mini-windows that contain nothing at all.

    I'm going to have to look deeper into the logic and see how to differentiate top windows from these "window stubs" as I seem to making those come to the fore as well.
    Last edited by yereverluvinuncleber; Feb 10th, 2021 at 06:59 PM.

  4. #4

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: [RESOLVED] VB6 QUESTION: how to identify processes in the systray

    I have retained that 'If IsWindowVisible(hwnd) Then' and my program works as expected on all 'normal' windows.

    For the invisible systray windows I am adding a temporary kludge that only affects processes that exist in a list of known processes. That is my own private list of known apps that utilise the "minimise to systray" functionality. I extract the window caption using the GetWindowText API.

    Code:
        ' systray apps list, add to the list those apps you find that can be minimised to the systray
        appSystrayTypes = "GPU-Z|XWidget|Lasso|Everything|Open Hardware Monitor|CintaNotes|Iconoid"
        appSystray = Split(appSystrayTypes, "|")
    
                Thread_ID = GetWindowThreadProcessId(hwnd, test_pid)
    
                If test_pid = PID Then
                    If GetParent(hwnd) = 0 Then
                        bNoOwner = (GetWindow(hwnd, GW_OWNER) = 0)
                        lExStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
    
                        
                        sWindowText = Space$(256) ' pad the string to 256 chars
                        lReturn = GetWindowText(hwnd, sWindowText, Len(sWindowText)) ' obtain the caption
    
                        For i = 0 To UBound(appSystray) ' search through all the potential systray apps
                            If InStr(sWindowText, appSystray(i)) Then
                        
                                If (((lExStyle And WS_EX_TOOLWINDOW) = 0) And bNoOwner) Or _
                                    ((lExStyle And WS_EX_APPWINDOW) And Not bNoOwner) Then
                
                                        hwnd = GetAncestor(hwnd, GA_ROOT)
                
                                        storeWindowHwnd = hwnd ' a bit of a kludge, a global var that carries the window handle to the calling function
                                        Exit Function
                                End If
                            End If
                        Next
                    End If
                End If
    GPU-Z is now in that list... and I'll add other apps that have the ability to minimise to the systray. It is a kludge but until I find a better way then it works and it'll hang around until I find a better way.

    Any suggestions will be appreciated.
    Last edited by yereverluvinuncleber; Feb 10th, 2021 at 01:37 PM.

  5. #5

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: VB6 QUESTION: how to identify processes in the systray

    It seems that the systray is just a simple toolbar hosted in Explorer which appears as if someone at MS must have simply knocked something new together using the minimum of effort. There are no APIs that test for items in the systray, one has to count the items manually and perform operations in pure code analysing properties like the colours of the tray icons to see exactly what is there...

  6. #6
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: VB6 QUESTION: how to identify processes in the systray

    yereverluvinuncleber, there are 2 areas with tray icon:
    - general notify tray area (next to the clock);
    - overflow area (which is available when you click the triangle and to be filled when the general area exceeds).

    Here is how you can retrieve the process paths which owns the icon in each area:

    Form
    Code:
    
    Option Explicit
    
    Private Sub Form_Load()
    
        Dim hTray As Long
        Dim hOverflow As Long
    
        hTray = FindWindow_NotifyTray()
        hOverflow = FindWindow_NotifyOverflow()
    
        Me.AutoRedraw = True
        Me.Font.Bold = True
    
        Me.Print "Tray Handle: 0x" & Hex(hTray)
        GetInfo hTray
    
        Me.Print "Overflow Handle: 0x" & Hex(hOverflow)
        GetInfo hOverflow
    End Sub
    
    Function GetInfo(hTray As Long)
    
        Dim count As Long
        Dim hIcon() As Long
        Dim i As Long
        Dim pid As Long
    
        count = GetIconCount(hTray)
    
        Me.Print "Count: " & count
    
        If count <> 0 Then
            Call GetIconHandles(hTray, count, hIcon)
        End If
    
        For i = 0 To count - 1
            pid = GetPidByWindow(hIcon(i))
            Me.Print i + 1 & vbTab & "0x" & Right$("0000000" & Hex(hIcon(i)), 8) & vbTab & ": " & GetFilePathByPid(pid)
        Next
    End Function
    
    
    Module
    Code:
    
    Option Explicit
    
    Private Type TBBUTTON_32
        iBitmap         As Long
        idCommand       As Long
        fsState         As Byte
        fsStyle         As Byte
        bReserved(1)    As Byte
        dwData          As Long
        iString         As Long
    End Type
    
    Private Type TBBUTTON_64
        iBitmap         As Long
        idCommand       As Long
        fsState         As Byte
        fsStyle         As Byte
        bReserved(5)    As Byte
        dwData          As Currency
        iString         As Currency
    End Type
    
    Private Type SYSTEM_INFO
        wProcessorArchitecture As Integer
        wReserved As Integer
        dwPageSize As Long
        lpMinimumApplicationAddress As Long
        lpMaximumApplicationAddress As Long
        dwActiveProcessorMask As Long
        dwNumberOrfProcessors As Long
        dwProcessorType As Long
        dwAllocationGranularity As Long
        wProcessorLevel As Integer
        wProcessorRevision As Integer
    End Type
    
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
    Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As Long, ByVal lpszWindow As Long) As Long
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
    Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Public Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
    Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
    Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
    Public Declare Function NtWow64ReadVirtualMemory64 Lib "ntdll.dll" (ByVal ProcessHandle As Long, ByVal BaseAddress As Currency, ByVal Buffer As Long, ByVal Size As Currency, ByVal NumberOfBytesRead As Long) As Long
    Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    Public Declare Sub GetNativeSystemInfo Lib "kernel32.dll" (ByVal lpSystemInfo As Long)
    Public Declare Function QueryFullProcessImageName Lib "kernel32.dll" Alias "QueryFullProcessImageNameW" (ByVal hProcess As Long, ByVal dwFlags As Long, ByVal lpExeName As Long, ByVal lpdwSize As Long) As Long
    Public Declare Function GetProcessImageFileName Lib "psapi.dll" Alias "GetProcessImageFileNameW" (ByVal hProcess As Long, ByVal lpImageFileName As Long, ByVal nSize As Long) As Long
    
    Public Const MAX_PATH As Long = 260&
    
    Public Const TB_GETBUTTON As Long = 1047&
    Public Const TB_BUTTONCOUNT As Long = 1048&
    
    Public Const PROCESS_VM_OPERATION As Long = &H8&
    Public Const PROCESS_VM_READ As Long = 16&
    Public Const PROCESS_QUERY_INFORMATION As Long = 1024&
    Public Const PROCESS_QUERY_LIMITED_INFORMATION As Long = &H1000&
    Public Const MEM_COMMIT As Long = &H1000&
    Public Const PAGE_READWRITE As Long = 4&
    Public Const MEM_RELEASE As Long = &H8000&
    
    Public Const PROCESSOR_ARCHITECTURE_AMD64 As Long = 9&
    
    
    Public Function FindWindow_NotifyTray() As Long
        Dim hWnd As Long
        hWnd = FindWindow(StrPtr("Shell_TrayWnd"), 0&)
        hWnd = FindWindowEx(hWnd, 0, StrPtr("TrayNotifyWnd"), 0)
        hWnd = FindWindowEx(hWnd, 0, StrPtr("SysPager"), 0)
        hWnd = FindWindowEx(hWnd, 0, StrPtr("ToolbarWindow32"), 0)
        FindWindow_NotifyTray = hWnd
    End Function
    
    Public Function FindWindow_NotifyOverflow() As Long
        Dim hWnd As Long
        hWnd = FindWindow(StrPtr("NotifyIconOverflowWindow"), 0&)
        hWnd = FindWindowEx(hWnd, 0, StrPtr("ToolbarWindow32"), 0)
        FindWindow_NotifyOverflow = hWnd
    End Function
    
    Public Function GetIconCount(hWnd As Long) As Long
        GetIconCount = SendMessage(hWnd, TB_BUTTONCOUNT, 0, ByVal 0)
    End Function
    
    Public Function GetIconHandles(hTray As Long, count As Long, hIcon() As Long) As Boolean
    
        Dim pid         As Long
        Dim tb_32       As TBBUTTON_32
        Dim tb_64       As TBBUTTON_64
        Dim Extra(1)    As Long
        Dim hProc       As Long
        Dim pMem        As Long
        Dim index       As Long
        Dim OS_64       As Boolean
        Dim si          As SYSTEM_INFO
    
        GetNativeSystemInfo VarPtr(si)
        OS_64 = (si.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64)
    
        ReDim hIcon(count - 1)
    
        GetWindowThreadProcessId hTray, pid
    
        If pid Then
    
            hProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_OPERATION Or PROCESS_VM_READ, False, pid)
    
            If hProc Then
    
                pMem = VirtualAllocEx(hProc, 0&, IIf(OS_64, LenB(tb_64), LenB(tb_32)), MEM_COMMIT, PAGE_READWRITE)
    
                If pMem Then
    
                    For index = 0 To count - 1
    
                        If SendMessage(hTray, TB_GETBUTTON, index, ByVal pMem) Then
    
                            If OS_64 Then
    
                                If ReadProcessMemory64(hProc, IntToInt64(pMem), VarPtr(tb_64), LenB(tb_64)) Then
    
                                    If tb_64.dwData <> 0 Then
    
                                        If ReadProcessMemory64(hProc, tb_64.dwData, VarPtr(Extra(0)), 8&) Then
    
                                            hIcon(index) = Extra(0)
                                            GetIconHandles = True
                                        End If
                                    End If
                                End If
                            Else
                                If ReadProcessMemory(hProc, pMem, ByVal VarPtr(tb_32), LenB(tb_32), ByVal 0&) Then
    
                                    If tb_32.dwData <> 0 Then
    
                                        If ReadProcessMemory(hProc, tb_32.dwData, ByVal VarPtr(Extra(0)), 8&, ByVal 0&) Then
    
                                            hIcon(index) = Extra(0)
                                            GetIconHandles = True
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    Next
                    VirtualFreeEx hProc, pMem, 0, MEM_RELEASE
                End If
                CloseHandle hProc
            End If
        End If
    End Function
    
    Public Function ReadProcessMemory64(hProcess As Long, lpBaseAddress As Currency, lpBuffer As Long, nSize As Long) As Boolean
        ReadProcessMemory64 = NT_SUCCESS(NtWow64ReadVirtualMemory64(hProcess, lpBaseAddress, lpBuffer, IntToInt64(nSize), 0&))
    End Function
    
    Public Function NT_SUCCESS(NT_Code As Long) As Boolean
        NT_SUCCESS = (NT_Code >= 0)
    End Function
    
    Public Function IntToInt64(numInt As Long) As Currency
        IntToInt64 = CCur(numInt / 10000&)
    End Function
    
    Public Function GetPidByWindow(hWnd As Long) As Long
         GetWindowThreadProcessId hWnd, GetPidByWindow
    End Function
    
    Public Function GetFilePathByPid(pid As Long) As String
    
        Dim hProc As Long
        Dim ProcPath As String
        Dim cnt As Long
    
        hProc = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION Or PROCESS_VM_READ, 0&, pid)
    
        If hProc Then
            cnt = MAX_PATH + 1
            ProcPath = String$(cnt, 0&)
            Call QueryFullProcessImageName(hProc, 0&, StrPtr(ProcPath), VarPtr(cnt))
    
            If 0 <> Err.LastDllError Then
                cnt = GetProcessImageFileName(hProc, StrPtr(ProcPath), Len(ProcPath))
            End If
            CloseHandle hProc
        End If
    
        If cnt <> 0 Then GetFilePathByPid = Left$(ProcPath, cnt)
    End Function
    
    
    Support: Windows 7+.
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

  7. #7

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: VB6 QUESTION: how to identify processes in the systray

    Thankyou indeed. I will look at that code in detail. Assuming that the APIs used to read 64 bit process information from a 32 bit process did not exist on Windows XP and that is why it is Win 7+ minimum? Just guessing.

  8. #8
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: VB6 QUESTION: how to identify processes in the systray

    No. For Win XP, you need some additional effort to access to the overflow area, like clicking the triangle button (need testing).
    Also, a window class name sequence is a bit different.
    Also, functions in GetFilePathByPid() is uncompatible, need to use GetModuleFileNameEx and PROCESS_QUERY_INFORMATION flag for OpenProcess.
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

  9. #9

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: VB6 QUESTION: how to identify processes in the systray

    OK, so it is possible to do the same for XP, I will just see if I can adapt your code to cater for XP as well. Thanks for the code and the insights too. Really appreciated.

  10. #10
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: VB6 QUESTION: how to identify processes in the systray

    I'm a little confused. This is Windows 2000, where window sequence is a bit different.
    As about Overflow area, it is only appeared starting from Windows 7.
    Here is GetFilePathByPid(), updated to use in XP+:

    Code:
    
    Private Type RTL_OSVERSIONINFOEXW
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion(127) As Integer
        wServicePackMajor As Integer
        wServicePackMinor As Integer
        wSuiteMask As Integer
        wProductType As Byte
        wReserved As Byte
    End Type
    
    Public Declare Function RtlGetVersion Lib "ntdll.dll" (lpVersionInformation As RTL_OSVERSIONINFOEXW) As Long
    Public Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExW" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
    
    Public Const ERROR_PARTIAL_COPY            As Long = 299&
    Public Const ERROR_ACCESS_DENIED           As Long = 5&
    
    Public Function GetFilePathByPid(pid As Long) As String
    
        Dim hProc       As Long
        Dim ProcPath    As String
        Dim cnt         As Long
        Dim osi         As RTL_OSVERSIONINFOEXW
        Dim bIsWinVistaAndNewer As Boolean
    
        osi.dwOSVersionInfoSize = Len(osi)
        Call RtlGetVersion(osi)
        bIsWinVistaAndNewer = (osi.dwMajorVersion >= 6)
    
        hProc = OpenProcess(IIf(bIsWinVistaAndNewer, PROCESS_QUERY_LIMITED_INFORMATION, PROCESS_QUERY_INFORMATION) Or PROCESS_VM_READ, 0&, pid)
        If hProc = 0 Then
            If Err.LastDllError = ERROR_ACCESS_DENIED Then
                hProc = OpenProcess(IIf(bIsWinVistaAndNewer, PROCESS_QUERY_LIMITED_INFORMATION, PROCESS_QUERY_INFORMATION), 0&, pid)
            End If
        End If
    
        If hProc Then
            If bIsWinVistaAndNewer Then
                cnt = MAX_PATH + 1
                ProcPath = String$(cnt, 0&)
                Call QueryFullProcessImageName(hProc, 0&, StrPtr(ProcPath), VarPtr(cnt))
            End If
    
            If 0 <> Err.LastDllError Or Not bIsWinVistaAndNewer Then
                ProcPath = String$(MAX_PATH, 0&)
                cnt = GetModuleFileNameEx(hProc, 0&, StrPtr(ProcPath), Len(ProcPath))
            End If
    
            If ERROR_PARTIAL_COPY = Err.LastDllError Or cnt = 0 Then
                cnt = GetProcessImageFileName(hProc, StrPtr(ProcPath), Len(ProcPath))
            End If
            CloseHandle hProc
        End If
    
        If cnt <> 0 Then GetFilePathByPid = Left$(ProcPath, cnt)
    End Function
    
    During my testing, I saw a false positive, when you open Task Manager.
    I think it creates some invisible icons in Overflow area, so need to filter them.
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

  11. #11

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: VB6 QUESTION: how to identify processes in the systray

    I'll see what I can do - your help is really appreciated and unexpectedly complete! Thanks.

  12. #12

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: VB6 QUESTION: how to identify processes in the systray

    Dragokas, I do like the function GetIconHandles, it is nothing like anything I would have come up with myself. It is delving into areas I would never have dived... Is that code all yours? I found nothing like it in my searches. It just shows what VB6 can do given a brain behind the wheel. It is extremely useful and exactly what I wanted, kudos to you.

  13. #13
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: VB6 QUESTION: how to identify processes in the systray

    It is a port from one complex x64 AutoIt utility.
    You are sending TB_GETBUTTON message pointing the result buffer to the address space of a requested application, otherwise, msg will fail.
    Further, you are using undoc. fileld dwData having a ptr to icon's window handle.

    I think the task could be solved in much simple way. You just need to enum all windows (including the child)
    and check for the properties related to those icons are holding.
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

  14. #14

    Thread Starter
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: VB6 QUESTION: how to identify processes in the systray

    That is actually very similar to what I did originally, checking against a list of known apps and comparing the Window's caption text but I did not have a method of determining whether the process was actually in the systray or not.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width