📄 frmtcpserver.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "mswinsck.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmTCPServer
Caption = "TCP服务器"
ClientHeight = 6000
ClientLeft = 285
ClientTop = 1035
ClientWidth = 5745
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6000
ScaleWidth = 5745
Begin VB.CommandButton cmdSendData
Caption = "发送信息"
Height = 375
Left = 720
TabIndex = 13
Top = 5160
Width = 1095
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 8
Top = 5625
Width = 5745
_ExtentX = 10134
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 9631
Object.ToolTipText = "服务器状态"
EndProperty
EndProperty
End
Begin VB.Timer Timer1
Interval = 500
Left = 2880
Top = 3720
End
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 375
Left = 3480
TabIndex = 7
Top = 5160
Width = 1095
End
Begin VB.CommandButton cmdCloseListen
Caption = "关闭监听"
Height = 375
Left = 3600
TabIndex = 6
Top = 1320
Width = 975
End
Begin VB.CommandButton cmdListen
Caption = "监听"
Height = 375
Left = 840
TabIndex = 5
Top = 1320
Width = 975
End
Begin VB.TextBox txtSend
Height = 975
Left = 240
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 3
Top = 4080
Width = 5175
End
Begin VB.TextBox txtReceive
Height = 1695
Left = 240
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 1
Top = 2040
Width = 5175
End
Begin MSWinsockLib.Winsock sckTCPServer
Left = 3480
Top = 3720
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.TextBox txtServerPort
Height = 270
Left = 1320
MaxLength = 5
TabIndex = 0
Top = 952
Width = 1095
End
Begin VB.Label ClientPort
Height = 255
Left = 4080
TabIndex = 20
Top = 960
Width = 1455
End
Begin VB.Label ClientIP
Height = 255
Left = 4080
TabIndex = 19
Top = 600
Width = 1335
End
Begin VB.Label ClientName
Height = 255
Left = 4080
TabIndex = 18
Top = 240
Width = 1335
End
Begin VB.Label label7
Caption = "客户端主机名："
Height = 255
Left = 2640
TabIndex = 17
Top = 240
Width = 1455
End
Begin VB.Label label8
Caption = "客户端IP地址："
Height = 255
Left = 2640
TabIndex = 16
Top = 600
Width = 1335
End
Begin VB.Label label9
Caption = "客户端端口："
Height = 255
Left = 2640
TabIndex = 15
Top = 960
Width = 1455
End
Begin VB.Label Label1
Caption = "本地端口："
Height = 255
Left = 240
TabIndex = 14
Top = 960
Width = 1095
End
Begin VB.Label Label4
Caption = "本地主机名："
Height = 255
Left = 240
TabIndex = 12
Top = 240
Width = 1095
End
Begin VB.Label labelLocalHostName
Height = 255
Left = 1320
TabIndex = 11
Top = 240
Width = 1215
End
Begin VB.Label labelLocalHostIP
Height = 255
Left = 1320
TabIndex = 10
Top = 600
Width = 1215
End
Begin VB.Label Label5
Caption = "本地IP地址："
Height = 255
Left = 240
TabIndex = 9
Top = 600
Width = 1215
End
Begin VB.Label Label3
Caption = "发送信息："
Height = 255
Left = 240
TabIndex = 4
Top = 3840
Width = 2175
End
Begin VB.Label Label2
Caption = "接收信息："
Height = 255
Left = 240
TabIndex = 2
Top = 1800
Width = 1935
End
End
Attribute VB_Name = "frmTCPServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义表示是否建立连接的标志:ConnectedFlag
Private ConnectedFlag As Boolean
''停止监听'按钮的click事件子过程，当鼠标单击停止监听按钮时执行此过程
Private Sub cmdCloseListen_Click()
'首先判断Winsock控件的状态
'如果Winsock已经处于监听或连接的状态，则关闭当前的侦听套接字或TCP连接
If sckTCPServer.State = sckListening Or sckTCPServer.State = sckConnected Then
'调用Winsock控件的close方法，关闭当前的连接或侦听套接字
sckTCPServer.Close
'置连接标志为“否”
ConnectedFlag = False
'使能'监听'按钮，禁止'停止监听'按钮和'发送信息'按钮
cmdCloseListen.Caption = "停止监听"
cmdListen.Enabled = True
cmdCloseListen.Enabled = False
cmdSendData.Enabled = False
ClientName.Caption = ""
ClientIP.Caption = ""
ClientPort.Caption = ""
txtServerPort.Text = "6000"
End If
End Sub
''退出'按钮的click事件子过程，当鼠标单击退出按钮时执行此过程
Private Sub cmdExit_Click()
'卸载当前窗体
Unload Me
End Sub
''监听'按钮的click事件子过程，当鼠标单击监听按钮时执行此过程
Private Sub cmdListen_Click()
'将Winsock控件关闭
sckTCPServer.Close
On Error GoTo listen_err
'给Winsock控件分配端口(LocalPort属性)
sckTCPServer.LocalPort = CLng(txtServerPort.Text)
'调用Winsock控件的Listen方法，使Winsock控件处于监听状态
sckTCPServer.Listen
'如果连接成功，Winsock控件状态是'sckListening',即监听状态
If sckTCPServer.State = sckListening Then
'使能'停止监听'按钮，禁止'监听'按钮
cmdCloseListen.Enabled = True
cmdCloseListen.Caption = "停止监听"
cmdListen.Enabled = False
txtServerPort.Text = CStr(sckTCPServer.LocalPort)
End If
listen_exit:
Exit Sub
listen_err:
Select Case Err
Case 380: MsgBox "端口属性值无效", vbOKOnly, "服务器警告"
Case 10048: MsgBox "端口已占用", vbOKOnly, "服务器警告"
Case Else: MsgBox "服务器错误：" & vbCrLf & CStr(Err), vbExclamation Or vbOKOnly, "服务器警告"
End Select
Resume listen_exit
End Sub
''发送信息'按钮的click事件子过程，当鼠标单击发送信息按钮时执行此过程
Private Sub cmdSendData_Click()
'如果发送信息的文本框中的内容为'空'，则退出此过程
If Trim(txtSend.Text) = "" Then
txtSend.Text = ""
Exit Sub
End If
'定义临时变量data
Dim data As String
' 打开错误处理程序
On Local Error GoTo SendData_error
'调用Winsock控件的senddata方法，将发送信息文本框中的信息发送出去
sckTCPServer.SendData txtSend.Text
'将发送的信息在接收信息文本框中显示出来
If Len(txtReceive.Text) Then
data = vbCrLf & "服务器信息：" & txtSend.Text
Else
data = "服务器信息：" & txtSend.Text
End If
txtReceive.SelStart = Len(txtReceive.Text)
txtReceive.SelText = data
txtReceive.SelStart = Len(txtReceive.Text)
txtSend.Text = ""
SendData_exit:
Exit Sub
' 错误处理程序
SendData_error:
' 检查错误代号,显示错误信息
Select Case Err
Case sckBadState:
MsgBox Err.Description & vbCrLf & "服务器未连接到客户端", vbExclamation Or vbOKOnly, "服务器警告"
Case Else:
MsgBox Err.Description & vbExclamation Or vbOKOnly, "服务器警告"
End Select
'在错误处理程序结束后，恢复原有的运行，返回到产生错误的语句
Resume SendData_exit
End Sub
'窗体装载子过程，当窗体装载时调用此过程
Private Sub Form_Load()
'显示服务器的计算机名和IP地址
labelLocalHostName.Caption = sckTCPServer.LocalHostName
labelLocalHostIP.Caption = sckTCPServer.LocalIP
'使能'监听'按钮，禁止'停止监听'按钮和'发送信息'按钮
cmdListen.Enabled = True
cmdCloseListen.Enabled = False
cmdSendData.Enabled = False
'初始化服务器的端口为“6000”，用户可在此修改
txtServerPort.Text = "6000"
End Sub
'窗体卸载子过程，当窗体卸载时调用此过程
Private Sub Form_Unload(Cancel As Integer)
'关闭Winsock控件
sckTCPServer.Close
End Sub
'Winsock控件关闭事件子过程，当远程计算机关闭连接时调用此过程
Private Sub sckTCPServer_Close()
'如果已经处在连接的状态，则关闭连接，同时提示信息
If ConnectedFlag = True Then
If sckTCPServer.State = sckClosing Then
ConnectedFlag = False
MsgBox "到客户端的连接意外终止。", vbExclamation Or vbOKOnly, "服务器警告"
sckTCPServer.Close
cmdCloseListen.Enabled = False
cmdListen.Enabled = True
cmdSendData.Enabled = False
ClientName.Caption = ""
ClientIP.Caption = ""
ClientPort.Caption = ""
txtServerPort.Text = "6000"
End If
End If
End Sub
'Winsock控件的远程计算机请求连接事件子过程
Private Sub sckTCPServer_ConnectionRequest(ByVal requestID As Long)
'检查控件是否处于关闭状态，如果不是，在接受新的连接前先关闭连接
If sckTCPServer.State <> sckClosed Then
sckTCPServer.Close
End If
sckTCPServer.Accept requestID
cmdCloseListen.Caption = "断开连接"
End Sub
'Winsock控件的新数据到达事件子过程,当接收到客户端的数据时调用此过程
Private Sub sckTCPServer_DataArrival(ByVal bytesTotal As Long)
Dim data As String
'判断是否已经连接(收到客户端发送的客户端主机名)
'是则接收数据，同时在接收信息文本框中显示
'否，则说明是第一次接收数据，发送服务器的主机名
'注：根据约定，客户端建立连接时，首先发送客户端的主机名；服务器收到后，发送服务器的主机名
If ConnectedFlag = True Then
sckTCPServer.GetData data
If Len(txtReceive.Text) Then
data = vbCrLf & "客户端信息：" & data
Else
data = "客户端信息：" & data
End If
txtReceive.SelStart = Len(txtReceive.Text)
txtReceive.SelText = data
txtReceive.SelStart = Len(txtReceive.Text)
Else
ConnectedFlag = True
sckTCPServer.GetData data
sckTCPServer.SendData sckTCPServer.LocalHostName
txtSend.SetFocus
cmdSendData.Enabled = True
ClientName.Caption = data
ClientIP.Caption = sckTCPServer.RemoteHostIP
ClientPort.Caption = sckTCPServer.RemotePort
End If
End Sub
'Winsock控件的错误事件子过程
Private Sub sckTCPServer_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'提示错误信息
MsgBox "服务器错误：" & vbCrLf & Description, vbExclamation Or vbOKOnly, "服务器警告"
'关闭Winsock控件
sckTCPServer.Close
End Sub
'Timer的Timer事件子过程
Private Sub Timer1_Timer()
'监控服务器状态，并在状态栏中显示
Select Case sckTCPServer.State
Case 0: StatusBar1.Panels(1) = "服务器已关闭"
Case 2: StatusBar1.Panels(1) = "服务器正在" & CStr(sckTCPServer.LocalPort) & "端口监听"
Case 7: StatusBar1.Panels(1) = "与客户端建立连接"
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -