麻烦帮我改改这个去除指定程序托盘图标
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