frmmain.frm

给局域网发送短消息

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{628CC7D5-A6CF-11D0-B997-00805F024BFD}#1.0#0"; "VertMenu.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmMain 
   Caption         =   "金狼信使"
   ClientHeight    =   7020
   ClientLeft      =   7965
   ClientTop       =   1290
   ClientWidth     =   2730
   Icon            =   "FrmMain.frx":0000
   MaxButton       =   0   'False
   ScaleHeight     =   468
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   182
   Begin TabDlg.SSTab tabMain 
      Height          =   7035
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2745
      _ExtentX        =   4842
      _ExtentY        =   12409
      _Version        =   393216
      Style           =   1
      Tabs            =   1
      TabsPerRow      =   1
      TabHeight       =   529
      TabCaption(0)   =   "金狼面板"
      TabPicture(0)   =   "FrmMain.frx":08CA
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "lstComputer"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      Begin VertMenu.VerticalMenu lstComputer 
         CausesValidation=   0   'False
         Height          =   6615
         Left            =   60
         TabIndex        =   1
         Top             =   360
         Width           =   2625
         _ExtentX        =   4630
         _ExtentY        =   11668
         Enabled         =   -1  'True
         MenusMax        =   3
         MenuCaption1    =   "网上电脑"
         MenuItemIcon11  =   "FrmMain.frx":08E6
         MenuItemCaption11=   "Item1"
         MenuCaption2    =   "更多机器"
         MenuItemsMax2   =   0
         MenuCaption3    =   "金狼信使"
         MenuItemIcon31  =   "FrmMain.frx":0AC0
         MenuItemCaption31=   "关闭信使"
         Enabled         =   -1  'True
      End
   End
   Begin MSComctlLib.ImageList istIcon 
      Left            =   592
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":0C9A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":2724
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":33FE
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":5108
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog cdlOpen 
      Left            =   1170
      Top             =   45
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Image imgIcon 
      Height          =   570
      Left            =   0
      Top             =   0
      Width           =   585
   End
   Begin VB.Menu mnuTray 
      Caption         =   "PopupTray"
      Visible         =   0   'False
      Begin VB.Menu mnuAllway 
         Caption         =   "总在最前面"
      End
      Begin VB.Menu mnuLine2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuTrayChangeIcon 
         Caption         =   "更换图标(&I)"
      End
      Begin VB.Menu mnuLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuTrayMinimize 
         Caption         =   "最小化(&N)"
      End
      Begin VB.Menu mnuTrayRestore 
         Caption         =   "恢复(&R)"
      End
      Begin VB.Menu mnuTrayMaximize 
         Caption         =   "最大化(&X)"
      End
      Begin VB.Menu mnuTrayLine 
         Caption         =   "-"
      End
      Begin VB.Menu mnuTrayClose 
         Caption         =   "退出(&C)"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
    Option Explicit
    '***************************************************
    
    Private strUserName As String
    Private strComputerName As String
    Private myData As NOTIFYICONDATA
    
    '***************************************************
    
    Private Const RESOURCE_CONNECTED As Long = &H1&
    Private Const RESOURCE_GLOBALNET As Long = &H2&
    Private Const RESOURCE_REMEMBERED As Long = &H3&
    
    Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9
    Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1
    Private Const RESOURCEDISPLAYTYPE_FILE& = &H4
    Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0
    Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5
    Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6
    Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7
    Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2
    Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
    Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8
    Private Const RESOURCETYPE_ANY As Long = &H0&
    Private Const RESOURCETYPE_DISK As Long = &H1&
    Private Const RESOURCETYPE_PRINT As Long = &H2&
    Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&
    Private Const RESOURCEUSAGE_ALL As Long = &H0&
    Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
    Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&
    Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000
    Private Const NO_ERROR = 0
    Private Const ERROR_MORE_DATA = 234 'L    // dderror
    Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
    Private Type NETRESOURCE
        dwScope As Long
        dwType As Long
        dwDisplayType As Long
        dwUsage As Long
        pLocalName As Long
        pRemoteName As Long
        pComment As Long
        pProvider As Long
    End Type
    Private Type NETRESOURCE_REAL
        dwScope As Long
        dwType As Long
        dwDisplayType As Long
        dwUsage As Long
        sLocalName As String
        sRemoteName As String
        sComment As String
        sProvider As String
    End Type
    Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
    Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
    Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
    Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
    Private Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject As Any) As Long
    Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
    Private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)
    Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
    Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long

    'Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    'Private Const SW_SHOWNORMAL = 1
    '
    'Private Sub 关联文件()
    '    ShellExecute Me.hwnd, "open", "c:\test.jpg", vbNullString, vbNullString, SW_SHOWNORMAL
    '    ShellExecute Me.hwnd, "open", "c:\test.bmp", vbNullString, vbNullString, SW_SHOWNORMAL
    '    ShellExecute Me.hwnd, "open", "c:\test.txt", vbNullString, vbNullString, SW_SHOWNORMAL
    '    ShellExecute Me.hwnd, "open", "c:\test.exe", vbNullString, vbNullString, SW_SHOWNORMAL
    'End Sub

Private Sub GetLocalInfo()
    Const MAX_RESOURCES = 256
    Const NOT_A_CONTAINER = -1

    Dim bFirstTime As Boolean
    Dim lReturn As Long
    Dim hEnum As Long
    Dim lCount As Long
    Dim lMin As Long
    Dim lLength As Long
    Dim l As Long