systray.bas

支持监控包括传输控制协议和 UDP 的所有的互联网传输协议。同时程序具有实时文件防修改监控功能

Attribute VB_Name = "mSysTray"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/09/20
'描    述：界面清爽VB版高级专业防火墙 Ver 2.0.3
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
'-------------------------------------------------------
' Api Declares....
'-------------------------------------------------------
'-------------------------------------------------------
' Api Constants...
'-------------------------------------------------------
Public Const GWL_USERDATA        As Long = (-21&)
Public Const GWL_WNDPROC         As Long = (-4&)
Private Const WM_USER            As Long = &H400
Public Const TRAY_CALLBACK       As Double = (WM_USER + 101&)
Public Const NIM_ADD             As Long = &H0
Public Const NIM_MODIFY          As Long = &H1
Public Const NIM_DELETE          As Long = &H2
Public Const NIF_MESSAGE         As Long = &H1
Public Const NIF_ICON            As Long = &H2
Public Const NIF_TIP             As Long = &H4
Public Const WM_MOUSEMOVE        As Long = &H200
Public Const WM_LBUTTONDOWN      As Long = &H201
Public Const WM_LBUTTONUP        As Long = &H202
Public Const WM_LBUTTONDBLCLK    As Long = &H203
Public Const WM_RBUTTONDOWN      As Long = &H204
Public Const WM_RBUTTONUP        As Long = &H205
Public Const WM_RBUTTONDBLCLK    As Long = &H206
'DrawEdge constants
Private Const BF_LEFT            As Long = &H1       ' Border flags
Private Const BF_SOFT            As Long = &H1000    ' For softer buttons
'-------------------------------------------------------
' Api Types....
'-------------------------------------------------------
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
Public Type RECT
    Left                             As Long
    Top                              As Long
    Right                            As Long
    Bottom                           As Long
End Type
Public PrevWndProc               As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
                                                                              ByVal hWnd As Long, _
                                                                              ByVal Msg As Long, _
                                                                              ByVal wParam As Long, _
                                                                              ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                                                            ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
                                                                           ByVal nIndex As Long, _
                                                                           ByVal dwNewLong 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, _
                                                                    pSource As Any, _
                                                                    ByVal ByteLen As Long)
Public Function SubWndProc(ByVal lngHWnd As Long, _
                           ByVal Msg As Long, _
                           ByVal wParam As Long, _
                           ByVal lParam As Long) As Long
'------------------------------------------------------------
'------------------------------------------------------------
' This is the control subclassed window proc.
'------------------------------------------------------------
Dim SysTray   As cSysTray ' SysTray class variable
Dim ClassAddr As Long     ' long pointer to class object
'------------------------------------------------------------
    Select Case Msg                                 ' Determine
    Case TRAY_CALLBACK
' Callback message received when user clicks on system tray...
' Retrieve long pointer to class object, this was saved in the
'USERDATA of the window struct. after the user control was subclassed...
        ClassAddr = GetWindowLong(lngHWnd, GWL_USERDATA) ' get pointer to object
        CopyMemory SysTray, ClassAddr, 4
' Copy an unreferenced pointer to object into variable
        SysTray.SendEvent lParam, wParam            ' Send windows message\user event to control
        CopyMemory SysTray, 0&, 4                   ' Nullify object pointer
    End Select
' Forward all messages to previous window procedure...(This must be done)
    SubWndProc = CallWindowProc(PrevWndProc, lngHWnd, Msg, wParam, lParam)
'------------------------------------------------------------
End Function
'------------------------------------------------------------