Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1619
  • Last Modified:

Hide specific system tray icons

Is there any way I can use VB to hide a specific system tray icon?  I found this API code that will hide the whole collection of tray icons, but I can't seem to figure out how to pull a single icon out of this so I can hide it.

Public Function HideTaskBarIcons()
    Dim FindClass As Long, Handle As Long
    FindClass& = FindWindow("Shell_TrayWnd", "")
    Handle& = FindWindowEx(FindClass&, 0, "TrayNotifyWnd", vbNullString)
    ShowWindow Handle&, 0
End Function

I also found this code that I think I can modify to do what I want, but I haven't figured out how exactly to get the buttons to hide.  I had to modify the API calls like this to get the list to work:
   http://www.visualbasiccode.com/Asp/showsn.asp?theID=11610

    hWndTray = FindWindow("Shell_TrayWnd", vbNullString)
    hWndTray2 = FindWindowEx(hWndTray, 0, "TrayNotifyWnd", vbNullString)
    hWndTray3 = FindWindowEx(hWndTray2, 0, "SysPager", vbNullString)
    hWndToolBar = FindWindowEx(hWndTray3, 0, "ToolbarWindow32", vbNullString)

I tried adding a For..Next loop to go through all the buttons, it finds the button I want to hide, but I haven't figured out how exactly to hide it.  Either that, or the system tray needs to be refreshed or something after it's hidden.
        Dim Ob As IAccessible
        AccessibleObjectFromWindow ByVal hWndToolBar, OBJID_CLIENT, UID1, Ob

        For iBtnIndex = 0 To iTrayButtonsCount
            If Ob.accName(Av(iBtnIndex)) = "PeerGuardian" Then
                SendMessage hWndToolBar&, TB_HIDEBUTTON, iBtnIndex, 0
                SendMessage hWndToolBar&, TB_SAVERESTOREA, True, vbNull
            End If
        Next iBtnIndex
0
Crash2100
Asked:
Crash2100
  • 4
  • 4
1 Solution
 
ArkCommented:
Hi

'Note - project require reference to MS Common Controls 6
'====================mIcons.bas====================
'To convert hBitmap and/or hIcon to StdPicture for adding to VB ImageList.
'Also call standard windows PickIcon dialog.

Option Explicit

Public Enum ICON_SIZE
    ICON_SMALL
    ICON_LARGE
End Enum

Private Type PictDesc
    cbSizeofStruct As Long
    PicType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type

Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As _
PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Public Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long

Private Declare Function ExtractIconEx Lib "Shell32" Alias "ExtractIconExA" _
        (ByVal szFile As String, ByVal nIconIndex As Long, phIconLarge As Long, _
        phIconSmall As Long, ByVal nIcons As Long) As Long

Private Declare Function SHChangeIconDialog Lib "Shell32" Alias "#62" _
        (ByVal hOwner As Long, ByVal szFilename As String, _
        ByVal Reserved As Long, lpIconIndex As Long) As Long
Const MAX_PATH = 260

Public Function IconToPicture(ByVal hIcon As Long) As StdPicture
    If hIcon = 0 Then Exit Function
    Dim oNewPic As Picture
    Dim tPicConv As PictDesc
    Dim IGuid As Guid
    With tPicConv
       .cbSizeofStruct = Len(tPicConv)
       .PicType = vbPicTypeIcon
       .hImage = hIcon
    End With
    With IGuid
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
    Set IconToPicture = oNewPic
End Function

Public Function BitmapToPicture(ByVal hBmp As Long) As StdPicture
    Dim oNewPic As Picture, tPicConv As PictDesc, IGuid As Guid
    With tPicConv
       .cbSizeofStruct = Len(tPicConv)
       .PicType = vbPicTypeBitmap
       .hImage = hBmp
    End With
    With IGuid
       .Data1 = &H20400
       .Data4(0) = &HC0
       .Data4(7) = &H46
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
    Set BitmapToPicture = oNewPic
End Function

Public Function GetIconFromDialog(Optional IconSize As ICON_SIZE = ICON_SMALL) As Long
   Dim sFileName As String
   Dim nIconIdx As Long, hSmallIcon As Long, hLargeIcon As Long
   sFileName = String(MAX_PATH, 0)
   If SHChangeIconDialog(0, sFileName, MAX_PATH, nIconIdx) Then
      If IsWindowsNT Then sFileName = StrConv(sFileName, vbFromUnicode)
      If ExtractIconEx(sFileName, nIconIdx, hLargeIcon, hSmallIcon, 1) > 0 Then
         If IconSize = ICON_SMALL Then
            GetIconFromDialog = CopyIcon(hSmallIcon)
         Else
            GetIconFromDialog = CopyIcon(hLargeIcon)
         End If
         DestroyIcon hSmallIcon
         DestroyIcon hLargeIcon
      End If
   End If
End Function

'=======mProcesses9x.bas==============
'To retrive ExeName from hWnd under Win9x OS

Option Explicit

Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Long = 260

Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwflags As Long
    szexeFile As String * MAX_PATH
End Type

Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlgas As Long, ByVal lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

Public Function GetExeFromHandle(hWnd As Long) As String
    Dim threadID As Long, processID As Long, hSnapshot As Long
    Dim uProcess As PROCESSENTRY32, rProcessFound As Long
    Dim i As Integer, szExename As String
    threadID = GetWindowThreadProcessId(hWnd, processID)
    If threadID = 0 Or processID = 0 Then Exit Function
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    If hSnapshot = -1 Then Exit Function
    uProcess.dwSize = Len(uProcess)
    rProcessFound = ProcessFirst(hSnapshot, uProcess)
    Do While rProcessFound
        If uProcess.th32ProcessID = processID Then
            i = InStr(1, uProcess.szexeFile, Chr(0))
            If i > 0 Then szExename = Left$(uProcess.szexeFile, i - 1)
            Exit Do
        Else
            rProcessFound = ProcessNext(hSnapshot, uProcess)
        End If
    Loop
    Call CloseHandle(hSnapshot)
    GetExeFromHandle = szExename
End Function

'=============mSharedMemory.bas========
'SharingMemory between processes

Option Explicit
Public Enum OS_VER
    Win32
    Win95
    Win98
    WinME
    WinNT
    Win2K
    WinXP
    Win2003
End Enum
'=========Checking OS staff=============
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long

'========= Win95/98/ME Shared memory staff===============
Private Declare Function CreateFileMapping Lib "Kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "Kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "Kernel32" (lpBaseAddress As Any) As Long
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SECTION_QUERY = &H1
Const SECTION_MAP_WRITE = &H2
Const SECTION_MAP_READ = &H4
Const SECTION_MAP_EXECUTE = &H8
Const SECTION_EXTEND_SIZE = &H10
Const SECTION_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SECTION_QUERY Or SECTION_MAP_WRITE Or SECTION_MAP_READ Or SECTION_MAP_EXECUTE Or SECTION_EXTEND_SIZE
Const FILE_MAP_ALL_ACCESS = SECTION_ALL_ACCESS

Private Const PAGE_NOACCESS = &H1&
Private Const PAGE_READONLY = &H2&
Private Const PAGE_READWRITE = &H4&
Private Const PAGE_WRITECOPY = &H8&
Private Const PAGE_EXECUTE = &H10&
Private Const PAGE_EXECUTE_READ = &H20&
Private Const PAGE_EXECUTE_READWRITE = &H40&
Private Const PAGE_EXECUTE_WRITECOPY = &H80&
Private Const PAGE_GUARD = &H100&
Private Const PAGE_NOCACHE = &H200&

'============NT Shared memory staff======================
Public Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Const PROCESS_VM_OPERATION = &H8
Public Const PROCESS_VM_READ = &H10
Public Const PROCESS_VM_WRITE = &H20
Public Const PROCESS_ALL_ACCESS = 0

Const MEM_COMMIT = &H1000
Const MEM_RESERVE = &H2000
Const MEM_DECOMMIT = &H4000
Const MEM_RELEASE = &H8000&
Const MEM_FREE = &H10000
Const MEM_PRIVATE = &H20000
Const MEM_MAPPED = &H40000
Const MEM_TOP_DOWN = &H100000

Private 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
Private Declare Function VirtualFreeEx Lib "Kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Public WinVer As OS_VER

Public Function GetMemShared95(ByVal memSize As Long, hFile As Long) As Long
    If hFile = 0 Then
       hFile = CreateFileMapping(&HFFFFFFFF, 0, PAGE_READWRITE, 0, memSize, vbNullString)
    End If
    GetMemShared95 = MapViewOfFile(hFile, FILE_MAP_ALL_ACCESS, 0, 0, 0)
End Function

Public Sub FreeMemShared95(ByVal hFile As Long, ByVal lpMem As Long, Optional bCloseHandle As Boolean)
    UnmapViewOfFile lpMem
    If bCloseHandle Then CloseHandle hFile
End Sub

Public Function GetMemSharedNT(ByVal pid As Long, ByVal memSize As Long, hProcess As Long) As Long
    If hProcess = 0 Then
       hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
    End If
    GetMemSharedNT = VirtualAllocEx(ByVal hProcess, ByVal 0&, ByVal memSize, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
End Function

Public Sub FreeMemSharedNT(ByVal hProcess As Long, ByVal MemAddress As Long, ByVal memSize As Long, Optional bCloseProcess As Boolean)
   Call VirtualFreeEx(hProcess, ByVal MemAddress, memSize, MEM_RELEASE)
   If bCloseProcess Then CloseHandle hProcess
End Sub

Public Function IsWindowsNT() As Boolean
   If WinVer = 0 Then GetWinVer
   IsWindowsNT = (WinVer > WinME)
End Function

Public Sub GetWinVer()
   Dim verinfo As OSVERSIONINFO
   verinfo.dwOSVersionInfoSize = Len(verinfo)
   If (GetVersionEx(verinfo)) = 0 Then Exit Sub
   With verinfo
      Select Case .dwPlatformId
         Case 0: WinVer = Win32
         Case 1 'Win9x
             Select Case .dwMinorVersion
                Case 0:  WinVer = Win95
                Case 10: WinVer = Win98
                Case 90: WinVer = WinME
             End Select
         Case 2
             If .dwMajorVersion < 5 Then
                WinVer = WinNT
             Else
                Select Case .dwMinorVersion
                   Case 0: WinVer = Win2K
                   Case 1: WinVer = WinXP
                   Case 2: WinVer = Win2003
                End Select
             End If
      End Select
   End With
End Sub

'==============mTray.bas==============
'Main module
Option Explicit

'Human readable tray icon data
Public Type TRAY_ICON_INFO
    hWnd As Long
    uID As Long
    uCallbackMessage As Long
    uFlags As Long
    iImage As Long
    hIcon As Long
    idCommand As Long
    dwState As Long
    dwStyle As Long
    sTip As String
    sExecutable As String
End Type

'Array of tray icons
Public Type TRAY_INFO
    nCount As Long
    hImageList As Long
    TII() As TRAY_ICON_INFO
End Type

'Internal tray icon info (almost same as NOTYFYICONDATA)
Public Type ICON_INFO
   hWnd As Long
   uID As Long
   uCallbackMessage As Long
   uFlags As Long
   dwUnknown As Long
   hIcon As Long
   lpszTip As Long 'String * 64
   dwState As Long
   dwStateMask As Long
   lpszInfo As String * 256
   dwUnion As Long
   lpszInfoTitle As Long 'String * 64
   dwInfoFlags As Long
End Type

'Real structure
Public Type NOTIFYICONDATA
   cbSize As Long
   hWnd As Long
   uID As Long
   uFlags As Long
   uCallbackMessage As Long
   hIcon As Long
   szTip As String * 128
   dwState As Long
   dwStateMask As Long
   szInfo As String * 256
   uTimeoutOrVersion As Long
   szInfoTitle As String * 64
   dwInfoFlags As Long
End Type

Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
Public Const NIF_STATE = 8
Public Const NIF_ALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP Or NIF_STATE
Public Const NIS_HIDDEN = 1
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Private Type TBBUTTONINFO ''Toolbar button info
   cbSize As Long
   dwMask As Long
   idCommand As Long
   iImage As Long
   fsState As Byte
   fsStyle As Byte
   cx As Integer
   lParam As Long  'for TrayNotyfy it's a pointer to NOTIFYICONDATA structure
   pszText As String
   cchText As Long
End Type
'UDT for retriving ToolTip text
Private Type TOOLTEXT
   sTipText As String * 80
End Type

Public Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageW Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "Kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "Kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
'Private Declare Function GetImageCount Lib "comctl32" Alias "ImageList_GetImageCount" (ByVal p As Long) As Long
Private Declare Sub ZeroMemory Lib "Kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
 
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
                         (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400&
Private Const TB_BUTTONCOUNT = (WM_USER + 24)
Private Const TB_GETBUTTONINFOW = (WM_USER + 63)
Private Const TB_GETBUTTONINFOA = (WM_USER + 65)
Private Const TB_GETIMAGELIST = (WM_USER + 49)
Private Const TB_GETBUTTONTEXTA = (WM_USER + 45)
Private Const TB_GETBUTTONTEXTW = (WM_USER + 75)

Private Const TBIF_IMAGE = &H1
Private Const TBIF_TEXT = &H2
Private Const TBIF_STATE = &H4
Private Const TBIF_STYLE = &H8
Private Const TBIF_LPARAM = &H10
Private Const TBIF_COMMAND = &H20
Private Const TBIF_SIZE = &H40
Private Const TBIF_ALL = TBIF_IMAGE Or TBIF_STATE Or _
                         TBIF_STYLE Or TBIF_LPARAM Or TBIF_COMMAND _
                         Or TBIF_SIZE 'Or TBIF_TEXT

Private Const TBIF_BYINDEX = &H80000000
Dim bInit As Boolean

Public Function GetTrayWnd() As Long
  GetTrayWnd = FindWindow("Shell_TrayWnd", vbNullString)
End Function

Public Function GetTrayNotifyWnd() As Long
  GetTrayNotifyWnd = FindWindowEx(GetTrayWnd, 0, "TrayNotifyWnd", vbNullString)
End Function

Public Function GetTraySysPager() As Long
  GetTraySysPager = FindWindowEx(GetTrayNotifyWnd, 0, "SysPager", vbNullString)
End Function

Public Function GetTrayNotifyToolBar() As Long
  Dim hParent As Long
  If WinVer = 0 Then GetWinVer
  If WinVer >= WinXP Then
     hParent = GetTraySysPager
  ElseIf ((WinVer = Win2K) Or (WinVer = WinME)) Then
     hParent = GetTrayNotifyWnd
  Else
     Exit Function
  End If
  GetTrayNotifyToolBar = FindWindowEx(hParent, 0, "ToolbarWindow32", vbNullString)
End Function

Public Function GetTrayIconCount() As Long
   Dim hTB As Long
   hTB = GetTrayNotifyToolBar
   GetTrayIconCount = SendMessageA(hTB, TB_BUTTONCOUNT, 0, ByVal 0&)
End Function

Public Function GetTrayInfo() As TRAY_INFO
   Dim hTB As Long
   Dim nCount As Long, i As Long, j As Long
   Dim tbi As TBBUTTONINFO
   Dim ti As TRAY_INFO
   Dim ii As ICON_INFO
   Dim tt As TOOLTEXT
   Dim tid As Long, pid As Long
   Dim hProcess As Long, lWritten As Long
   Dim hMapping As Long, hMapping2 As Long
   Dim lpSysShared As Long     'Shared memory pointer for TBBUTTONINFO
   Dim lpSysSharedTIP As Long  'Shared memory pointer for ToolTip
   
   hTB = GetTrayNotifyToolBar
   If hTB = 0 Then Exit Function 'Check if tray toolbar exists
   
   nCount = GetTrayIconCount
   If nCount = 0 Then Exit Function 'Check if icons exists
   
   ti.nCount = nCount
   ti.hImageList = SendMessageA(hTB, TB_GETIMAGELIST, 0, ByVal 0&)
   ReDim ti.TII(nCount - 1)
   tbi.cbSize = Len(tbi)
   tbi.dwMask = TBIF_ALL Or TBIF_BYINDEX
   tbi.cchText = Len(tt)
   tid = GetWindowThreadProcessId(hTB, pid)
   If IsWindowsNT Then
      lpSysShared = GetMemSharedNT(pid, Len(tbi), hProcess)
      lpSysSharedTIP = GetMemSharedNT(pid, Len(tt), hProcess)
      WriteProcessMemory hProcess, ByVal lpSysShared, tbi, Len(tbi), lWritten
      WriteProcessMemory hProcess, ByVal lpSysSharedTIP, tt, Len(tt), lWritten
      For i = 0 To nCount - 1
          Call SendMessageA(hTB, TB_GETBUTTONINFOA, i, ByVal lpSysShared)
          Call ReadProcessMemory(hProcess, ByVal lpSysShared, tbi, Len(tbi), lWritten)
          Call ReadProcessMemory(hProcess, ByVal tbi.lParam, ii, Len(ii), lWritten)
          Call SendMessageA(hTB, TB_GETBUTTONTEXTA, tbi.idCommand, ByVal lpSysSharedTIP)
          Call ReadProcessMemory(hProcess, ByVal lpSysSharedTIP, tt, Len(tt), lWritten)
          With ti.TII(i)
            .dwState = tbi.fsState
            .dwStyle = tbi.fsStyle
            .hIcon = ii.hIcon
            .hWnd = ii.hWnd
            .idCommand = tbi.idCommand
            .iImage = tbi.iImage
            .sExecutable = TrimNULL(StrConv(ii.lpszInfo, vbFromUnicode))
            .sTip = TrimNULL(tt.sTipText)
            .uCallbackMessage = ii.uCallbackMessage
            .uFlags = ii.uFlags / &H100000
            .uID = ii.uID
          End With
      Next i
      FreeMemSharedNT hProcess, lpSysShared, Len(tbi)
      FreeMemSharedNT hProcess, lpSysSharedTIP, Len(tt), True
   Else
      lpSysShared = GetMemShared95(Len(tbi), hMapping)
      lpSysSharedTIP = GetMemShared95(Len(tt), hMapping2)
      hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
      For i = 0 To nCount - 1
          CopyMemory ByVal lpSysShared, tbi, Len(tbi)
          Call SendMessageA(hTB, TB_GETBUTTONINFOA, i, ByVal lpSysShared)
          CopyMemory tbi, ByVal lpSysShared, Len(tbi)
          Call ReadProcessMemory(hProcess, ByVal tbi.lParam, ii, Len(ii), lWritten)
          CopyMemory ByVal lpSysSharedTIP, tt, Len(tt)
          Call SendMessageA(hTB, TB_GETBUTTONTEXTA, tbi.idCommand, ByVal lpSysSharedTIP)
          CopyMemory tt, ByVal lpSysSharedTIP, Len(tt)
          With ti.TII(i)
            .dwState = tbi.fsState
            .dwStyle = tbi.fsStyle
            .hIcon = CopyIcon(ii.hIcon)
            .hWnd = ii.hWnd
            .idCommand = tbi.idCommand
            .iImage = tbi.iImage
            .sExecutable = GetExeFromHandle(.hWnd)
            .sTip = TrimNULL(tt.sTipText)
            .uCallbackMessage = ii.uCallbackMessage
            .uFlags = ii.uFlags / &H100000
            .uID = ii.uID
          End With
      Next i
      FreeMemShared95 hMapping, lpSysShared
      FreeMemShared95 hMapping2, lpSysSharedTIP, True
      CloseHandle hProcess
   End If
   GetTrayInfo = ti
End Function

Public Function TrimNULL(startstr As String) As String
   Dim pos As Integer
   pos = InStr(startstr, Chr$(0))
   If pos Then
      TrimNULL = Left$(startstr, pos - 1)
      Exit Function
   End If
   TrimNULL = startstr
End Function

'===========Form code==========
'Copy/Paste this code into notepad and save as Form1.frm
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3630
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   9375
   LinkTopic       =   "Form1"
   ScaleHeight     =   3630
   ScaleWidth      =   9375
   StartUpPosition =   3  'Windows Default
   Begin MSComctlLib.ImageList ImageList1
      Left            =   240
      Top             =   2520
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      UseMaskColor    =   0   'False
      _Version        =   393216
   End
   Begin MSComctlLib.ListView ListView1
      Height          =   2055
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   9015
      _ExtentX        =   15901
      _ExtentY        =   3625
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Menu mnuTray
      Caption         =   "&Tray"
      Begin VB.Menu mnuRefresh
         Caption         =   "&Refresh"
      End
      Begin VB.Menu mnuEdit
         Caption         =   "&Edit"
         Begin VB.Menu mnuDelete
            Caption         =   "&Delete"
         End
         Begin VB.Menu mnuHide
            Caption         =   "&Hide"
         End
         Begin VB.Menu mnuShow
            Caption         =   "&Show"
         End
         Begin VB.Menu mnuModify
            Caption         =   "&Modify"
            Begin VB.Menu mnuModifyToolTip
               Caption         =   "&Tooltip"
            End
            Begin VB.Menu mnuModifyIcon
               Caption         =   "&Icon"
            End
         End
      End
      Begin VB.Menu sep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

Dim ti As TRAY_INFO

Private Sub EnumTray()
   Dim i As Long
   Dim pic As StdPicture
   Dim nIcon As Long
   Dim idx As Long
   Dim li As ListItem
       
   idx = 1
   Set li = ListView1.SelectedItem
   If Not li Is Nothing Then idx = ListView1.SelectedItem.Index
   Set li = Nothing
   ListView1.ListItems.Clear
   Set ListView1.SmallIcons = Nothing
   ImageList1.ListImages.Clear
   ImageList1.ImageWidth = 16
   ImageList1.ImageHeight = 16
   ImageList1.ListImages.Add , , Me.Icon
   Set ListView1.SmallIcons = ImageList1
   ti = GetTrayInfo
   For i = 0 To ti.nCount - 1
      Set pic = IconToPicture(ti.TII(i).hIcon)
      If Not pic Is Nothing Then
         ImageList1.ListImages.Add , , pic
         nIcon = ImageList1.ListImages.Count
         Set pic = Nothing
      Else
         nIcon = 0
      End If
      With ListView1.ListItems.Add(, , ti.TII(i).sExecutable, , nIcon)
           .ToolTipText = ti.TII(i).sTip
           .SubItems(1) = ti.TII(i).hWnd
           .SubItems(2) = ti.TII(i).uID
           .SubItems(3) = ti.TII(i).uCallbackMessage & " (0x" & Hex(ti.TII(i).uCallbackMessage) & ")" 'GetStyle(ti.TII(i).dwStyle)
           .SubItems(4) = GetState(ti.TII(i).dwState)
      End With
   Next i
   If idx > ListView1.ListItems.Count - 1 Then idx = ListView1.ListItems.Count - 1
   ListView1.ListItems(idx).Selected = True
   ListView1.ListItems(idx).EnsureVisible
End Sub

Private Sub Form_Load()
  Caption = "Who lives in my system tray?"
  Icon = IconToPicture(LoadIcon(0, 32514))
  ListView1.View = lvwReport
  ListView1.ColumnHeaders.Add , , "Icon and Executable", 4500
  ListView1.ColumnHeaders.Add , , "hWnd", 1000, 1
  ListView1.ColumnHeaders.Add , , "uID", 1000, 1
  ListView1.ColumnHeaders.Add , , "Callback msg", 1500, 2
  ListView1.ColumnHeaders.Add , , "State", 1500, 1
  Me.Width = 10000
  EnumTray
End Sub

Private Sub Form_Resize()
   If WindowState = vbMinimized Then Exit Sub
   ListView1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub ListView1_DblClick()
   Const WM_LBUTTONDBLCLK = &H203
   With ti.TII(ListView1.SelectedItem.Index - 1)
        Call SetForegroundWindow(.hWnd)
        SendMessageA .hWnd, .uCallbackMessage, 0, ByVal WM_LBUTTONDBLCLK
   End With
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   Dim li As ListItem
   Const WM_RBUTTONUP = &H205
   If Button = vbRightButton Then
      Set li = ListView1.HitTest(x, y)
      If Not li Is Nothing Then
         li.Selected = True
         With ti.TII(ListView1.SelectedItem.Index - 1)
            Call SetForegroundWindow(.hWnd)
            SendMessageA .hWnd, .uCallbackMessage, 0, ByVal WM_RBUTTONUP
         End With
'         CheckShowHide
'         PopupMenu mnuEdit
      End If
   End If
End Sub

Private Sub mnuDelete_Click()
   Dim nid As NOTIFYICONDATA
   nid.cbSize = Len(nid)
   With ti.TII(ListView1.SelectedItem.Index - 1)
        nid.hWnd = .hWnd
        nid.uID = .uID
   End With
   Shell_NotifyIcon NIM_DELETE, nid
   EnumTray
End Sub

Private Sub mnuEdit_Click()
   CheckShowHide
End Sub

Private Sub mnuExit_Click()
   Unload Me
End Sub

Private Sub mnuHide_Click()
   Dim nid As NOTIFYICONDATA
   nid.cbSize = Len(nid)
   With ti.TII(ListView1.SelectedItem.Index - 1)
        nid.hWnd = .hWnd
        nid.uID = .uID
        nid.uFlags = NIF_STATE
        nid.dwState = NIS_HIDDEN
        nid.dwStateMask = NIS_HIDDEN
   End With
   Shell_NotifyIcon NIM_MODIFY, nid
   EnumTray
End Sub

Private Sub mnuModifyIcon_Click()
   Dim nid As NOTIFYICONDATA
   Dim hIcon As Long
   nid.cbSize = Len(nid)
   With ti.TII(ListView1.SelectedItem.Index - 1)
        hIcon = GetIconFromDialog(ICON_SMALL)
        If hIcon = 0 Then Exit Sub
        nid.hWnd = .hWnd
        nid.uID = .uID
        nid.uFlags = NIF_ICON
        nid.hIcon = hIcon
   End With
   Shell_NotifyIcon NIM_MODIFY, nid
   EnumTray
End Sub

Private Sub mnuModifyToolTip_Click()
   Dim nid As NOTIFYICONDATA
   Dim sTip As String
   nid.cbSize = Len(nid)
   With ti.TII(ListView1.SelectedItem.Index - 1)
        sTip = InputBox("Enter new tooltip text:", "Modify tray icon tooltip", .sTip)
        If sTip = "" Then Exit Sub
        nid.hWnd = .hWnd
        nid.uID = .uID
        nid.uFlags = NIF_TIP
        nid.szTip = Trim(sTip) & Chr(0)
   End With
   Shell_NotifyIcon NIM_MODIFY, nid
   EnumTray
End Sub

Private Sub mnuRefresh_Click()
   EnumTray
End Sub

Private Sub mnuShow_Click()
   Dim nid As NOTIFYICONDATA
   nid.cbSize = Len(nid)
   With ti.TII(ListView1.SelectedItem.Index - 1)
        nid.hWnd = .hWnd
        nid.uID = .uID
        nid.uFlags = NIF_STATE
        nid.dwState = 0
        nid.dwStateMask = NIS_HIDDEN
   End With
   Shell_NotifyIcon NIM_MODIFY, nid
   EnumTray
End Sub

Private Sub CheckShowHide()
  Dim i As Integer
  mnuShow.Enabled = ((ti.TII(ListView1.SelectedItem.Index - 1).dwState And 8) = 8)
  mnuHide.Enabled = Not mnuShow.Enabled
End Sub

Private Function GetStyle(ByVal iStyle As Long) As String
   Dim sStyle As String
' Check for TBSTATE_ constants
   sStyle = "Button"
   If (iStyle And 1) = 1 Then sStyle = "Separator"
   If (iStyle And 2) = 2 Then sStyle = sStyle & ", Check"
   If (iStyle And 4) = 4 Then sStyle = sStyle & ", Group"
   If (iStyle And 8) = 8 Then sStyle = sStyle & ", DropDown"
   If (iStyle And 10) = 10 Then sStyle = sStyle & ", Autosize"
   If (iStyle And 20) = 20 Then sStyle = sStyle & ", No prefix"
   If (iStyle And 100) = 100 Then sStyle = sStyle & ", Tooltips"
   If (iStyle And 200) = 200 Then sStyle = sStyle & ", Wrappable"
   If (iStyle And 400) = 400 Then sStyle = sStyle & ", AltDrag"
   If (iStyle And 800) = 800 Then sStyle = sStyle & ", Flat"
   If (iStyle And 1000) = 1000 Then sStyle = sStyle & ", List"
   If (iStyle And 2000) = 2000 Then sStyle = sStyle & ", Custom erase"
   If (iStyle And 4000) = 4000 Then sStyle = sStyle & ", Register drop"
   If (iStyle And 8000) = 8000 Then sStyle = sStyle & ", Transparent"
   GetStyle = sStyle
End Function

Private Function GetState(ByVal iState As Long) As String
   Dim sState As String
' Check for TBSTATE_ constants
   If (iState And 1) = 1 Then sState = sState & ", Checked"
   If (iState And 2) = 2 Then sState = sState & ", Pressed"
   If (iState And 4) = 4 Then sState = sState & ", Enabled"
   If (iState And 8) = 8 Then sState = sState & ", Hidden"
   If (iState And 10) = 10 Then sState = sState & ", Inderterminate"
   If (iState And 20) = 20 Then sState = sState & ", Wrap"
   If (iState And 40) = 40 Then sState = sState & ", Ellipses"
   If (iState And 80) = 80 Then sState = sState & ", Marked"
   If Len(sState) > 0 Then GetState = Mid(sState, 3)
End Function

Private Sub mnuTray_Click()
   CheckShowHide
End Sub

0
 
Crash2100Author Commented:
That is really neat, is that something you wrote yourself?
0
 
ArkCommented:
Yes, I forgot to add copyrights :)
All code is mine. This version (with icon extraction) works for Win ME/2000/XP/2003 OS only. You can find my previous version (works on all OS, but can not extract icons into ListView - it uses a trick with Tray tooltips) at http://www.freevbcode.com/ShowCode.Asp?ID=3291
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
Crash2100Author Commented:
I managed to take the code you gave me and I came up with this function that shows and hides icons.  I was wondering, is there any way I can do this more simply, without having to include all of those modules?  Possibly with a SendMessage API call or something?  If not, it's ok, I'm just curious.

Private bIsIconVisible As Boolean

Private Sub SetTrayIconVisible(strEXEName As String, bVisible As Boolean)
   Dim ti As TRAY_INFO
   
   Dim i As Long
   Dim pic As StdPicture
   Dim nIcon As Long
   Dim idx As Long
   Dim li As ListItem
       
   idx = 1
   ti = GetTrayInfo
   For i = 0 To ti.nCount - 1
      If LCase(ti.TII(i).sExecutable) Like "*" & strEXEName Then
        Dim nid As NOTIFYICONDATA
        nid.cbSize = Len(nid)
       
        With ti.TII(i)
            nid.hWnd = .hWnd
            nid.uID = .uID
            nid.uFlags = NIF_STATE
            nid.dwState = 0
            nid.dwStateMask = NIS_HIDDEN
        End With
       
        nid.dwState = IIf(bVisible = True, NIS_SHOWING, NIS_HIDDEN)
        Shell_NotifyIcon NIM_MODIFY, nid
        'MsgBox "Sysdoc is " & IIf(bVisible = True, "showing", "hidden")
      End If
   Next i
   
End Sub
0
 
ArkCommented:
Hi
Youn need
 .hWnd, .uID and .sExecutable variables, so you can remove all other staff. Also, you can deal with NT OS only.
0
 
Crash2100Author Commented:
I don't care if it will only work with NT, I'm writing this for XP machines anyway.

What exactly do you mean remove everything but .hWnd, .uID and .sExecutable?  Remove the things from the TRAY_ICON_INFO type?

Basically, I'm trying to figure out if there's another way to do this with just a few lines of code, rather than having all the code in those four modules included in the project.  That's why I was wondering if you could do it with just a SendMessage API call or something.  I did try removing the modules one by one, but the way the code in them is all tied together, and I kept getting errors when I was trying to figure out how to isolate the code so it wouldn't require what was in the other module.
0
 
ArkCommented:
Hi
Actually, all my code use SendMessage API. The problem with interprocess memory communication is in the 4th member of this API  - lParam. When you don't use this member (TB_BUTTONCOUNT, for example) - everything is OK. But when you use it as a pounter to structure, which must be filled with this call (TB_GETBUTTONINFO) - there is a problem. The variable, holding this structure, declared in YOUR process and it's pointer belong to YOUR process memory space. Remote process (Shell in your case) have its own memory space, and same memory address may be empty or allocated with another variable/function code etc. So, SendMessage write TBBUTTON structure not in your process address, but in its own process. To use SendMessage in this case, you have to allocate enough memory in remote process, write initial structure there and pass this remote address to SendMessage. Then read structure back into your process and parse it parameters.

Pseudo code for your task for XP can be following:

1. Get Tray ToolBar hwnd:
    hTrayWnd = FindWindow("Shell_TrayWnd", vbNullString)
    hTrayNotifyWnd = FindWindowEx(hTrayWnd, 0, "TrayNotifyWnd", vbNullString)
    hTraySysPager = FindWindowEx(hTrayNotifyWnd, 0, "SysPager", vbNullString)
    hTB = FindWindowEx(hTraySysPager, 0, "ToolbarWindow32", vbNullString)

and check if there is ANY icon:
    nCount = SendMessage(hTB, TB_BUTTONCOUNT, 0, ByVal 0&) - exit from function if nCount = 0

2. Get Shell ProcessId:
    tid = GetWindowThreadProcessId(hTB, pid)

3. Open this process with required rights:
    hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)

4. Allocate memory for structures in remote process:
    Private Type TBBUTTONINFO ''Toolbar button info
       cbSize As Long
       dwMask As Long
       idCommand As Long
       iImage As Long
       fsState As Byte
       fsStyle As Byte
       cx As Integer
       lParam As Long  'for TrayNotyfy it's a pointer to NOTIFYICONDATA structure
       pszText As Long ' Not "As String" - Bug in previous declaration!
       cchText As Long
    End Type

    Dim tbi As TBBUTTONINFO
    tbiAddr = VirtualAllocEx(hProcess, 0, Len(tbi), MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)

5. Initialize structure and copy it to remote address. In your case all you need from structure is LPARAM (you don't need icon,text etc.):
    tbi.cbSize = Len(tbi)
    tbi.dwMask = TBIF_LPARAM Or TBIF_BYINDEX
    Call WriteProcessMemory(hProcess, ByVal tbiAddr, tbi, Len(tbi), lWritten)

6. In a For..Next loop for each button, call SendMessage, using REMOTE address and read info from remote address:
    Call SendMessage(hTB, TB_GETBUTTONINFO, i, ByVal tbiAddr)
    Call ReadProcessMemory(hProcess, ByVal tbiAddr, tbi, Len(tbi), lWritten)

7. As I found from memory investigation, tbi.lParam contain a pointer to NOTIFYICONDATA structure, so extract this structure from remote process:
    Call ReadProcessMemory(hProcess, ByVal tbi.lParam, ii, Len(ii), lWritten)

8. Now ii(ICONINFO) structure contain all info you need. You can collect these info into array (like in my sample) or check for sExecutable just here:
     sExecutable = TrimNULL(StrConv(ii.lpszInfo, vbFromUnicode))
     If LCase(ti.TII(i).sExecutable) Like "*" & strEXEName Then
' rest code

9. Free memory in remote process and close its handle:  
    VirtualFreeEx hProcess, ByVal tbiAddr, 0, MEM_RELEASE
    CloseHandle hProcess
0
 
Crash2100Author Commented:
Thanks for all the help!
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now