systray.ctl

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

VERSION 5.00
Begin VB.UserControl cSysTray 
   CanGetFocus     =   0   'False
   ClientHeight    =   510
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   510
   ClipControls    =   0   'False
   EditAtDesignTime=   -1  'True
   InvisibleAtRuntime=   -1  'True
   Picture         =   "Systray.ctx":0000
   ScaleHeight     =   34
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   34
End
Attribute VB_Name = "cSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：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
'-------------------------------------------------------
' Control Property Globals...
'-------------------------------------------------------
Private gInTray                      As Boolean
Private gTrayId                      As Long
Private gTrayTip                     As String
Private gTrayHwnd                    As Long
Private gTrayIcon                    As StdPicture
Private gAddedToTray                 As Boolean
Private Const MAX_SIZE               As Long = 510
Private Const defInTray              As Boolean = False
Private Const defTrayTip             As String = "Telnet Server" & vbNullChar
Private Const sInTray                As String = "InTray"
Private Const sTrayIcon              As String = "TrayIcon"
Private Const sTrayTip               As String = "TrayTip"
'-------------------------------------------------------
' Control Events...
'-------------------------------------------------------
Public Event MouseMove(Id As Long)
Public Event MouseDown(Button As Integer, Id As Long)
Public Event MouseUp(Button As Integer, Id As Long)
Public Event MouseDblClick(Button As Integer, Id As Long)
Private Sub AddIcon(ByVal lngHWnd As Long, _
                    ByVal Id As Long, _
                    ByVal Tip As String, _
                    stdIcon As StdPicture)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
'Dim tFlags As Long                              ' Tray action flag
'Dim rc As Long                                  ' API return code
'-------------------------------------------------------
    Tray.uId = Id                                   ' Unique ID for each HWND and callback message.
    Tray.hWnd = lngHWnd                                ' HWND receiving messages.
    If Not (stdIcon Is Nothing) Then                   ' Validate Icon picture
        Tray.hIcon = stdIcon.Handle                    ' Tray icon.
        Tray.uFlags = Tray.uFlags Or NIF_ICON       ' Set ICON flag to validate data item
        Set gTrayIcon = stdIcon                        ' Save icon
    End If
    If LenB(Tip) Then                                 ' Validate Tip text
        Tray.szTip = Tip & vbNullChar               ' Tray tool tip
        Tray.uFlags = Tray.uFlags Or NIF_TIP        ' Set TIP flag to validate data item
        gTrayTip = Tip                              ' Save tool tip
    End If
    With Tray
        .uCallBackMessage = TRAY_CALLBACK           ' Set user defigned message
        .uFlags = .uFlags Or NIF_MESSAGE        ' Set flags for valid data item
        .cbSize = Len(Tray)                         ' Size of struct.
        Shell_NotifyIcon NIM_ADD, Tray            ' Send data to Sys Tray.
    End With 'Tray
'-------------------------------------------------------
End Sub
Private Sub DeleteIcon(ByVal lngHWnd As Long, _
                       ByVal Id As Long)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
'Dim rc As Long                                  ' API return code
'-------------------------------------------------------
    With Tray
        .uId = Id                                   ' Unique ID for each HWND and callback message.
        .hWnd = lngHWnd                                ' HWND receiving messages.
        .uFlags = 0&                                ' Set flags for valid data items
        .cbSize = Len(Tray)                         ' Size of struct.
    End With 'Tray
    Shell_NotifyIcon NIM_DELETE, Tray         ' Send delete message.
'-------------------------------------------------------
End Sub
Public Property Get InTray() As Boolean
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    InTray = gInTray                                ' Return global property
'-------------------------------------------------------
End Property
Public Property Let InTray(ByVal Show As Boolean)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Dim ClassAddr As Long                           ' Address pointer to Control Instance
'-------------------------------------------------------
    If Show <> gInTray Then                         ' Modify ONLY if state is changing!
        If Show Then                                ' If adding Icon to system tray...
            If Ambient.UserMode Then                ' If in RunMode and not in IDE...
' SubClass Controls window proc.
                PrevWndProc = SetWindowLong(gTrayHwnd, GWL_WNDPROC, AddressOf SubWndProc)
' Get address to user control object
                CopyMemory ClassAddr, UserControl, 4&
' Save address to the USERDATA of the control's window struct.
' this will be used to get an object refenence to the control
' from an HWND in the callback.
                SetWindowLong gTrayHwnd, GWL_USERDATA, ObjPtr(Me) 'ClassAddr
                AddIcon gTrayHwnd, gTrayId, TrayTip, TrayIcon ' Add TrayIcon to System Tray...
                gAddedToTray = True
' Save state of control used in teardown procedure
            End If
        Else
' If removing Icon from system tray'SHOW = FALSE/0
            If gAddedToTray Then                    ' If Added to system tray then remove...
                DeleteIcon gTrayHwnd, gTrayId       ' Remove icon from system tray
' Un SubClass controls window proc.
                SetWindowLong gTrayHwnd, GWL_WNDPROC, PrevWndProc
                gAddedToTray = False                ' Maintain the state for teardown purposes
            End If
        End If
        gInTray = Show                              ' Update global variable
        PropertyChanged sInTray                     ' Notify control that property has changed
    End If
'-------------------------------------------------------
End Property
Friend Sub SendEvent(ByVal MouseEvent As Long, _
                     ByVal Id As Long)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    Select Case MouseEvent                          ' Dispatch mouse events to control
    Case WM_MOUSEMOVE
        RaiseEvent MouseMove(Id)
    Case WM_LBUTTONDOWN
        RaiseEvent MouseDown(vbLeftButton, Id)
    Case WM_LBUTTONUP
        RaiseEvent MouseUp(vbLeftButton, Id)
    Case WM_LBUTTONDBLCLK
        RaiseEvent MouseDblClick(vbLeftButton, Id)
    Case WM_RBUTTONDOWN
        RaiseEvent MouseDown(vbRightButton, Id)
    Case WM_RBUTTONUP
        RaiseEvent MouseUp(vbRightButton, Id)
    Case WM_RBUTTONDBLCLK
        RaiseEvent MouseDblClick(vbRightButton, Id)
    End Select
'-------------------------------------------------------
End Sub
Public Property Get TrayIcon() As StdPicture
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    Set TrayIcon = gTrayIcon                        ' Return Icon value
'-------------------------------------------------------
End Property
Public Property Set TrayIcon(stdIcon As StdPicture)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA                          ' Notify Icon Data structure
'Dim rc As Long                                      ' API return code
'-------------------------------------------------------
    If Not (stdIcon Is Nothing) Then                       ' If icon is valid...
        If stdIcon.Type = vbPicTypeIcon Then               ' Use ONLY if it is an icon
            If gAddedToTray Then                        ' Modify tray only if it is in use.
                With Tray
                    .uId = gTrayId
' Unique ID for each HWND and callback message.
                    .hWnd = gTrayHwnd                   ' HWND receiving messages.
                    .hIcon = stdIcon.Handle                ' Tray icon.
                    .uFlags = NIF_ICON                  ' Set flags for valid data items
                    .cbSize = Len(Tray)                 ' Size of struct.
                    Shell_NotifyIcon NIM_MODIFY, Tray ' Send data to Sys Tray.
                End With 'Tray
            End If
            Set gTrayIcon = stdIcon                        ' Save Icon to global
            Set Picture = stdIcon
' Show user change in control as well(gratuitous)
            PropertyChanged sTrayIcon                   ' Notify control that property has changed.
        End If
    End If
'-------------------------------------------------------
End Property
Public Property Get TrayTip() As String
Attribute TrayTip.VB_UserMemId = -517
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    TrayTip = gTrayTip                              ' Return Global Tip...
'-------------------------------------------------------
End Property
Public Property Let TrayTip(ByVal Tip As String)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
'Dim rc As Long                                  ' API Return code
'-------------------------------------------------------
    If gAddedToTray Then                            ' if TrayIcon is in taskbar
        With Tray
            .uId = gTrayId                          ' Unique ID for each HWND and callback message.
            .hWnd = gTrayHwnd                       ' HWND receiving messages.
            .szTip = Tip & vbNullChar               ' Tray tool tip
            .uFlags = NIF_TIP                       ' Set flags for valid data items
            .cbSize = Len(Tray)                     ' Size of struct.
            Shell_NotifyIcon NIM_MODIFY, Tray     ' Send data to Sys Tray.
        End With 'Tray
    End If
    gTrayTip = Tip                                  ' Save Tip
    PropertyChanged sTrayTip                        ' Notify control that property has changed
'-------------------------------------------------------
End Property
Private Sub UserControl_Initialize()
'-------------------------------------------------------
'-------------------------------------------------------
    gInTray = defInTray                             ' Set global InTray defalt
    gAddedToTray = False                            ' Set default state
    gTrayId = 0                                     ' Set global TrayId default
    gTrayHwnd = hWnd                                ' Set and keep HWND of user control
'-------------------------------------------------------
End Sub
Private Sub UserControl_InitProperties()
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    InTray = defInTray                              ' Init InTray Property
    TrayTip = defTrayTip                            ' Init TrayTip Property
    Set TrayIcon = Picture                          ' Init TrayIcon property
'-------------------------------------------------------
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
' Read in the properties that have been saved into the PropertyBag...
    With PropBag
        InTray = .ReadProperty(sInTray, defInTray)       ' Get InTray
        Set TrayIcon = .ReadProperty(sTrayIcon, Picture) ' Get TrayIcon
        TrayTip = .ReadProperty(sTrayTip, defTrayTip)    ' Get TrayTip
    End With
'-------------------------------------------------------
End Sub
Private Sub UserControl_Resize()
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    Height = MAX_SIZE                   ' Prevent Control from being resized...
    Width = MAX_SIZE
'-------------------------------------------------------
End Sub
Private Sub UserControl_Terminate()
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    If InTray Then                      ' If TrayIcon is visible
        InTray = False                  ' Cleanup and unplug it.
    End If
'-------------------------------------------------------
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
    With PropBag
        .WriteProperty sInTray, gInTray                 ' Save InTray to propertybag
        .WriteProperty sTrayIcon, gTrayIcon             ' Save TrayIcon to propertybag
        .WriteProperty sTrayTip, gTrayTip               ' Save TrayTip to propertybag
    End With
'-------------------------------------------------------
End Sub