📄 chat.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"
Begin VB.Form form1
BorderStyle = 1 'Fixed Single
Caption = "局域网聊天程序"
ClientHeight = 7110
ClientLeft = 45
ClientTop = 330
ClientWidth = 5265
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7110
ScaleWidth = 5265
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox txtRemotePort
Height = 285
Left = 1440
TabIndex = 10
Top = 720
Width = 2145
End
Begin VB.TextBox txtLocalPort
Height = 285
Left = 1440
TabIndex = 9
Top = 420
Width = 2145
End
Begin VB.TextBox txtRemoteIP
Height = 285
Left = 1440
TabIndex = 8
Top = 120
Width = 2145
End
Begin ComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 285
Left = 0
TabIndex = 4
Top = 6825
Width = 5265
_ExtentX = 9287
_ExtentY = 503
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 2
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 2
Text = " 未连接... "
TextSave = " 未连接... "
Key = "STATUS"
Object.Tag = ""
Object.ToolTipText = "The current status of the connection"
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 6668
TextSave = ""
Key = "DATA"
Object.Tag = ""
Object.ToolTipText = "The last data transfer through the modem"
EndProperty
EndProperty
End
Begin VB.CommandButton cmdClear
Caption = "清除"
Height = 285
Left = 120
TabIndex = 3
Top = 6480
Width = 1545
End
Begin VB.CommandButton cmdConnect
Caption = "连接"
BeginProperty Font
Name = "Arial"
Size = 13.5
Charset = 161
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 885
Left = 3720
TabIndex = 2
Top = 120
Width = 1365
End
Begin VB.Frame Frame2
Caption = "发送"
Enabled = 0 'False
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2415
Left = 90
TabIndex = 1
Top = 3960
Width = 5025
Begin VB.TextBox Text2
Height = 2055
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 13
Top = 240
Width = 4815
End
End
Begin VB.Frame Frame1
Caption = "接收"
Enabled = 0 'False
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 = 0
Top = 1200
Width = 5025
Begin VB.TextBox Text1
Height = 2055
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 12
Top = 240
Width = 4815
End
End
Begin MSWinsockLib.Winsock Winsock1
Left = 2040
Top = 6480
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin VB.Label Label4
Caption = "在下面输入文字后按Enter键发送信息"
Height = 255
Left = 720
TabIndex = 11
Top = 3720
Width = 3615
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "远程端口:"
Height = 180
Left = 90
TabIndex = 7
Top = 772
Width = 1350
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "本机端口:"
Height = 180
Left = 90
TabIndex = 6
Top = 472
Width = 1350
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "对方主机IP地址:"
Height = 180
Left = 90
TabIndex = 5
Top = 172
Width = 1350
End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private IgnoreText As Boolean
'----------------------各控件说明----------------------------
'--名称-------------类型---------------作用------------------
'frmMain Form CHAT主窗体
'Winsock1 Winsock 连接控件
'Label1 Label CONNECT WITH IP标签
'Label2 Label LOCAL PORT标签
'Label3 Label REMOTE PORT标签
'txtRemoteIP TextBox 远程IP地址输入框
'txtLocalPort TextBox 本地PORT输入框
'txtRemotePort TextBox 远程PORT输入框
'cmdConnect CommandButton 连接CONNECT按钮
'Label4 Label Type your text and hit Enter to send it.标签
'Frame1(remoteip) Frame REMOTE IP 框架
'Frame2(host ip) Frame HOST IP 框架
'Text1 TextBox 显示对方（远程主机）发送的CHAT内容
'Text2 TextBox 输入己方（本地主机）要发送的CHAT内容，按ENTER键发送
'cmdClear CommandButton 清空输入框（TEXT2）和显示框（TEXT1）中的内容
'StatusBar1 StatusBar 状态栏
'当CLEAR按钮按下时，清空TEXT1和TEXT2中的内容
Private Sub cmdClear_Click()
Text1 = ""
With Text2
'清空输入框
.Text = " "
'并把焦点置于TEXT2
.SetFocus
End With
End Sub
'当CONNECT按钮按下时，进行以下操作
Private Sub cmdConnect_Click()
On Error GoTo ErrHandler
With Winsock1
'设置 RemoteHost 属性
.RemoteHost = Trim(txtRemoteIP)
'设置 RemotePort 属性
'RemotePort 属性的值应该等于 远程主机上的 LocalHost 属性的值
.RemotePort = Trim(txtRemotePort)
'LocalPort 属性的值是不能改变的,必须检查它是否已经被设置
'如果 LocalPort 属性为空（没有被设置），将其设为在LocalPort输入框中输入的数值
If .LocalPort = Empty Then
.LocalPort = Trim(txtLocalPort)
Frame2.Caption = .LocalIP
'这是必须的，Bind 方法的作用是为控件“保留”一个本地端口,防止被其他用户调用。
.Bind .LocalPort
End If
End With
'为了保证使用者不能改变LocalPort的值，将txtLocalPort输入框锁定
txtLocalPort.Locked = True
'在状态栏中显示“正在连接”的状态
StatusBar1.Panels(1).Text = " 正在连接 " & Winsock1.RemoteHost & " "
'如果连接正常，做以下设置
Frame1.Enabled = True
Frame2.Enabled = True
Label4.Visible = True
Text2.SetFocus
Exit Sub
'如果在连接过程中出现错误，则转向ErrHandler:，并显示错误提示
ErrHandler:
MsgBox "连接远程主机失败！", vbCritical
End Sub
'当窗体加载时显示提示信息并在 txtRemoteIP 框中显示本地主机的IP
Private Sub Form_Load()
Show
txtRemoteIP = Winsock1.LocalIP
End Sub
Private Sub Label5_Click()
End Sub
'接收TEXT2输入框的按键，并做响应
Private Sub Text2_KeyPress(KeyAscii As Integer)
'定义变量 Last_Line_Feed 来记录最后输入行的位置
Static Last_Line_Feed As Long
'定义 New_Line 字符串记录新键入的一行文本的内容
Dim New_Line As String
'如果使用者按下CLEAR按钮对输入框内容清空，这时TEXT2为空，则重设最后输入行的位置为0
If Trim(Text2) = vbNullString Then Last_Line_Feed = 0
'当使用者按下ENTER键时
If KeyAscii = 13 Then
'取得最后输入行的内容并赋值给 New_Line 字符串
New_Line = Mid(Text2, Last_Line_Feed + 1)
'重设最后输入行的位置
Last_Line_Feed = Text2.SelStart
'通过 WINSOCK 发送新输入的一行文本的内容
Winsock1.SendData New_Line
'在状态栏显示发送信息
StatusBar1.Panels(2).Text = " 发送 " & (LenB(New_Line) / 2) & " 字节 "
End If
End Sub
'当 WINSOCK 接收到新的数据（信息）时，进行以下响应
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'定义 New_Text 字符串来记录新接收的信息
Dim New_Text As String
'接收信息并赋值给 New_Text
Winsock1.GetData New_Text
'在TEXT1显示框中显示新接收到的信息
Text1.SelText = New_Text
Frame1.Caption = Winsock1.RemoteHostIP
'在状态栏中显示接收信息
StatusBar1.Panels(2).Text = " 接收到 " & bytesTotal & " 字节 "
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -