完美隐藏系统托盘图标
上一篇 / 下一篇 2010-03-07 15:09:57 / 天气: 晴朗 / 心情: 高兴
listview设放：,安全阀三个文件，一个非FORM1，modIconToPic、modMain。'*modMain**'*模块名：获与托盘图标'*道亮：By：大江北京北京翻译公司公司(ayInfo.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"(By Val 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=&H 100000 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 Cons tPAGE_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 0Then hTrayWnd=FindWindowEx(hTrayWnd,0,"TrayNotifyWnd",vbNullString)hTrayWnd=FindWindowEx(hTrayWnd,0,"SysPager",vbNullString)If hTrayWnd 0Then 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 0Then 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 0Then 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：大江北京北京翻译公司公司(ayInfo.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 iAs 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(PROCES S_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.P rint 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 sAs String iIndex=ListView1.SelectedItem.Index-1 s=ListView1.SelectedItem.Text Debug.Print sIf iIndex 0And 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 sAs String iIndex=ListView1.SelectedItem.Index-1 s=ListView1.SelectedItem.Text Debug.Print sIf iIndex ListView1.ListI tems.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'*注：那要hI con、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相关文章：
托盘服务澳门托盘托盘标准化困局待破
TAG:
