十万火急！怎样用api实现使一个程序在系统托盘上出现！要2000和98下都可以！还有在vb判断端口是否忙！

Question

类模块:
Option ExplicitPrivate m_tip As String
Private m_MsgNo As Long
Private m_ID As Long
Private m_hIcon As Long
Private m_Icon As IPictureDisp
Private m_Form As Form
Private nid As NOTIFYICONDATA
Private HadAdd As Boolean
Private preWndProc As LongPublic Property Get Tip() As String
Tip = m_tip
End Property'设定Mouse移至Icon时所show出之Tip
Public Property Let Tip(ByVal vNewValue As String)
m_tip = vNewValue
End PropertyPublic Property Get MsgNo() As Long
MsgNo = m_MsgNo - WM_USER
End Property
'设定Mosue Click於Icon时，所送出之讯息编号
Public Property Let MsgNo(ByVal vNewValue As Long)
m_MsgNo = vNewValue + WM_USER
End Property
'设定ID
Public Property Get ID() As Long
ID = m_ID
End PropertyPublic Property Let ID(ByVal vNewValue As Long)
m_ID = vNewValue
End Property
'设定Icon的图示
Public Property Set Icon(ByVal vNewValue As IPictureDisp)
Set m_Icon = vNewValue
m_hIcon = m_Icon.Handle
End Property
'将原先的Form隐藏，并在右下方加入一个Icon，传入的是待处理的Form
Public Function AddNIcon(ByVal para_form As Form) As Boolean
Dim ret As Long
AddNIcon = False
If Not HadAdd Then
    Call Shell_NotifyIconA(NIM_DELETE, nid)
    Set m_Form = para_form
    nid.cbSize = Len(nid)
    nid.hWnd = m_Form.hWnd
    nid.uID = m_ID
    nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
    nid.hIcon = m_hIcon
    nid.szTip = m_tip + Chr(0)
    nid.uCallbackMessage = m_MsgNo
    Dim i As Integer
    i = Shell_NotifyIconA(NIM_ADD, nid)
    If i = 1 Then '新增成功
   IconMsg = m_MsgNo
   preWndProc = GetWindowLong(m_Form.hWnd, GWL_WNDPROC)
   '记录原先window procedure的Addr於Window的extra 32 bits，每个Window都会保留
   '32Bits给Application运用，在此记录preWndProc的值
   ret = SetWindowLong(m_Form.hWnd, GWL_USERDATA, preWndProc)
   ret = SetWindowLong(m_Form.hWnd, GWL_WNDPROC, AddressOf WndProcForIcon)
   m_Form.Hide  '如果不想加入时就隐藏form，这行请Mark，并在您的程式中自行决定何时Hide form
   AddNIcon = True
   HadAdd = True
    End If
End If
End Function'删除於右下方的Icon
Public Sub DelNIcon()
 Dim ret As Long
 If preWndProc <> 0 Then
    ret = SetWindowLong(m_Form.hWnd, GWL_WNDPROC, preWndProc)
    preWndProc = 0
 End If
 If HadAdd Then
    Call Shell_NotifyIconA(NIM_DELETE, nid)
    HadAdd = False
    Set m_Form = Nothing
 End If
End Sub
'修改Icon的设定，能改的只有Icon的图与Icon的Tip
Public Function ModNIcon() As Boolean
ModNIcon = False
If HadAdd Then
   nid.hIcon = m_hIcon
   nid.szTip = m_tip + Chr(0)
   Dim i
   i = Shell_NotifyIconA(NIM_MODIFY, nid)
   If i = 1 Then
      ModNIcon = True
   End If
End If
End FunctionPrivate Sub Class_Initialize()
m_MsgNo = WM_USER
m_ID = 9999
m_tip = Trim(Screen.ActiveForm.Caption)
Set m_Form = Screen.ActiveForm
m_hIcon = m_Form.Icon.Handle
HadAdd = False
End SubPrivate Sub Class_Terminate()
Call DelNIcon
End Sub模块
Option Explicit
'右下角添加图标
Public Const WM_USER = &H400
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const WM_LBUTTONDOWN = &H201
Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2
Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
Public IconMsg As LongPublic 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 TypeDeclare 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
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer
Function WndProcForIcon(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim prevWndProcForIcon As Long
   '取回前一个Window procdure所在的位置，这个值是在Nicon.AddNicon中放进去的
   prevWndProcForIcon = GetWindowLong(hwnd, GWL_USERDATA)
   If Msg = IconMsg Then
   If lParam = WM_LBUTTONDOWN Then
      Dim mForm As Form
      For Each mForm In Forms
      If mForm.hwnd = hwnd Then
         mForm.Show
      End If
      Next
   End If
       '若您按Mosue右键或Double Click等，要执行什麽事，请在这里加进来
   End If
   WndProcForIcon = CallWindowProc(prevWndProcForIcon, hwnd, Msg, wParam, lParam)
End Function窗体
Option Explicit
Private nid As New NIcon'最小化为右下角的图标
Private Sub command1_Click()
   DoEvents
   nid.Tip = "资料下载"
   nid.ID = 9998 '若没设，会使用内订值9999
   nid.MsgNo = 2 '若没设，内订0
   Call nid.AddNIcon(Me)
   Me.Hide
End Sub
'退出程序
Private Sub command2_Click()
   nid.DelNIcon
   Set nid = Nothing
   Unload Me
End Sub

Answer 1

用VB安装盘上的SYSTRAY，编译成OCX，加入工程
cSysTray1.InTray = True 就进去了，
控制极简单，自己玩吧。

Answer 2

VERSION 5.00
Begin VB.Form frmTrayIcon 
   Caption         =   "Mind's Tray Icon Example"
   ClientHeight    =   1485
   ClientLeft      =   2625
   ClientTop       =   2175
   ClientWidth     =   3480
   Icon            =   "TrayIcon.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1485
   ScaleWidth      =   3480
   Begin VB.CommandButton cmdExit 
      Caption         =   "E&xit"
      Height          =   375
      Left            =   1200
      TabIndex        =   0
      Top             =   840
      Width           =   1215
   End
   Begin VB.Image imgIcon2 
      Height          =   480
      Left            =   1920
      Picture         =   "TrayIcon.frx":030A
      Top             =   240
      Width           =   480
   End
   Begin VB.Image imgIcon1 
      Height          =   480
      Left            =   1200
      Picture         =   "TrayIcon.frx":074C
      Top             =   240
      Width           =   480
   End
   Begin VB.Menu mnuPopUp 
      Caption         =   "PopUp_Menu"
      Visible         =   0   'False
      Begin VB.Menu mnuChange 
         Caption         =   "Change &Icon"
      End
      Begin VB.Menu line2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "E&xit"
      End
      Begin VB.Menu line 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "&About"
      End
   End
End
Attribute VB_Name = "frmTrayIcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongConst SW_RESTORE = 9Const SW_SHOWNORMAL = 1Private 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 Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Private Sub cmdExit_Click()    Unload Me
    
End Sub
Private Sub Form_Load()    
    'centers form
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2    'sets cbSize to the Length of TrayIcon
    TrayIcon.cbSize = Len(TrayIcon)
    ' Handle of the window used to handle messages - which is the this form
    TrayIcon.hwnd = Me.hwnd
    ' ID code of the icon
    TrayIcon.uId = vbNull
    ' Flags
    TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    ' ID of the call back message
    TrayIcon.ucallbackMessage = WM_MOUSEMOVE
    ' The icon - sets the icon that should be used
    TrayIcon.hIcon = imgIcon1.Picture
    ' The Tooltip for the icon - sets the Tooltip that will be displayed
    TrayIcon.szTip = "Mind's Tray Icon Example" & Chr$(0)
    
    ' Add icon to the tray by calling the Shell_NotifyIcon API
    'NIM_ADD is a Constant - add icon to tray
    Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
    
    ' Don't let application appear in the Windows task list
    App.TaskVisible = False
    Me.Hide
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Static Message As Long
Static RR As Boolean
    
    'x is the current mouse location along the x-axis
    Message = X / Screen.TwipsPerPixelX
    
    If RR = False Then
        RR = True
        Select Case Message
            Case WM_LBUTTONUP
            'Me.Visible = True
               
                SendMessage Me.hwnd, WM_SYSCOMMAND, SC_RESTORE, 0&
                ShowWindow Me.hwnd, SW_SHOWNORMAL
                SetForegroundWindow Me.hwnd
                
'            ' Left double click (This should bring up a dialog box)
'            Case WM_LBUTTONDBLCLK
'                'Me.Visible = True
'
'                Me.Show
'
'                SetForegroundWindow Me.hwnd
'                Me.SetFocus
'            ' Right button up (This should bring up a menu)
            Case WM_RBUTTONUP
                Me.PopupMenu mnuPopUp
        End Select
        RR = False
    End If
    
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)    TrayIcon.cbSize = Len(TrayIcon)
    TrayIcon.hwnd = Me.hwnd
    TrayIcon.uId = vbNull
    'Remove icon for Tray
    Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
    
End Sub
Private Sub Form_Resize()    If Me.WindowState = vbMinimized Then
     Me.Hide
    End If
    
End SubPrivate Sub mnuAbout_Click()    frmAbout.ShowEnd SubPrivate Sub mnuChange_Click()    'checks to find what icon is currently displayed
    If TrayIcon.hIcon = imgIcon1.Picture Then
        'changes the icon to display
        TrayIcon.hIcon = imgIcon2.Picture
        'removes current icon from tray
        Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
         'calls the API to add in new icon
        Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
    Else
        'changes the icon to display
        TrayIcon.hIcon = imgIcon1.Picture
        'removes current icon from tray
         Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
        'calls the API to add in new icon
        Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
    End If
        
End Sub
Private Sub mnuExit_Click()    Unload MeEnd SubAttribute VB_Name = "Tray"
Option Explicit
'Win32 API declaration
Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean' Constants used to detect clicking on the icon
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONUP = &H205
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202' Constants used to control the icon
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIF_MESSAGE = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4' Used as the ID of the call back message
Public Const WM_MOUSEMOVE = &H200' Used by Shell_NotifyIcon
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'create variable of type NOTIFYICONDATA
Public TrayIcon As NOTIFYICONDATA

Answer 3

这一函数应这样纠正一下
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Static Message As Long
Static RR As Boolean
    
    'x is the current mouse location along the x-axis
    Message = X / Screen.TwipsPerPixelX
If Y =0    
    If RR = False Then
        RR = True
        Select Case Message
            Case WM_LBUTTONUP
            'Me.Visible = True
              
                SendMessage Me.hwnd, WM_SYSCOMMAND, SC_RESTORE, 0&
                ShowWindow Me.hwnd, SW_SHOWNORMAL
                SetForegroundWindow Me.hwnd
                
'            ' Left double click (This should bring up a dialog box)
'            Case WM_LBUTTONDBLCLK
'                'Me.Visible = True
'
'                Me.Show
'
'                SetForegroundWindow Me.hwnd
'                Me.SetFocus
'            ' Right button up (This should bring up a menu)
            Case WM_RBUTTONUP
                Me.PopupMenu mnuPopUp
        End Select
        RR = False
    End If
End If    
End Sub