📄 frmchat.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form FrmChat
BorderStyle = 1 'Fixed Single
Caption = "双机对话程序（教务管理系统V1.0.0）"
ClientHeight = 6030
ClientLeft = 45
ClientTop = 330
ClientWidth = 5205
Icon = "FrmChat.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6030
ScaleWidth = 5205
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdConnect
Caption = "连接"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 3600
TabIndex = 2
Top = 240
Width = 1335
End
Begin VB.TextBox TxtLocalPort
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1920
MaxLength = 4
TabIndex = 14
Top = 480
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "超级信使"
Height = 375
Left = 3480
TabIndex = 6
Top = 5350
Width = 1095
End
Begin VB.TextBox TxtRemoteIp
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1920
MaxLength = 15
TabIndex = 0
Top = 840
Width = 1575
End
Begin VB.TextBox TxtLocalIp
Alignment = 2 'Center
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1920
TabIndex = 13
Top = 120
Width = 1575
End
Begin ComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 12
Top = 5775
Width = 5205
_ExtentX = 9181
_ExtentY = 450
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 3
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 5212
Text = "没有连接远程机器！"
TextSave = "没有连接远程机器！"
Key = ""
Object.Tag = ""
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
TextSave = ""
Key = ""
Object.Tag = ""
EndProperty
BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Style = 5
Alignment = 1
Object.Width = 1323
MinWidth = 1323
TextSave = "11:30"
Key = ""
Object.Tag = ""
EndProperty
EndProperty
End
Begin MSWinsockLib.Winsock Winsock1
Left = 4200
Top = 5400
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
LocalPort = 1234
End
Begin VB.TextBox TxtRemotePort
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1920
MaxLength = 4
TabIndex = 1
Top = 1200
Width = 1575
End
Begin VB.CommandButton CmdClear
Caption = "清空"
Height = 375
Left = 360
TabIndex = 5
Top = 5350
Width = 855
End
Begin VB.CommandButton CmdSend
Caption = "发送"
Height = 375
Left = 1920
TabIndex = 4
Top = 5350
Width = 855
End
Begin VB.Frame Frame2
Caption = "发送信息："
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 120
TabIndex = 8
Top = 4080
Width = 5025
Begin RichTextLib.RichTextBox Send
Height = 855
Left = 120
TabIndex = 3
Top = 240
Width = 4815
_ExtentX = 8493
_ExtentY = 1508
_Version = 393217
Enabled = -1 'True
ScrollBars = 3
TextRTF = $"FrmChat.frx":08CA
End
End
Begin VB.Frame Frame1
Caption = "接收信息："
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2325
Left = 120
TabIndex = 7
Top = 1680
Width = 5025
Begin RichTextLib.RichTextBox Recieve
Height = 1935
Left = 120
TabIndex = 16
Top = 240
Width = 4815
_ExtentX = 8493
_ExtentY = 3413
_Version = 393217
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 3
TextRTF = $"FrmChat.frx":0967
End
End
Begin VB.Label Label4
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 = &H00404080&
Height = 210
Left = 240
TabIndex = 15
Top = 480
Width = 1485
End
Begin VB.Label Label3
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 = &H00400000&
Height = 210
Left = 240
TabIndex = 11
Top = 1200
Width = 1575
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 = &H00400000&
Height = 210
Left = 240
TabIndex = 10
Top = 840
Width = 1575
End
Begin VB.Label Label1
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 = &H00404080&
Height = 210
Left = 240
TabIndex = 9
Top = 150
Width = 1485
End
End
Attribute VB_Name = "FrmChat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SendTxt As String
Dim RecieveTxt As String
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 CmdClear_Click()
Send.Text = ""
Recieve.Text = ""
End Sub
Private Sub cmdConnect_Click()
On Error GoTo err
If Trim(TxtRemoteIp) = "" Or Trim(TxtRemotePort) = "" Then
MsgBox "远程主机参数错误！"
Else
With Winsock1
.RemoteHost = TxtRemoteIp.Text '要连接到计算机的IP地址
.RemotePort = TxtRemotePort.Text '要连接到的端口号
.LocalPort = TxtLocalPort.Text '该Winsock控制将使用的本地端口号，便于其它方与之通讯
.Bind TxtLocalPort.Text '将该Winsock控制绑定到该本地端口
End With
StatusBar1.Panels(1).Text = "连接到远程主机： " & Winsock1.RemoteHost & "！"
TxtRemoteIp.Enabled = False
TxtRemotePort.Enabled = False
TxtLocalPort.Enabled = False
cmdConnect.Enabled = False
End If
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub
Private Sub CmdSend_Click()
On Error GoTo err:
SendTxt = Send.Text
Winsock1.SendData SendTxt
Send.Text = ""
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub
Private Sub Command1_Click()
On Error GoTo err:
If Trim(TxtRemoteIp) = "" Then
MsgBox "远程主机参数错误！"
Else
Dim X As Boolean
X = SendMsg(TxtRemoteIp.Text, TxtLocalIp.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 Sub Form_Load()
TxtLocalIp.Text = Winsock1.LocalIP
End Sub
Private Sub Form_Unload(Cancel As Integer)
Winsock1.Close
End Sub
Private Sub TxtRemotePort_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
KeyAscii = 0
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error GoTo err
Winsock1.GetData RecieveTxt
Recieve.SelText = Chr(13) + RecieveTxt
StatusBar1.Panels(2).Text = "接收到 " & bytesTotal & " 字节"
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -