完美隐藏系统托盘图标

完美隐藏系统托盘图标（VB源码）！

2009-01-05 23:07

 

 

我做桌面托盘隐藏时翻译了一篇文章是关于托盘。现在公开我这个翻译。 三个文件，一个是FORM1，modIconToPic、modMain。 '************************modMain*********************************** '**模 块 名：获取托盘图标 '**说    明：By:小江翻译（http://www.codeproject.com/KB/applications/ShellTrayInfo.aspx） '**日    期：2008-12-10 00:27:01 '************************************************************************* Option Explicit 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 PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Public 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 Public 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 Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public 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 Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long '加入托盘 Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Public Const NIM_ADD = &H0 '表示要往任务栏中加入图标 Public Const NIM_DELETE = &H2 '删除图标 Public Const NIM_MODIFY = &H1 '修改图标 Public Const NIF_ICON = &H2 '允许图标显示 Public Const NIF_MESSAGE = &H1 '允许图标消息转发 Public Const NIF_TIP = &H4 '允许图标显示图标提示字符串 Public Const WM_USER = &H400 Public Const WM_NOTIFYICON = WM_USER + 1          ' 自定义消息，用于子类化时，取得托盘相应信息 '托盘BOTTON Public Const TBSTATE_HIDDEN = &H8 Public Const WM_SIZE = &H5 'Public Const WM_USER As Long = &H400 Public Const TB_BUTTONCOUNT As Long = (WM_USER + 24) Public Const TB_HIDEBUTTON As Long = (WM_USER + 4) Public Const TB_GETBUTTON As Long = (WM_USER + 23) Public Const TB_GETBITMAP As Long = (WM_USER + 44) Public Const TB_DELETEBUTTON As Long = (WM_USER + 22) Public Const TB_ADDBUTTONS As Long = (WM_USER + 20) Public Const TB_INSERTBUTTON As Long = (WM_USER + 21) Public Const TB_GETBUTTONTEXTA As Long = (WM_USER + 45) Public Const TB_ISBUTTONHIDDEN As Long = (WM_USER + 12) Public Const TB_MOVEBUTTON = (WM_USER + 82) Public Const TB_AUTOSIZE As Long = (WM_USER + 33) Public Const ILD_NORMAL As Long = &H0 '进程读写 Public Const READ_CONTROL As Long = &H20000 Public Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000 Public Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL) Public Const STANDARD_RIGHTS_EXECUTE As Long = (READ_CONTROL) Public Const STANDARD_RIGHTS_ALL As Long = &H1F0000 Public Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL) Public Const SYNCHRONIZE As Long = &H100000 Public Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF) Public Const PROCESS_TERMINATE As Long = (&H1) '内存读写参数 Public Const PROCESS_VM_OPERATION As Long = (&H8) Public Const PROCESS_VM_READ As Long = (&H10) Public Const PROCESS_VM_WRITE As Long = (&H20) Public Const MEM_RESERVE As Long = &H2000 Public Const MEM_COMMIT As Long = &H1000 Public Const MEM_RELEASE As Long = &H8000 Public Const PAGE_READWRITE As Long = &H4 '窗口状态参数 Public Const SW_HIDE = 0 Public Const SW_SHOW = 5 Public Const SW_MINIMIZE = 6 Public Const PROCESS_QUERY_INFORMATION = 1024 '托盘 Public 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 'ICON结构 Public Type ICONINFO     fIcon           As Long     xHotspot        As Long     yHotspot        As Long     hbmMask         As Long     hbmColor        As Long End Type 'Botton结构 Public 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结构 Public 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 '自定义结构 Public 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 Public Const MAX_PATH& = 260 Public m_hTrayWnd As Long Sub Main()     Form1.Show End Sub '************************************************************************* '**函 数 名：得到系统托盘句柄 '************************************************************************* Public 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"。 '************************************************************************* Public 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 Function CheckPath(ByVal sPath As String) As String     On Error Resume Next     sPath = Replace$(sPath, "/??/", "")     If UCase$(Left$(sPath, 12)) = "/SYSTEMROOT/" Then sPath = GetWinDir & Mid$(sPath, 12)     CheckPath = sPath End Function '************************************************************************* '**函 数 名'得到系统路径 '************************************************************************* Public Function GetWinDir() As String     Dim sTemp As String * 256     Dim iCharLen As Integer     iCharLen = GetWindowsDirectory(sTemp, Len(sTemp))     GetWinDir = Left$(sTemp, iCharLen) End Function '------------------------modIconToPic------------------------------------------------ Option Explicit '网络上抄摘，原作者不详。 '把ICON文件转为一般图像文件与获取EXE文件的图标 'OleCreatePictureIndirect建立一个图像对象,并返回对象句柄 'pDicDesc 图象结构 'riid      接口的标识符 'fown      是否清除图像对象,如设置为真,则图片对象将摧毁它的图片当对象被摧毁时。如果假, 则由用户负责摧毁图片对象。 'lpUnk     输出变量地址接口类型 Public Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long Public Type TypeIcon     cbSize    As Long                  '结构大小     picType   As PictureTypeConstants '图像类型     hIcon     As Long                  '图标句柄 End Type 'CLSID类标识符的缩写 Public Type CLSID     id(16) As Byte '由16个成员组成的字节数组 End Type Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long Private Type SHFILEINFO     hIcon         As Long                '文件的图标句柄     iIcon         As Long                '图标的系统索引号     dwAttributes As Long                '文件的属性值     szDisplayName As String * 260        '文件的显示名     szTypeName    As String * 80         '文件的类型名 End Type Public Const SHGFI_ICON = &H100         '获得图标 Public Const SHGFI_LARGEICON = &H0      '获取文件大图标 Public Const SHGFI_SMALLICON = &H1      '获取小图标 'ICON 转 Picture Public Function IconToPic(hIcon As Long) As IPictureDisp     Dim cls_id As CLSID     Dim hRes As Long     Dim new_icon As TypeIcon     Dim lpUnk As IUnknown         'Com接口     With new_icon         .cbSize = Len(new_icon)         .picType = vbPicTypeIcon 'Picture 对象的图标类型         .hIcon = hIcon     End With     With cls_id         .id(8) = &HC0         .id(15) = &H46     End With     hRes = OleCreatePictureIndirect(new_icon, cls_id, 1, lpUnk)     If hRes = 0 Then Set IconToPic = lpUnk End Function '获得文件ICON Public Function GetExeIcon(FileName, Optional ByVal SmallIcon As Boolean = True) As IPictureDisp     Dim Index As Integer     Dim hIcon As Long     Dim item_num As Long     Dim icon_pic As IPictureDisp     Dim sh_info As SHFILEINFO     If SmallIcon = True Then         SHGetFileInfo FileName, 0, sh_info, Len(sh_info), SHGFI_ICON + SHGFI_SMALLICON     Else         SHGetFileInfo FileName, 0, sh_info, Len(sh_info), SHGFI_ICON + SHGFI_LARGEICON     End If     hIcon = sh_info.hIcon     Set icon_pic = IconToPic(hIcon)     Set GetExeIcon = icon_pic     Set icon_pic = Nothing End Function '************************************************************************* '**函 数 名：通过PID返回程序路径 '************************************************************************* Public Function GetAppPathByPid(lPid As Long) As String     Dim sRet As String     Dim lret As Long     Dim lModules(1 To MAX_PATH) As Long     Dim sModName As String     Dim lCBSize As Long     Dim hProcess As Long     Dim sProcessPath As String     sProcessPath = "[Unknown Process]"     hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, lPid)     If hProcess Then         lret = EnumProcessModules(hProcess, lModules(1), MAX_PATH, lCBSize)         If lret <> 0 Then             sModName = Space$(MAX_PATH)             lret = GetModuleFileNameExA(hProcess, lModules(1), sModName, 500) '从句柄的取得对应的程序路径             sProcessPath = Left$(sModName, lret)             sProcessPath = CheckPath(Trim$(sProcessPath)) '去除路径中/??/的内容         End If     End If     GetAppPathByPid = sProcessPath     CloseHandle hProcess End Function '-------------------------------form1--------------------------------------- Option Explicit '************************************************************************* '**模 块 名：获取托盘图标 '**说    明：By:小江翻译（http://www.codeproject.com/KB/applications/ShellTrayInfo.aspx） '**日    期：2008-12-10 00:27:01 '************************************************************************* Private Declare Function GetLastError Lib "kernel32" () As Long Private m_aTrayinfo() As TrayItemInfo Private iIndex   As Integer Public Sub Command1_Click()     Dim lTrayPid As Long     Dim lCount   As Long     Dim lret     As Long     Dim hProcess As Long     Dim lAddress As Long     Dim udtTb    As TBBUTTON     Dim udtTray As TRAYDATA     Dim udtTifo As TrayItemInfo     Dim lTextAdr As Long     Dim asTip(0 To 1024) As Byte     Dim sTip    As String     Dim icoInfo As ICONINFO     Dim i       As Integer     Set ListView1.Icons = Nothing     Set ListView1.SmallIcons = Nothing     ListView1.ListItems.Clear     ImageList1.ListImages.Clear     ImageList1.ImageHeight = 16     ImageList1.ImageWidth = 16     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 = sTip             .hWnd = udtTray.hWnd             .uCallBackMessage = udtTray.uCallBackMessage             .uid = udtTray.uid             .bVisible = Not CBool((udtTb.fsState And TBSTATE_HIDDEN))             .hIcon = udtTray.hIcon         End With         If GetIconInfo(udtTray.hIcon, icoInfo) <> 0 Then             ImageList1.ListImages.Add , , IconToPic(udtTray.hIcon)             'Debug.Print GetLastError         Else             ImageList1.ListImages.Add , , GetExeIcon(udtTifo.sProcessPath)         End If         Debug.Print sTip, GetLastError, i         If ImageList1.ListImages.Count = 1 Then             Set ListView1.Icons = ImageList1             Set ListView1.SmallIcons = ImageList1         End If         ReDim Preserve m_aTrayinfo(0 To i)         m_aTrayinfo(i) = udtTifo         ListView1.ListItems.Add i + 1, , udtTifo.sTip, 1, i + 1         ListView1.ListItems(i + 1).SubItems(1) = udtTifo.sProcessPath     Next End Sub Public Sub Command2_Click()     Dim s As String     iIndex = ListView1.SelectedItem.Index - 1     s = ListView1.SelectedItem.Text     Debug.Print s     If iIndex > 0 And s <> "[Hidden Icon]" Then         Call SendMessage(m_hTrayWnd, TB_MOVEBUTTON, iIndex, ByVal CLng(iIndex - 1))         Call Command1_Click         ListView1.SelectedItem = ListView1.ListItems(iIndex)         ListView1.SelectedItem.EnsureVisible         ListView1.SetFocus     End If End Sub Public Sub Command3_Click()     Dim s As String     iIndex = ListView1.SelectedItem.Index - 1     s = ListView1.SelectedItem.Text     Debug.Print s     If iIndex < ListView1.ListItems.Count - 1 And s <> "[Hidden Icon]" Then         Call SendMessage(m_hTrayWnd, TB_MOVEBUTTON, iIndex, ByVal CLng(iIndex + 1))         Call Command1_Click         ListView1.SelectedItem = ListView1.ListItems(iIndex + 2)         ListView1.SelectedItem.EnsureVisible         ListView1.SetFocus     End If End Sub Private Sub Command4_Click()     iIndex = ListView1.SelectedItem.Index - 1     Const WM_RBUTTONDOWN = &H204     Const WM_RBUTTONUP = &H205     Call PostMessage(m_aTrayinfo(iIndex).hWnd, m_aTrayinfo(iIndex).uCallBackMessage, m_aTrayinfo(iIndex).uid, WM_RBUTTONDOWN)     Call PostMessage(m_aTrayinfo(iIndex).hWnd, m_aTrayinfo(iIndex).uCallBackMessage, m_aTrayinfo(iIndex).uid, WM_RBUTTONUP) End Sub Private Sub Command5_Click()     Dim udtIconData As NOTIFYICONDATA     iIndex = ListView1.SelectedItem.Index - 1     If m_aTrayinfo(iIndex).bVisible Then         With udtIconData             .cbSize = Len(udtIconData)             .hIcon = m_aTrayinfo(iIndex).hIcon             .hWnd = m_aTrayinfo(iIndex).hWnd             .szTip = m_aTrayinfo(iIndex).sTip             .uCallBackMessage = m_aTrayinfo(iIndex).uCallBackMessage             '*注：这要hIcon、szTip、uCallBackMessage对应相对应的值。这里我默认三者都有！             .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP             .uid = m_aTrayinfo(iIndex).uid         End With         If m_aTrayinfo(iIndex).IsSetHide Then             m_aTrayinfo(iIndex).IsSetHide = False             Call Shell_NotifyIcon(NIM_ADD, udtIconData)             Command5.Caption = "HIDE"         Else             m_aTrayinfo(iIndex).IsSetHide = True             Call Shell_NotifyIcon(NIM_DELETE, udtIconData)             Command5.Caption = "SHOW"         End If     End If End Sub Private Sub Form_Load()     Call Command1_Click End Sub Private Sub Form_Unload(Cancel As Integer)     Dim iIndex As Integer     Dim udtIconData As NOTIFYICONDATA     Cancel = 1     For iIndex = 0 To UBound(m_aTrayinfo)         If m_aTrayinfo(iIndex).IsSetHide Then             With udtIconData                 .cbSize = Len(udtIconData)                 .hIcon = m_aTrayinfo(iIndex).hIcon                 .hWnd = m_aTrayinfo(iIndex).hWnd                 .szTip = m_aTrayinfo(iIndex).sTip                 .uCallBackMessage = m_aTrayinfo(iIndex).uCallBackMessage                 '*注：这要hIcon、szTip、uCallBackMessage对应相对应的值。这里我默认三者都有！                 .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP                 .uid = m_aTrayinfo(iIndex).uid             End With             Call Shell_NotifyIcon(NIM_ADD, udtIconData)         End If     Next     Cancel = 0 End Sub

 

原帖地址：

http://hi.baidu.com/hidetray/blog/item/a0aca8b606f39df331add1ed.html