sendmsg.frm

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

                        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 uNet(l).dwDisplayType = RESOURCEDISPLAYTYPE_SERVER Then
            Dim STemps As String
            STemps = Mid(uNet(l).sRemoteName, 3, Len(uNet(l).sRemoteName))
            List1.AddItem STemps
       End If
    Next l
End If
End Sub

Private Sub Check1_Click()
  If Check1.Value = 1 Then
      Text2.Enabled = True
  ElseIf Check1.Value = 0 Then
      Text2.Enabled = False
  End If
End Sub

Private Sub Check2_Click()
If Check2.Value = 1 Then
  Open (App.Path & "\Set.ini") For Output As #1
     Print #1, "UseEnter"
  Close #1
ElseIf Check2.Value = 0 Then
  Open (App.Path & "\Set.ini") For Output As #1
     Print #1, "NoEnter"
  Close #1
End If
End Sub
Private Sub Command2_Click()
   Text1.Text = ""
   Text1.SetFocus
End Sub

Private Sub EXIT_Click()
   End
End Sub

Private Sub Form_Load()
    Ascii = 0
    Dim X As Integer, Domain As String
    i = 0
    j = 0
    If App.PrevInstance Then
        MsgBox "信使服务程序已经处于运行状态", 16, "信使服务5.0"
    End
    End If
    
    Call GetNeighbor  '获取局域网内计算机的名称
    If List1.ListCount = 0 Then
       Frame2.Caption = "发送信息的内容（手工设置计算机名称状态）"
          Open (App.Path & "\UserName.ini") For Input As #1
              Do While Not EOF(1)
                 Line Input #1, Intext
                 List1.AddItem Intext
              Loop
          Close #1
    Else
      Frame2.Caption = "发送信息的内容"
    End If
    
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
    
         Open (App.Path & "\Noname.ini") For Input As #1
               Line Input #1, Intext
         Close #1
            If Intext = "True" Then
                Check1.Value = 1
            ElseIf Intext = "False" Then
                Check1.Value = 0
            End If
            If Check1.Value = 1 Then
                Open (App.Path & "\Noname.ini") For Input As #1
                    Line Input #1, Intext
                    Line Input #1, Intext1
                Close #1
               Text2.Enabled = True
               Text2.Text = Intext1
            Else
               Check1.Value = 0
               Text2.Enabled = False
            End If

         Open (App.Path & "\Set.ini") For Input As #1
               Line Input #1, Intext
         Close #1
            If Intext = "UseEnter" Then
               Check2.Value = 1
            Else
               Check2.Value = 0
            End If
End Sub
Private Sub Command1_Click()
    Dim X As Boolean
    '将选中的计算机名称保存到数组当中
  If Ascii = 1 Then
  j = 0
  n = 0
     For n = 0 To List1.ListCount - 1
         If List1.Selected(n) = True Then
             StrList(j) = List1.list(n)
             j = j + 1
         ElseIf List1.Selected(n) = False Then
         End If
     Next n
  ElseIf Ascii = 0 Then
     StrList(0) = List1.list(List1.ListIndex)
  End If
     Ascii = 0                 '取消群发操作

    GetComputerName StrName, 200
    If Text1.Text = "" Then
      MsgBox "不能发送空信息!", , "提示信息"
    Else
        If i = 1 Then     '选中接收信息的计算机
            If j = 0 Then
                    X = SendMessage(StrName, StrList(j), Text1.Text)
            ElseIf j > 0 Then
                For n = 0 To j - 1
                    X = SendMessage(StrName, StrList(n), Text1.Text)
                Next n
            End If
                If X Then
                   If Check1.Value = 1 Then
                       MsgBox "成功发送匿名消息", vbInformation, "发送消息"
                   ElseIf Check1.Value = 0 Then
                       MsgBox "消息成功发送", vbInformation, "发送消息"
                   End If
                    i = 0
                Else
                    MsgBox "发送消息失败", vbCritical, "发送消息"
                End If
        ElseIf i = 0 Then
           MsgBox "请您选择接收信息的计算机名称", , "提示信息"
        End If
    End If
End Sub

Private Function SendMessage(sToUser As String, sFromUser As String, sMessage As String) As Boolean
    Dim ToName() As Byte
    Dim FromName() As Byte
    Dim Msg() As Byte
    Dim l As Long
    
    ToName = StrList(n) & vbNullChar
       If Check1.Value = 1 Then
           FromName = Text2.Text & vbNullChar
       ElseIf Check1.Value = 0 Then
           FromName = StrName & vbNullChar
       End If
    Msg = Text1 & vbNullChar
    
    If NetMessageBufferSend(ByVal 0&, ToName(0), FromName(0), Msg(0), UBound(Msg)) = NERR_Success Then
        SendMessage = True
    End If

End Function

Private Sub Form_Unload(Cancel As Integer)
    If Check1.Value = 1 Then
      Open (App.Path & "\Noname.ini") For Output As #1
         Print #1, "True"
         Print #1, Text2.Text
      Close #1
    ElseIf Check1.Value = 0 Then
      Open (App.Path & "\Noname.ini") For Output As #1
         Print #1, "False"
      Close #1
    End If
End Sub

Private Sub FSXX_Click()
   Call Command1_Click    '发送信息
End Sub

Private Sub GBBYLB_Click()
   Call Form_Load
End Sub

Private Sub HCFS_Click()
  Check2.Value = 1
End Sub

Private Sub List1_Click()
  i = 1
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = 17 Then
     Ascii = 1
  End If
End Sub

Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then
       Me.PopupMenu AAA, 2
   Else
   End If
End Sub

Private Sub NMFS_Click()
  Check1.Value = 1
  Text2.Enabled = True
End Sub

Private Sub QDBYLB_Click()
   Frame2.Caption = "发送信息的内容（手工设置计算机名称状态）"
      List1.Clear
      Open (App.Path & "\UserName.ini") For Input As #1
          Do While Not EOF(1)
             Line Input #1, Intext
             List1.AddItem Intext
          Loop
      Close #1
End Sub

Private Sub QXFS_Click()
  Call Command2_Click    '取消发送
End Sub

Private Sub QXHC_Click()
  Check2.Value = 0
End Sub

Private Sub QXNM_Click()
  Check1.Value = 0
  Text2.Enabled = False
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = 13 And Check2.Value = 1 Then
     Call Command1_Click
   Else
   End If
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then
        Text1.Enabled = False
        Text1.Enabled = True
       Me.PopupMenu FILE, 2
   Else
   End If
End Sub