frmsend.frm

给局域网发送短消息

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form frmSend 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "金狼信使"
   ClientHeight    =   4665
   ClientLeft      =   2355
   ClientTop       =   825
   ClientWidth     =   5055
   Icon            =   "frmSend.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4665
   ScaleWidth      =   5055
   ShowInTaskbar   =   0   'False
   Begin MSComctlLib.StatusBar stbInfo 
      Align           =   2  'Align Bottom
      Height          =   315
      Left            =   0
      TabIndex        =   14
      Top             =   4350
      Width           =   5055
      _ExtentX        =   8916
      _ExtentY        =   556
      Style           =   1
      SimpleText      =   "金狼信使...."
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   8864
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton cmdInfo 
      Caption         =   "信使(&I)"
      Height          =   350
      Left            =   150
      TabIndex        =   13
      Top             =   3930
      Visible         =   0   'False
      Width           =   1200
   End
   Begin VB.Frame fraThree 
      Height          =   645
      Left            =   60
      TabIndex        =   8
      Top             =   3180
      Width           =   4935
      Begin VB.ComboBox cboName 
         Height          =   315
         Left            =   645
         TabIndex        =   16
         Top             =   210
         Width           =   2145
      End
      Begin VB.CommandButton cmdSignatory 
         Caption         =   "JL"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   8.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   2880
         Picture         =   "frmSend.frx":08CA
         TabIndex        =   15
         Top             =   210
         Width           =   525
      End
      Begin VB.TextBox txtNum 
         Height          =   315
         Left            =   4380
         TabIndex        =   11
         Text            =   "1"
         Top             =   210
         Width           =   435
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "发送次数:"
         Height          =   195
         Left            =   3495
         TabIndex        =   10
         Top             =   270
         Width           =   765
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "签名:"
         Height          =   195
         Left            =   120
         TabIndex        =   9
         Top             =   270
         Width           =   405
      End
   End
   Begin VB.Frame fraOne 
      Caption         =   "发送选择"
      Height          =   855
      Left            =   60
      TabIndex        =   4
      Top             =   30
      Width           =   4935
      Begin VB.CheckBox chkAll 
         Caption         =   "群发"
         Height          =   300
         Left            =   4230
         TabIndex        =   7
         ToolTipText     =   "（发给所有该组的计算机）"
         Top             =   330
         Width           =   675
      End
      Begin VB.ComboBox cboComputer 
         Height          =   315
         Left            =   1515
         TabIndex        =   5
         Text            =   "cboComputer"
         Top             =   330
         Width           =   2595
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "请选择计算机名:"
         Height          =   195
         Left            =   90
         TabIndex        =   6
         Top             =   390
         Width           =   1305
      End
   End
   Begin VB.Frame fraTwo 
      Caption         =   "消息内容"
      Height          =   2205
      Left            =   60
      TabIndex        =   2
      Top             =   930
      Width           =   4935
      Begin VB.TextBox txtInfo 
         ForeColor       =   &H00FF0000&
         Height          =   1875
         Left            =   90
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   3
         Top             =   210
         Width           =   4725
      End
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "关闭(&C)"
      Height          =   350
      Left            =   3720
      TabIndex        =   1
      Top             =   3930
      Width           =   1200
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送(&S)"
      Height          =   350
      Left            =   2370
      TabIndex        =   0
      Top             =   3930
      Width           =   1200
   End
   Begin MSComctlLib.ProgressBar proBar 
      Height          =   315
      Left            =   150
      TabIndex        =   12
      Top             =   3390
      Width           =   4755
      _ExtentX        =   8387
      _ExtentY        =   556
      _Version        =   393216
      BorderStyle     =   1
      Appearance      =   0
   End
End
Attribute VB_Name = "frmSend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim strUserName As String
Dim strComputerName As String


Private Declare Function NetMessageBufferSend Lib _
  "NETAPI32.DLL" (yServer As Any, yToName As Byte, _
  yFromName As Any, yMsg As Byte, ByVal lSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Const NERR_Success As Long = 0&

Public Function SendMessageNet(RcptToUser As String, _
   FromUser As String, BodyMessage As String) As Boolean
 
   Dim RcptTo() As Byte
   Dim From() As Byte
   Dim Body() As Byte

   RcptTo = RcptToUser & vbNullChar
   From = FromUser & vbNullChar
   Body = BodyMessage & vbNullChar

   If NetMessageBufferSend(ByVal 0&, RcptTo(0), ByVal 0&, _
        Body(0), UBound(Body)) = NERR_Success Then
     SendMessageNet = True
   End If
End Function

Private Sub cboComputer_Change()
    Me.stbInfo.SimpleText = "金狼信使...."
End Sub

Private Sub cboComputer_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub cboName_Change()
    Me.stbInfo.SimpleText = "金狼信使...."
End Sub

Private Sub chkAll_Click()
    Me.stbInfo.SimpleText = "金狼信使...."
End Sub

Private Sub cmdSend_Click()
    Dim strInfo As String
    Dim i As Integer
    
    
    Screen.MousePointer = vbHourglass
    strInfo = "        从现在开始我只疼你一个人,要宠你,不能骗你,答应你的每一件事都要做到,对你说的每一句话都要真心,不欺负你,不骂你,要相信你,别人欺负你,我会在第一时间出来帮你,你开心呢,我就要陪着你开心,你不开心呢,我就要哄你开心,永远都觉得你是最漂亮的,做梦都会见到你,在我的梦里只有你。"
    If Trim(txtInfo.Text) <> "" Then
        strInfo = txtInfo.Text
    End If
    If Trim(cboName.Text) <> "" Then
        strInfo = strInfo & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "签名: " & Trim(cboName.Text)
    End If
    Dim blnRetVal As Boolean
    If chkAll.Value Then
        proBar.Min = 0
        proBar.Max = cboComputer.ListCount - 1
        For i = 0 To cboComputer.ListCount - 1
            proBar.Visible = True
            blnRetVal = SendMessageNet(cboComputer.List(i), strComputerName, strInfo)
            proBar.Value = i
        Next
        proBar.Visible = False
    Else
        If IsNumeric(txtNum.Text) Then
            For i = 1 To Val(txtNum.Text)
                blnRetVal = SendMessageNet(Trim(cboComputer.Text), strComputerName, strInfo)
            Next
        Else
            blnRetVal = SendMessageNet(Trim(cboComputer.Text), strComputerName, strInfo)
        End If
    End If
    If blnRetVal Then
        Me.stbInfo.SimpleText = "发送成功...."
        Dim strTemp As String
        
        If Trim(Me.cboName.Text) = "" Then
            strTemp = "未签名"
        Else
            strTemp = "签名:" & Me.cboName.Text
        End If
        Call WriteData("内容.txt", ComputerName() & "对" & Me.cboComputer.Text & " : " & Me.txtInfo.Text & Space(2) & strTemp)
    Else
        Me.stbInfo.SimpleText = "发送失败...."
    End If
    proBar.Visible = False
    txtInfo.SelStart = 0
    txtInfo.SelLength = Len(txtInfo.Text)
    txtInfo.SetFocus
    Screen.MousePointer = vbDefault
    
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdSignatory_Click()
    Call WriteData("签名.txt", Me.cboName.Text)
    Call ReadData("签名.txt")
End Sub

Private Sub WriteData(ByVal strFileName As String, ByVal strNote As String)
    '写文件
    Dim strFull As String
    Dim intFileNumber As Integer
    
    strFull = App.Path & "/" & strFileName
    intFileNumber = FreeFile
    Open strFull For Append As #intFileNumber
    Print #intFileNumber, strNote
    Close #intFileNumber
End Sub

Private Sub ReadData(ByVal strFileName As String)
    '读签名文件
    Dim strFull As String
    Dim intFileNumber As Integer
    Dim strTextLine As String
    
    Dim i As Long
    Dim blnE As Boolean
    
    strFull = App.Path & "/" & strFileName
    If Dir(strFull) = "" Then Exit Sub
    
    Me.cboName.Clear
    intFileNumber = FreeFile
    Open strFull For Input As #intFileNumber
    Do While Not EOF(intFileNumber)
        Line Input #intFileNumber, strTextLine
        For i = 0 To Me.cboName.ListCount - 1
            blnE = False
            If strTextLine = Me.cboName.List(i) Then blnE = True: Exit For
        Next i
        If Not blnE Then Me.cboName.AddItem strTextLine
    Loop
    Close #intFileNumber
End Sub

Private Sub Form_Load()
    Dim strForm As String
    
    strForm = FormSet(Me, 5)
    Me.Top = Me.Top - 600
    strUserName = String(100, Chr$(0))
    GetUserName strUserName, 100
    strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
    txtInfo.Text = ""
    proBar.Visible = False
    strComputerName = ComputerName()
    cboComputer.Clear
    Call GetLocalComputer
    Call ReadData("签名.txt")
End Sub

Public Sub GetSend(ByVal strCaption As String, ByVal strSender As String)
    Me.Caption = strCaption
    Me.cboComputer.Text = strSender
    Me.Show vbModal
End Sub

Private Sub mnuExit_Click()
  Unload Me
End Sub


Private Sub mnuTrayClose_Click()
  Unload Me
End Sub

Private Sub txtInfo_Change()
    Me.stbInfo.SimpleText = "金狼信使...."
End Sub

Private Sub txtInfo_GotFocus()
    txtInfo.SelStart = 0
    txtInfo.SelLength = Len(txtInfo.Text)
End Sub

Private Sub txtInfo_KeyPress(KeyAscii As Integer)
    If KeyAscii = 10 Then
        Call cmdSend_Click
    End If
End Sub

Private Sub txtNum_KeyPress(KeyAscii As Integer)
    '只允许输入数字
    If (KeyAscii <> vbKeyDelete) And (KeyAscii <> vbKeyBack) And (KeyAscii <> 13) _
    And (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0
    Me.stbInfo.SimpleText = "金狼信使...."
End Sub

Private Sub GetLocalComputer()
    Dim i As Integer
    cboComputer.Clear
    For i = 0 To UBound(strGroupComputerName)
        If Len(Trim(strGroupComputerName(i))) > 0 Then
            cboComputer.AddItem strGroupComputerName(i)
        End If
    Next
End Sub