frmxs.frm

本软件为免费软件

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{15F8A61A-A8F0-11D2-8350-DA7378C7D4D3}#1.1#0"; "TRAYFORM.OCX"
Begin VB.Form FrmXS 
   Caption         =   "超级信使"
   ClientHeight    =   6000
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5175
   Icon            =   "FrmXS.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6000
   ScaleWidth      =   5175
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Caption         =   "发送消息："
      Height          =   4695
      Left            =   0
      TabIndex        =   4
      Top             =   720
      Width           =   5175
      Begin RichTextLib.RichTextBox Send 
         Height          =   4335
         Left            =   120
         TabIndex        =   5
         Top             =   240
         Width           =   4935
         _ExtentX        =   8705
         _ExtentY        =   7646
         _Version        =   393217
         Enabled         =   -1  'True
         ScrollBars      =   3
         TextRTF         =   $"FrmXS.frx":08CA
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "清空"
      Height          =   375
      Left            =   2640
      TabIndex        =   3
      Top             =   5520
      Width           =   735
   End
   Begin VB.TextBox TxtRemoteIp 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   1560
      MaxLength       =   15
      TabIndex        =   0
      Top             =   120
      Width           =   3255
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发送信息"
      Height          =   375
      Left            =   3840
      TabIndex        =   1
      Top             =   5520
      Width           =   1095
   End
   Begin TrayFormControl.TrayForm TrayForm1 
      Left            =   840
      Top             =   5520
      _ExtentX        =   2064
      _ExtentY        =   794
      Icon            =   "FrmXS.frx":0B54
      ToolTip         =   "超级信使（双击弹出）"
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "远程主机"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00008000&
      Height          =   210
      Left            =   480
      TabIndex        =   2
      Top             =   180
      Width           =   915
   End
End
Attribute VB_Name = "FrmXS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 Sub Command1_Click()
On Error GoTo err:
If Trim(TxtRemoteIp) = "" Then
    MsgBox "远程主机参数错误！"
Else
    Dim X As Boolean
    X = SendMsg(TxtRemoteIp.Text, "石甸初中 倪德根", Send.Text)
    If X Then
        MsgBox "消息已被成功发送", vbInformation, "发送消息"
    Else
        MsgBox "发送消息失败", vbCritical, "发送消息"
    End If
End If
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Function SendMsg(sToUser As String, sFromUser As String, sMessage As String) As Boolean
    
    Dim yToName() As Byte
    Dim yFromName() As Byte
    Dim yMsg() As Byte
    Dim l As Long
    
    yToName = sToUser & vbNullChar
    yFromName = sFromUser & vbNullChar
    yMsg = sMessage & vbNullChar

    If NetMessageBufferSend(ByVal 0&, yToName(0), ByVal 0&, yMsg(0), UBound(yMsg)) = NERR_Success Then
        SendMsg = True
    End If
End Function

Private Sub Command2_Click()
Send.Text = ""
End Sub