frmclient_chat.frm

串口程序

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmClient_Chat 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "利用Winsock控件基于TCP的局域网多站点通信程序（客户机端）"
   ClientHeight    =   4215
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7335
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4215
   ScaleWidth      =   7335
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   10
      Left            =   5520
      Top             =   3960
   End
   Begin VB.Frame Frame3 
      Caption         =   "发送消息"
      Height          =   855
      Left            =   3000
      TabIndex        =   10
      Top             =   3000
      Width           =   4215
      Begin VB.TextBox Text_SendData 
         ForeColor       =   &H00FF0000&
         Height          =   270
         Left            =   240
         TabIndex        =   12
         Text            =   "你好！我是通信工程2000级的学生。"
         Top             =   360
         Width           =   3735
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "通信记录"
      Height          =   2775
      Left            =   3000
      TabIndex        =   9
      Top             =   120
      Width           =   4215
      Begin VB.TextBox Text_GetData 
         ForeColor       =   &H00FF00FF&
         Height          =   2175
         Left            =   240
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   11
         Top             =   360
         Width           =   3735
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "连接设置"
      Height          =   3735
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2655
      Begin VB.CommandButton Command2 
         Caption         =   "断开连接"
         Height          =   375
         Left            =   360
         TabIndex        =   8
         Top             =   3120
         Width           =   1455
      End
      Begin VB.CommandButton Command1 
         Caption         =   "建立连接"
         Height          =   375
         Left            =   360
         TabIndex        =   7
         Top             =   2520
         Width           =   1455
      End
      Begin VB.TextBox Text_ServerIP 
         Height          =   270
         Left            =   360
         TabIndex        =   4
         Text            =   "211.67.216.2"
         Top             =   2040
         Width           =   1455
      End
      Begin VB.TextBox Text_LocalName 
         Height          =   270
         Left            =   360
         TabIndex        =   2
         Top             =   960
         Width           =   1455
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "连接端口号：1200"
         Height          =   180
         Left            =   360
         TabIndex        =   6
         Top             =   1440
         Width           =   1440
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "本机IP："
         Height          =   180
         Left            =   360
         TabIndex        =   5
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "服务器IP地址"
         Height          =   180
         Left            =   360
         TabIndex        =   3
         Top             =   1800
         Width           =   1080
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "本机名称"
         Height          =   180
         Left            =   360
         TabIndex        =   1
         Top             =   720
         Width           =   720
      End
   End
   Begin MSWinsockLib.Winsock TcpClient_Chat 
      Left            =   6000
      Top             =   3960
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label2 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "没有与服务器建立连接！"
      Height          =   255
      Left            =   0
      TabIndex        =   13
      Top             =   3960
      Width           =   7335
   End
End
Attribute VB_Name = "frmClient_Chat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'建立连接
'==========================================================
On Error GoTo warring '错误处理
Text_GetData.Text = "" '清空通信记录框
TcpClient_Chat.Protocol = sckTCPProtocol '基于TCP协议
TcpClient_Chat.RemoteHost = Trim(Text_ServerIP.Text) '将服务器IP地址内容的两边的空格去掉
TcpClient_Chat.RemotePort = 1200  '设置连接端口为1200
TcpClient_Chat.Connect '进行连接
Command1.Enabled = False '禁止连接按钮
Text_ServerIP.Enabled = False '禁止服务器IP填写
Text_LocalName.Enabled = False '禁止本机名称填写
Exit Sub '退出该过程
warring: MsgBox "请输入正确的服务器IP地址！", vbInformation '错误报告
TcpClient_Chat.Close '关闭Winsock控件
'=============================================================
End Sub

Private Sub Command2_Click()
'断开连接
'=============================================================
Text_ServerIP.Enabled = True '激活服务器IP地址填写
Text_LocalName.Enabled = True '激活本机名称填写
Command1.Enabled = True '激活建立连接按钮
TcpClient_Chat.Close '关闭Winsock控件
'==============================================================
End Sub

Private Sub Form_Load()

'==============================================================
Label1.Caption = "本机IP：" & TcpClient_Chat.LocalIP '显示本机IP
Text_LocalName.Text = TcpClient_Chat.LocalHostName '显示本机名称
'==============================================================
End Sub

Private Sub TcpClient_Chat_DataArrival(ByVal bytesTotal As Long)
'接收数据
'===============================================================
Dim Data As Variant
TcpClient_Chat.GetData Data, vbString '接收数据存于Data
Text_GetData.SelText = Data & vbCrLf '将Data内容显示在通信记录框，并换行
'===============================================================
End Sub
Private Sub Text_SendData_KeyDown(KeyCode As Integer, Shift As Integer)
'发送数据
'====================================================================
If KeyCode = 13 Then '如果回车
  If TcpClient_Chat.State = sckConnected Then '如果已建立连接
     '发送数据，并附加日期和时间以及发送方名称
     TcpClient_Chat.SendData "<" & Text_LocalName.Text & "> " & "（ " & Date & "  " & Time & " ）" & "：" & vbCrLf & Text_SendData.Text & vbCrLf
     Text_SendData.Text = "" '清空发送信息框
     KeyCode = 0 '初始化KeyCode
  End If
End If
End Sub
Private Sub Timer1_Timer()
'连接状态判断及显示
'=========================================================================
Select Case TcpClient_Chat.State
        Case sckConnected '连接
            Label2.Caption = "已连接到服务器！"
            Text_SendData.Enabled = True
            Text_GetData.Enabled = True
        Case sckClosed '无连接
            Label2.Caption = "没有与服务器建立连接！"
            Text_SendData.Enabled = False
            Text_GetData.Enabled = False
    End Select
'==========================================================================
End Sub