frmmain.frm

给局域网发送短消息

    Dim lBufferSize As Long
    Dim lLastIndex As Long
    Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE
    Dim uNet() As NETRESOURCE_REAL
    Dim N As Integer
    N = 1
    bFirstTime = True
    Do
        If bFirstTime Then
            lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
            bFirstTime = False
        Else
            If uNet(lLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER Then
                lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lLastIndex), hEnum)
            Else
                lReturn = NOT_A_CONTAINER
                hEnum = 0
            End If
            lLastIndex = lLastIndex + 1
        End If
        If lReturn = NO_ERROR Then
            lCount = RESOURCE_ENUM_ALL
            Do
                lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
                lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)
                If lCount > 0 Then
                    ReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE_REAL
                    For l = 0 To lCount - 1
                        'Each Resource will appear here as uNet(i)
                        uNet(lMin + l).dwScope = uNetApi(l).dwScope
                        uNet(lMin + l).dwType = uNetApi(l).dwType
                        uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType
                        uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
                        If uNetApi(l).pLocalName Then
                            lLength = lstrlen(uNetApi(l).pLocalName)
                            uNet(lMin + l).sLocalName = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sLocalName, ByVal uNetApi(l).pLocalName, lLength
                        End If
                        If uNetApi(l).pRemoteName Then
                            lLength = lstrlen(uNetApi(l).pRemoteName)
                            uNet(lMin + l).sRemoteName = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sRemoteName, ByVal uNetApi(l).pRemoteName, lLength
                        End If
                        If uNetApi(l).pComment Then
                            lLength = lstrlen(uNetApi(l).pComment)
                            uNet(lMin + l).sComment = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sComment, ByVal uNetApi(l).pComment, lLength
                        End If
                        If uNetApi(l).pProvider Then
                            lLength = lstrlen(uNetApi(l).pProvider)
                            uNet(lMin + l).sProvider = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sProvider, ByVal uNetApi(l).pProvider, lLength
                        End If
                    Next l
                End If
                lMin = lMin + lCount
            Loop While lReturn = ERROR_MORE_DATA
        End If
        If hEnum Then
            l = WNetCloseEnum(hEnum)
        End If
    Loop While lLastIndex < lMin
    
    If UBound(uNet) > 0 Then
        For l = 0 To UBound(uNet)
            If l > 15 Then Exit Sub
            If uNet(l).dwDisplayType = 2 Then
                strGroupComputerName(N) = Right(uNet(l).sRemoteName, Len(uNet(l).sRemoteName) - 2)
                If N > 10 Then
                    N = 1
                    lstComputer.MenuCur = lstComputer.MenuCur + 1
                End If
                  lstComputer.MenuItemsMax = N
                  lstComputer.MenuItemCur = N
                  lstComputer.MenuItemCaption = Right(uNet(l).sRemoteName, Len(uNet(l).sRemoteName) - 2)
                  lstComputer.MenuItemKey = Right(uNet(l).sRemoteName, Len(uNet(l).sRemoteName) - 2)
                  Set lstComputer.MenuItemIcon = istIcon.ListImages(2).Picture
                N = N + 1
            End If
        Next l
    End If
    lstComputer.MenuCur = 1
End Sub

Private Sub Form_Load()
    Me.Top = 300
    Me.Left = Screen.Width - Me.Width - 300
    'Get the username
    strComputerName = ComputerName()
    Me.Caption = strComputerName
    Call GetLocalInfo
    
    If WindowState = vbMinimized Then
        LastState = vbNormal
    Else
        LastState = WindowState
    End If
    With myData
        .cbSize = Len(myData)
        .hwnd = Me.hwnd
        .uID = 0
        .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
        .uCallbackMessage = WM_MOUSEMOVE
        .hIcon = Me.Icon.Handle '默认为窗口图标
        .szTip = "信息" & vbNullChar
        .szTip = "金狼信使!" & vbNullChar
    End With
    Shell_NotifyIcon NIM_ADD, myData
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Select Case CLng(X)
    Case WM_RBUTTONUP '鼠标在图标上右击时弹出菜单
        Me.PopupMenu mnuTray
    Case WM_LBUTTONUP '鼠标在图标上左击时窗口若最小化则恢复窗口位置
        If Me.WindowState = vbMinimized Then
            Me.WindowState = LastState
            SendMessage hwnd, WM_SYSCOMMAND, SC_RESTORE, 0&
        End If
  End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MsgBox("你是否要退出金狼信使?", vbExclamation + vbYesNo, "信息") = vbYes Then
        Cancel = False
        Shell_NotifyIcon NIM_DELETE, myData '窗口卸载时,将状态栏中的图标一同卸载
        End
    Else
        Cancel = True
    End If
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuAllway_Click()
    If mnuAllway.Checked Then
        Call NoSetWinPos(Me)
        mnuAllway.Checked = False
    Else
        Call SetWinPos(Me)
        mnuAllway.Checked = True
    End If
End Sub

Private Sub mnuTrayChangeIcon_Click()
    On Error GoTo ErrHandler:
    With cdlOpen
        .CancelError = True '设置标志
        .InitDir = App.Path '默认的文件夹为当前文件夹
        .FLAGS = cdlOFNHideReadOnly '设置过滤器
        .Filter = "图标文件 (*.ico)|*.ico" '指定缺省的过滤器为图标文件
        .ShowOpen '显示选定文件的名字
    End With
    imgIcon.Picture = LoadPicture(cdlOpen.FileName)
    With myData
        .hIcon = imgIcon.Picture
        .uFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, myData
ErrHandler:     '用户按了"取消"按钮
    Exit Sub
End Sub

Private Sub mnuTrayClose_Click()
    Unload Me
End Sub

Private Sub Form_Resize()
    Select Case WindowState
        Case vbMinimized
            Me.Hide
            mnuTrayMinimize.Enabled = False
            mnuTrayRestore.Enabled = True
        Case vbMaximized
            mnuTrayMinimize.Enabled = True
            mnuTrayRestore.Enabled = True
            tabMain.SetFocus
        Case vbNormal
            mnuTrayMinimize.Enabled = True
            mnuTrayRestore.Enabled = False
            tabMain.SetFocus
            Dim intState As Integer
            intState = Me.ScaleMode
            Me.ScaleMode = vbTwips
            Me.tabMain.Move 30, 30, Me.ScaleWidth - 60, Me.ScaleHeight - 60
            Me.lstComputer.Move 60, Me.tabMain.TabHeight + 60, Me.tabMain.Width - 120, Me.tabMain.Height - Me.tabMain.TabHeight - 120
            Me.ScaleMode = intState
    End Select
    mnuTrayMaximize.Enabled = False
    If WindowState <> vbMinimized Then LastState = WindowState
End Sub

Private Sub mnuTrayMaximize_Click()
    WindowState = vbMaximized
End Sub

Private Sub mnuTrayMinimize_Click()
    WindowState = vbMinimized
End Sub

Private Sub mnuTrayRestore_Click()
    SendMessage hwnd, WM_SYSCOMMAND, SC_RESTORE, 0&
End Sub

Private Sub lstComputer_MenuItemClick(MenuNumber As Long, MenuItem As Long)
    If lstComputer.MenuItemCaption = "关闭信使" Then
        Unload Me
        Exit Sub
    End If
    lstComputer.MenuCur = MenuNumber
    lstComputer.MenuItemCur = MenuItem

    frmSend.GetSend lstComputer.MenuItemCaption, lstComputer.MenuItemCaption
End Sub

Private Sub lstComputer_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then PopupMenu mnuTray
End Sub