| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 529 人关注过本帖
标题:麻烦帮我改改这个去除指定程序托盘图标
只看楼主 加入收藏
zjh495208501
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2011-11-27
结帖率:0
收藏
 问题点数:0 回复次数:0 
麻烦帮我改改这个去除指定程序托盘图标
Option Explicit  
  
'*************************************************************************   
'**模块用途:去除系统托盘中的无效图标。   
'*************************************************************************   
'托盘ICON   
Private Const NIF_ICON = &H2    '允许图标显示   
Private Const NIF_MESSAGE = &H1 '允许图标消息转发   
Private Const NIF_TIP = &H4     '允许图标显示图标提示字符串   
Private Const NIM_DELETE = &H2  '删除图标   
'托盘BOTTON   
Private Const WM_USER = &H400  
Private Const TBSTATE_HIDDEN = &H8  
Private Const TB_BUTTONCOUNT As Long = (WM_USER + 24)  
Private Const TB_GETBUTTON As Long = (WM_USER + 23)  
'进程读写   
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000  
Private Const SYNCHRONIZE As Long = &H100000  
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)  
'内存读写参数   
Private Const MEM_COMMIT As Long = &H1000  
Private Const PAGE_READWRITE As Long = &H4  
'托盘   
Private Type NOTIFYICONDATA  
    cbSize           As Long  
    hWnd             As Long  
    uid              As Long  
    uFlags           As Long  
    uCallBackMessage As Long  
    hIcon            As Long  
    szTip            As String * 64  
End Type  
'Botton结构   
Private Type TBBUTTON  
    iBitmap         As Long  
    idCommand       As Long  
    fsState         As Byte  
    fsStyle         As Byte  
    bReserved1      As Byte  
    bReserved2      As Byte  
    dwData          As Long  
    iString         As Long  
End Type  
'没有公开的TRAYDATA结构   
Private Type TRAYDATA  
    hWnd              As Long  
    uid               As Long  
    uCallBackMessage  As Long  
    Reserved1(0 To 1) As Long  
    hIcon             As Long  
    Reserved2(0 To 5) As Integer  
    ExePath(0 To 255) As Byte  
End Type  
'自定义结构   
Private Type TrayItemInfo  
    hWnd             As Long  
    uid              As Long  
    hIcon            As Long  
    uCallBackMessage As Long  
    sTip             As String  
    sProcessPath     As String  
    lIdCommand       As Long  
    bVisible         As Boolean  
    IsSetHide        As Boolean  
End Type  
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  
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long  
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long  
Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long  
Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long  
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long  
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long  
'*************************************************************************   
'**函 数 名:已知对象句柄,获得进程 ID   
'*************************************************************************   
Private Function GetObjectProcessID(ByVal ObjectHandle As Long) As Long  
    Dim lRnt As Long, lPid As Long  
    lRnt = GetWindowThreadProcessId(ObjectHandle, lPid)  
    GetObjectProcessID = lPid  
End Function  
'*************************************************************************   
'**函 数 名:得到系统托盘句柄   
'*************************************************************************   
Private Function FindSysTray() As Long  
    Dim hTrayWnd As Long  
    hTrayWnd = FindWindow("Shell_TrayWnd", vbNullString)  
    If hTrayWnd <> 0 Then  
        hTrayWnd = FindWindowEx(hTrayWnd, 0, "TrayNotifyWnd", vbNullString)  
        hTrayWnd = FindWindowEx(hTrayWnd, 0, "SysPager", vbNullString)  
        If hTrayWnd <> 0 Then  
            hTrayWnd = FindWindowEx(hTrayWnd, 0, "ToolbarWindow32", vbNullString)  
        End If  
    End If  
    FindSysTray = hTrayWnd  
End Function  
'*************************************************************************   
'**函 数 名:转换BYTE数组 及 去除最后的"\0"。   
'*************************************************************************   
Private Function DelEndNull(ByVal sSrc As String) As String  
    Dim lNullpos As Long  
    lNullpos = InStr(sSrc, Chr$(0))  
    If lNullpos > 0 Then  
        DelEndNull = Left$(sSrc, lNullpos - 1)  
    Else  
        DelEndNull = sSrc  
    End If  
End Function  
'*************************************************************************   
'**过 程 名:去除系统托盘中的无效图标。   
'*************************************************************************   
Public Sub RemoveDisabledTrayIcon()  
    Dim udtTb            As TBBUTTON  
    Dim udtTray          As TRAYDATA  
    Dim udtTifo          As TrayItemInfo  
    Dim m_aTrayinfo()    As TrayItemInfo  
    Dim udtIconData      As NOTIFYICONDATA  
    Dim m_hTrayWnd       As Long  
    Dim lTrayPid         As Long  
    Dim lCount           As Long  
    Dim lRet             As Long  
    Dim hProcess         As Long  
    Dim lAddress         As Long  
    Dim asTip(0 To 1024) As Byte  
    Dim sTip             As String  
    Dim I                As Integer  
    m_hTrayWnd = FindSysTray()  
    lRet = GetWindowThreadProcessId(m_hTrayWnd, lTrayPid)  
    lCount = SendMessage(m_hTrayWnd, TB_BUTTONCOUNT, 0, ByVal 0&)  
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, lTrayPid)  
    lAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal 4096&, MEM_COMMIT, PAGE_READWRITE)  
    For I = 0 To lCount - 1  
        lRet = SendMessage(m_hTrayWnd, TB_GETBUTTON, ByVal I, ByVal lAddress&)  
        lRet = ReadProcessMemory(hProcess, ByVal lAddress, ByVal VarPtr(udtTb), ByVal Len(udtTb), ByVal 0&)  
        lRet = ReadProcessMemory(hProcess, ByVal udtTb.dwData, ByVal VarPtr(udtTray), ByVal Len(udtTray), ByVal 0&)  
        udtTifo.sProcessPath = DelEndNull(udtTray.ExePath)  
        If Not CBool((udtTb.fsState And TBSTATE_HIDDEN)) Then  
            lRet = ReadProcessMemory(hProcess, ByVal udtTb.iString, ByVal VarPtr(asTip(0)), ByVal 1024, ByVal 0&)  
            sTip = DelEndNull(asTip)  
        Else  
            sTip = "[Hidden Icon]"  
        End If  
        With udtTifo  
            .sTip = Trim(sTip)  
            .hWnd = udtTray.hWnd  
            .uCallBackMessage = udtTray.uCallBackMessage  
            .uid = udtTray.uid  
            .bVisible = Not CBool((udtTb.fsState And TBSTATE_HIDDEN))  
            .hIcon = udtTray.hIcon  
        End With  
        ReDim Preserve m_aTrayinfo(0 To I)  
        m_aTrayinfo(I) = udtTifo  
    Next  
    CloseHandle hProcess  
    For I = 0 To UBound(m_aTrayinfo)  
        If GetObjectProcessID(m_aTrayinfo(I).hWnd) = 0 Then  
            With udtIconData  
                .cbSize = Len(udtIconData)  
                .hIcon = m_aTrayinfo(I).hIcon  
                .hWnd = m_aTrayinfo(I).hWnd  
                .szTip = m_aTrayinfo(I).sTip  
                .uCallBackMessage = m_aTrayinfo(I).uCallBackMessage  
                '*注:这要hIcon、szTip、uCallBackMessage对应相对应的值。这里我默认三者都有!   
                .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP  
                .uid = m_aTrayinfo(I).uid  
            End With  
            Call Shell_NotifyIcon(NIM_DELETE, udtIconData) '*注:删除已不存在的进程的图标!   
        End If  
    Next  
End Sub  


上面这个是清除所有无效的图标,这个清除图标后图标位置也去掉了,但是就是不会改成清楚指定的图标。。。。。


下面这段代码可以隐藏图标,但是隐藏后,图标位置还保留一个空格去不掉,只隐藏不能彻底清除


麻烦给帮我看看怎么改,帮我修改一下,谢谢!




Option Explicit
Private Const WM_USER = &H400
Private Const TB_BUTTONCOUNT = (WM_USER + 24)
Private Const TB_HIDEBUTTON = (WM_USER + 4)
Private Const TB_GETBUTTONTEXTA = (WM_USER + 45)
Private Const TB_AUTOSIZE = (WM_USER + 33)

Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_RELEASE = &H8000
Private Const TB_ADDBUTTONS = (WM_USER + 20)
Private Const PAGE_READWRITE = &H4
Private Const PROCESS_VM_OPERATION = (&H8)
Private Const PROCESS_VM_READ = (&H10)
Private Const PROCESS_VM_WRITE = (&H20)
Const TB_ENABLEBUTTON = (WM_USER + 1)
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) 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 GetCurrentProcessId Lib "kernel32" () As Long

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private nfIconData As NOTIFYICONDATA
Const MAX_TOOLTIP As Integer = 64
Const NIF_ICON = &H2
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const NIM_ADD = &H0
Const NIM_DELETE = &H2
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_LBUTTONDBLCLK = &H203
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDBLCLK = &H206
Const SW_RESTORE = 9
Const SW_HIDE = 0
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type


Private Sub Command1_Click()
    Dim pIdExplorer As Long, hwnd2 As Long, hExplorer As Long, lpIconText As Long
    Dim i As Integer
    Dim BtnCount As Integer
    Dim IconText As String

    hwnd2 = FindWindow("Shell_TrayWnd", vbNullString)
    hwnd2 = FindWindowEx(hwnd2, 0, "TrayNotifyWnd", vbNullString)
    hwnd2 = FindWindowEx(hwnd2, 0, "SysPager", vbNullString)
    hwnd2 = FindWindowEx(hwnd2, 0, "ToolbarWindow32", vbNullString)

    GetWindowThreadProcessId hwnd2, pIdExplorer
    hExplorer = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pIdExplorer)
    lpIconText = VirtualAllocEx(ByVal hExplorer, ByVal 0&, Len(IconText), MEM_COMMIT Or MEM_RESERVE, PAGE_READWRITE)

    BtnCount = SendMessage(hwnd2, TB_BUTTONCOUNT, 0, 0)

    Dim lLen As Long, sBuff As String
    For i = 0 To BtnCount - 1

        IconText = Space$(256)
        lLen = SendMessage(hwnd2, TB_GETBUTTONTEXTA, i, ByVal lpIconText)
        ReadProcessMemory hExplorer, ByVal lpIconText, ByVal IconText, Len(IconText), 0
        If lLen <> -1 Then IconText = Left$(IconText, InStr(1, IconText, Chr$(0)) - 1)
        Debug.Print IconText
         If (InStr(1, IconText, "音量", 1) > 0) Then

        'If IconText = "音量" Then

            Dim a

            a = SendMessage(hwnd2, TB_HIDEBUTTON, i, False)
            SendMessage hwnd2, TB_AUTOSIZE, 0, 0
            Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
        End If
    Next
    VirtualFreeEx hExplorer, lpIconText, Len(IconText), MEM_RELEASE
    CloseHandle hExplorer
End Sub
搜索更多相关主题的帖子: 托盘 系统托盘 字符串 
2012-08-23 15:12
快速回复:麻烦帮我改改这个去除指定程序托盘图标
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.017136 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved