sendmsg.frm

很好的行政管理系统,供大家享用,功能非常强大,希望大家的支持

VERSION 5.00
Begin VB.Form SendMsg 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "局域网通讯"
   ClientHeight    =   3270
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   6060
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   3270
   ScaleWidth      =   6060
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame3 
      Height          =   555
      Left            =   75
      TabIndex        =   6
      Top             =   2670
      Width           =   3930
      Begin VB.CheckBox Check2 
         Caption         =   "回车发送"
         Height          =   240
         Left            =   180
         TabIndex        =   9
         Top             =   210
         Width           =   1035
      End
      Begin VB.TextBox Text2 
         Height          =   300
         Left            =   2490
         TabIndex        =   8
         Top             =   165
         Width           =   1290
      End
      Begin VB.CheckBox Check1 
         Caption         =   "匿名发送"
         Height          =   225
         Left            =   1335
         TabIndex        =   7
         Top             =   210
         Width           =   1035
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "重写"
      Height          =   345
      Left            =   5130
      TabIndex        =   5
      Top             =   2880
      Width           =   870
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发送"
      Height          =   345
      Left            =   4200
      TabIndex        =   4
      Top             =   2880
      Width           =   870
   End
   Begin VB.Frame Frame2 
      Caption         =   "发送信息的内容"
      Height          =   2580
      Left            =   75
      TabIndex        =   2
      Top             =   90
      Width           =   3930
      Begin VB.TextBox Text1 
         Height          =   2175
         Left            =   155
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   3
         Top             =   285
         Width           =   3630
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "局域网中的计算机"
      Height          =   2580
      Left            =   4080
      TabIndex        =   0
      Top             =   90
      Width           =   1920
      Begin VB.ListBox List1 
         Height          =   2220
         Left            =   105
         MultiSelect     =   2  'Extended
         TabIndex        =   1
         Top             =   270
         Width           =   1665
      End
   End
   Begin VB.Menu FILE 
      Caption         =   "文件"
      Visible         =   0   'False
      Begin VB.Menu FSXX 
         Caption         =   "发送信息"
      End
      Begin VB.Menu QXFS 
         Caption         =   "取消发送"
      End
      Begin VB.Menu BB 
         Caption         =   "-"
      End
      Begin VB.Menu HCFS 
         Caption         =   "回车发送"
      End
      Begin VB.Menu QXHC 
         Caption         =   "取消回车"
      End
      Begin VB.Menu CC 
         Caption         =   "-"
      End
      Begin VB.Menu NMFS 
         Caption         =   "匿名发送"
      End
      Begin VB.Menu QXNM 
         Caption         =   "取消匿名"
      End
   End
   Begin VB.Menu AAA 
      Caption         =   "备用列表"
      Visible         =   0   'False
      Begin VB.Menu QDBYLB 
         Caption         =   "启动备用列表"
      End
      Begin VB.Menu GBBYLB 
         Caption         =   "关闭备用列表"
      End
      Begin VB.Menu AA 
         Caption         =   "-"
      End
      Begin VB.Menu EXIT 
         Caption         =   "退出信使服务"
      End
   End
End
Attribute VB_Name = "SendMsg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    Dim X As Integer
    Dim i As Integer                         '判断是否选择接收信息的计算机名称
    Dim j As Integer
    Dim n As Integer
    Dim Intext, Intext1
    Dim StrName As String * 256
    Dim StrList(20) As String                '保存接收信息的计算机名称信息
    Public Ascii As Integer                     '判断是否按下Ctrl键
    Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare Function NetMessageBufferSend Lib "NETAPI32.DLL" (Server As Any, yToName As Byte, yFromName As Any, yMsg As Byte, ByVal lSize 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 Any, lpBufferSize As Long) As Long
    Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
    Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, 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 Const RESOURCE_GLOBALNET As Long = &H2&  ' 枚举所有资源

    '  网络资源类型常数
    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
    Private Const RESOURCE_ENUM_ALL As Long = &HFFFF

'   枚举信息数据类型
Private Type NETRESOURCE
    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 Type NETRESOURCE_BUF
    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
' 获得网上邻居计算机名称的子程序
Sub GetNeighbor()
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
Dim lBufferSize As Long
Dim lLastIndex As Long
Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE_BUF
Dim uNet() As NETRESOURCE

bFirstTime = True

Do
    If bFirstTime Then
        '  启动对顶级网络资源进行枚举的过程,并返回枚举资源所用的句柄
        lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
        bFirstTime = False
    Else
        '  如果uNet(lLastIndex)资源包含了可以枚举的额外资源,并返回枚举资源所用的句柄
        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
            '  应用上面WNetOpenEnum返回的句柄枚举网络资源,并将枚举信息装载到uNetApi缓冲区
            lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)
            If lCount > 0 Then
                '  为动态数组变量重新分配存储空间
                ReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE
                For l = 0 To lCount - 1
                    '将枚举信息赋值给 uNet
                    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)