frmmain.frm

VB类QQ聊天程序NETICE版 VB类QQ聊天程序NETICE版

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmMain 
   Caption         =   "局域网消息发送器（通用咨询公司专用）VER 1.0"
   ClientHeight    =   4575
   ClientLeft      =   2370
   ClientTop       =   840
   ClientWidth     =   5025
   Icon            =   "FrmMain.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   4575
   ScaleWidth      =   5025
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   405
      Left            =   420
      TabIndex        =   14
      Top             =   3990
      Visible         =   0   'False
      Width           =   1065
   End
   Begin MSComctlLib.ProgressBar ProBar 
      Height          =   345
      Left            =   120
      TabIndex        =   13
      Top             =   3330
      Width           =   4695
      _ExtentX        =   8281
      _ExtentY        =   609
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.Frame Frame3 
      Height          =   645
      Left            =   30
      TabIndex        =   8
      Top             =   3150
      Width           =   4935
      Begin VB.TextBox txtNum 
         Height          =   315
         Left            =   3210
         TabIndex        =   12
         Text            =   "1"
         Top             =   210
         Width           =   1455
      End
      Begin VB.TextBox txtName 
         Height          =   315
         Left            =   750
         TabIndex        =   10
         Top             =   180
         Width           =   1245
      End
      Begin VB.Label Label4 
         Caption         =   "发送次数："
         Height          =   285
         Left            =   2190
         TabIndex        =   11
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label3 
         Caption         =   "签名："
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Width           =   945
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "发送选择"
      Height          =   855
      Left            =   30
      TabIndex        =   4
      Top             =   30
      Width           =   4935
      Begin VB.CheckBox Check1 
         Caption         =   "群发"
         Height          =   255
         Left            =   3660
         TabIndex        =   7
         ToolTipText     =   "（发给所有该组的计算机）"
         Top             =   390
         Width           =   945
      End
      Begin VB.ComboBox cboComputer 
         Height          =   300
         Left            =   1590
         TabIndex        =   5
         Text            =   "cboComputer"
         Top             =   360
         Width           =   1755
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "请选择计算机名："
         Height          =   180
         Left            =   150
         TabIndex        =   6
         Top             =   420
         Width           =   1440
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "消息内容"
      Height          =   2205
      Left            =   30
      TabIndex        =   2
      Top             =   930
      Width           =   4935
      Begin VB.TextBox Text1 
         ForeColor       =   &H00FF0000&
         Height          =   1905
         Left            =   30
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   3
         Text            =   "FrmMain.frx":08CA
         Top             =   240
         Width           =   4875
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   405
      Left            =   3480
      TabIndex        =   1
      Top             =   3990
      Width           =   975
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送"
      Height          =   405
      Left            =   2040
      TabIndex        =   0
      Top             =   3990
      Width           =   975
   End
   Begin VB.Image Image1 
      Height          =   1335
      Left            =   0
      Top             =   0
      Width           =   1815
   End
End
Attribute VB_Name = "FrmMain"
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_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub cmdsend_Click()
    Dim str As String
    Dim i As Integer
    str = "古天乐：从现在开始我只疼你一个人，要宠你，不能骗你，答应你的每一件事都要做到，对你说的每一句话都要真心，不欺负你，不骂你，要相信你，别人欺负你，我会在第一时间出来帮你，你开心呢，我就要陪着你开心，你不开心呢，我就要哄你开心，永远都觉得你是最漂亮的，做梦都会见到你，在我的梦里只有你。"
    If Trim(Text1.Text) <> "" Then
        str = Text1.Text
    End If
    If Trim(txtName.Text) <> "" Then
        str = str & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "签名： " & Trim(txtName.Text)
    End If
    Dim RetVal As Boolean
    If Check1.Value Then
        ProBar.Min = 0
        ProBar.Max = cboComputer.ListCount - 1
        For i = 0 To cboComputer.ListCount - 1
            ProBar.Visible = True
            RetVal = SendMessageNet(cboComputer.List(i), strComputerName, str)
            ProBar.Value = i
        Next
        ProBar.Visible = False
    Else
        If IsNumeric(txtNum.Text) Then
            For i = 1 To Val(txtNum.Text)
                RetVal = SendMessageNet(Trim(cboComputer.Text), strComputerName, str)
            Next
        Else
            RetVal = SendMessageNet(Trim(cboComputer.Text), strComputerName, str)
        End If
    End If
    If RetVal Then
        MsgBox "发送成功! ", vbInformation, "局域网消息发送器"
    Else
        MsgBox "发送失败！", vbCritical, "局域网消息发送器"
    End If
        ProBar.Visible = False
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
    Text1.SetFocus
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Command1_Click()

   ' lblAddress.Caption = ""
'    EnumWindows AddressOf EnumProc, 0
    Command1.Tag = GetWinText("信使服务")
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)
    Text1.Text = ""
    ProBar.Visible = False
    strComputerName = ComputerName()
    cboComputer.Clear
    Call GetLocalComputer
End Sub

Private Sub mnuExit_Click()
  Unload Me
End Sub


Private Sub mnuTrayClose_Click()
  Unload Me
End Sub

Private Sub Text1_GotFocus()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_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
    End If
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