Question

VB问题：如何根据进程名，来隐藏改程序的托盘图标？

比如“QQ.exe”吧，隐藏托盘中的小企鹅图标的VB源码？求高手！
也就是知道进程的名字，就能隐藏改程序在系统托盘的图标！
求高手，我百度了好几百遍了，也找不到特别合适的答案！
肯定可以实现，我在网上找到编译好的exe文件，也百分百确定是VB写的，那个文件就是只要输入进程名，就可以隐藏该程序的托盘图标！不过没有源码！
求源码！

Answer 1

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 PAGE_READWRITE = &H4

Private Const PROCESS_VM_OPERATION = (&H8)
Private Const PROCESS_VM_READ = (&H10)
Private Const PROCESS_VM_WRITE = (&H20)

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 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)
If IconText = List1.List(List1.ListIndex) Then ' "音量" Then
SendMessage hwnd2, TB_HIDEBUTTON, i, ByVal True
SendMessage hwnd2, TB_AUTOSIZE, 0, 0
End If
Next
VirtualFreeEx hExplorer, lpIconText, Len(IconText), MEM_RELEASE
CloseHandle hExplorer
End Sub

Private Sub Command2_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)
If IconText = List1.List(List1.ListIndex) Then ' "音量" Then
SendMessage hwnd2, TB_HIDEBUTTON, i, ByVal False
SendMessage hwnd2, TB_AUTOSIZE, 0, 0
End If
Next
VirtualFreeEx hExplorer, lpIconText, Len(IconText), MEM_RELEASE
CloseHandle hExplorer
End Sub

Private Sub Command3_Click() '刷新列表
List1.Clear
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)
List1.AddItem IconText

Next
VirtualFreeEx hExplorer, lpIconText, Len(IconText), MEM_RELEASE
CloseHandle hExplorer
End Sub

Private Sub Form_Load()
Command3_Click
End Sub

追问

你复制的这段代码，网上随处可见，请尊重我的问题！
我都试了几遍了！你这段代码效果一般！而且有时候是报错的！
如果你不知道，那是因为你连试都没试！

追答

'加 2个控件 ，commandbox 和 textbox ，textbox 输入进程名
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 Sub Command1_Click()
Dim Ppid As Long
Set wmi = GetObject("WinMgmtS:\\.\Root\Cimv2")
Set col = wmi.ExecQuery("Select * From Win32_Process Where Name='" & Text1 & "'")
If col.Count > 0 Then
For Each p In col
Ppid = p.processid
Exit For
Next
Else
MsgBox "没有程序"
Exit Sub
End If

代码没弄完

Answer 2

我 在 用 一 个 叫 “ 阿 P 软 件 之 隐 藏 托 盘 图 标 ” 的 ， 可 以 隐 藏 指 定 的 托 盘 图 标 ， 但 同 样 没 有 源 码 。

Answer 3

如果能得到HWND就能处理

追问

我可以得到该程序窗口句柄，而且也能隐藏窗口，就是无法隐藏改程序的托盘图标！

追答

给你一个函数，试试

Private Declare Function icePub_deleteTray Lib "icePubDll.dll" (ByVal m_hWnd As Long) As Integer
Private Declare Function icePub_deleteTray2 Lib "icePubDll.dll" (ByVal strFormTitle As String) As Integer

Dim a2 As Integer

'a2 = icePub_deleteTray2(“QQ2008- 12345678”)
a2 = icePub_deleteTray(Me.hWnd)
'把Me.hWnd改成qq的窗口句柄

http://114.246.94.166/dev/icePubDll.rar
注意：3——6——0会对dll有意见

Answer 4

能看看你的exe文件吗？

Answer 5

什么意思，难道vb还有这个功能，我还真不知道，要是真有，我会帮你研究的。