VB隐藏托盘.显示.刷新.代码

mengl520

VB系统托盘图标.rar (4.32 KB, 下载次数: 55)

2011-9-8 18:42 上传

点击文件名下载附件

原代码如下
Option Explicit

Private Sub Command1_Click() '隐藏
    Call hideSysButton(List1.List(List1.ListIndex))
End Sub
Private Sub Command2_Click()
    Call showSysButton(List1.List(List1.ListIndex))
End Sub
Private Sub Command3_Click() '刷新
    Call listSysButtonTitle(List1)
End Sub
Private Sub Form_Load()
    Call Command3_Click
End Sub
'摸版代码
Option Explicit
'=========================================
'http://www.6688jp.com 网络收集到的代码
'=========================================
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
'隐藏包含某个消息的系统托盘
Public Sub hideSysButton(strTitle As String)
    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 = strTitle 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
'显示包含某个消息的系统托盘
Public Sub showSysButton(strTitle As String)
    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 = strTitle 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
'用listbox控件显示所有系统图标的title
Public Sub listSysButtonTitle(lst1 As ListBox)
    lst1.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)
        lst1.AddItem IconText
    Next
    VirtualFreeEx hExplorer, lpIconText, Len(IconText), MEM_RELEASE
    CloseHandle hExplorer
End Sub

今夕望月

头疼的定义啊

xylguagua

有易语言的就好了

瓜瓜

{:1_914:}