form1.frm

关于局域网发送消息的vb源代码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7260
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10125
   LinkTopic       =   "Form1"
   ScaleHeight     =   7260
   ScaleWidth      =   10125
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "发送对象"
      Height          =   6135
      Left            =   240
      TabIndex        =   10
      Top             =   240
      Width           =   2655
      Begin VB.CommandButton Command1 
         Caption         =   "搜索网络中的计算机"
         Height          =   350
         Left            =   360
         TabIndex        =   12
         Top             =   240
         Width           =   2055
      End
      Begin VB.ListBox List1 
         Height          =   5100
         Left            =   120
         MultiSelect     =   1  'Simple
         TabIndex        =   11
         Top             =   720
         Width           =   2415
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "发送内容"
      Height          =   6135
      Left            =   3120
      TabIndex        =   8
      Top             =   240
      Width           =   6735
      Begin VB.TextBox Text1 
         Height          =   5655
         Left            =   120
         TabIndex        =   9
         Top             =   360
         Width           =   6495
      End
   End
   Begin VB.Frame Frame3 
      Height          =   615
      Left            =   240
      TabIndex        =   0
      Top             =   6480
      Width           =   9615
      Begin VB.CheckBox Check1 
         Height          =   255
         Left            =   960
         TabIndex        =   4
         Top             =   230
         Width           =   255
      End
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   2880
         TabIndex        =   3
         Top             =   240
         Width           =   1935
      End
      Begin VB.CommandButton Command2 
         Caption         =   "发送消息"
         Height          =   350
         Left            =   5520
         TabIndex        =   2
         Top             =   180
         Width           =   1575
      End
      Begin VB.CommandButton Command3 
         Caption         =   "退出程序"
         Height          =   350
         Left            =   7800
         TabIndex        =   1
         Top             =   180
         Width           =   1335
      End
      Begin VB.Label Label1 
         Caption         =   "发送方式"
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   270
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "群发"
         Height          =   255
         Left            =   1200
         TabIndex        =   6
         Top             =   270
         Width           =   375
      End
      Begin VB.Label Label3 
         Caption         =   "你的签名"
         Height          =   255
         Left            =   2040
         TabIndex        =   5
         Top             =   240
         Width           =   735
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 
'初始化
Private Sub Form_Load()
 App.Title = "局域网信使"
 Me.Caption = "局域网信使-" & ComputerName
End Sub

'窗口激活时搜索计算机
Private Sub Form_Activate()
 Me.Refresh
 Call Command1_Click
End Sub

'搜索网络计算机
Private Sub Command1_Click()
 Text1.SetFocus
 Call GetNetComputerName_1(List1)
End Sub
'展开文件夹
Private Sub List1_DblClick()
    
    Dim fiTemp  As FolderItem
    Dim fiTemp2  As FolderItem
    Dim fdTemp As Folder
    Dim strTemp As String
    
    Set fiTemp = mdctItems(List1.ListIndex)
    If fiTemp.IsFolder Then
        List1.Clear
        mdctItems.RemoveAll
        Set fdTemp = fiTemp.GetFolder
        For Each fiTemp2 In fdTemp.Items
            strTemp = fdTemp.GetDetailsOf(fiTemp2, 0)
            List1.AddItem strTemp
            mdctItems.Add List1.NewIndex, fiTemp2
'            MsgBox strTemp
'            If strTemp = "\\Aiffe-05" Then Exit Sub
        Next
    End If
End Sub


'发送消息
Private Sub Command2_Click()

 Dim cMsg As String  '保存消息
 Dim tMsg As String  '保存群发失败信息
 Dim RetVal As Boolean
 
 Text1.SetFocus
 '检查是否有计算机可以接受信息
 If List1.ListCount = 0 Then
  MsgBox Chr(13) & "没有计算机可以接受消息！", vbExclamation
  Exit Sub
 End If
 
 If Check1.Value = 0 Then
  If List1.Text = "" Then
   MsgBox Chr(13) & "请选择接受消息的计算机！", vbExclamation
   List1.SetFocus: Exit Sub
  End If
 End If
 
 Text1.Text = Trim(Text1.Text)
 Text2.Text = Trim(Text2.Text)
 
 If Text1.Text = "" Then
  MsgBox Chr(13) & "发送内容不能为空！", vbExclamation
  Text1.SetFocus: Exit Sub
 End If
 
 cMsg = Text1.Text & vbCrLf & vbCrLf & "签名：" '消息内容
 
 If Text2.Text <> "" Then  '签名部分
  cMsg = cMsg & Text2.Text
 End If
 
 Frame2.ForeColor = QBColor(12)
 If Check1.Value = 0 Then  '单发
  Frame2.Caption = "正在发送消息到：" & List1.Text & "，请稍侯..."
  Frame2.Refresh
  RetVal = SendMsgInLan(Mid$(List1.Text, 3), cMsg)
  If RetVal Then
   MsgBox Chr(13) & "消息发送成功！", vbInformation
  Else
   MsgBox Chr(13) & "消息发送失败！", vbCritical
  End If
 Else   '群发
  tMsg = vbCrLf & "其中，发送到："
  For i = 0 To List1.ListCount - 1
   List1.ListIndex = i
   Frame2.Caption = "正在发送消息到：" & List1.List(i) & "，请稍候..."
   Frame2.Refresh
   RetVal = SendMsgInLan(Mid$(List1.List(i), 3), cMsg)
   If Not RetVal Then
    tMsg = tMsg & List1.List(i) & ","
   End If
  Next
  tMsg = tMsg & "失败！"
  MsgBox Chr(13) & "消息群发完成！" & vbCrLf & tMsg, vbInformation
 End If
 
 Frame2.ForeColor = QBColor(0)
 Frame2.Caption = "发送内容"
  
End Sub

'退出程序
Private Sub Command3_Click()
 End
End Sub