frmclient.frm

电子书“Visual Basic 6 网络编程实例教程.rar”

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form FrmClient 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "基于WINSOCK的聊天程序—客户端"
   ClientHeight    =   4155
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5775
   Icon            =   "FrmClient.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4155
   ScaleWidth      =   5775
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送"
      Height          =   495
      Left            =   4080
      TabIndex        =   5
      Top             =   3360
      Width           =   1455
   End
   Begin VB.CommandButton cmdDisConnect 
      Caption         =   "断开连接"
      Height          =   495
      Left            =   4080
      TabIndex        =   4
      Top             =   1920
      Width           =   1455
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "连接"
      Height          =   495
      Left            =   4080
      TabIndex        =   3
      Top             =   480
      Width           =   1455
   End
   Begin VB.TextBox TxtSend 
      Height          =   975
      Left            =   0
      MultiLine       =   -1  'True
      TabIndex        =   2
      Text            =   "FrmClient.frx":030A
      Top             =   2880
      Width           =   3735
   End
   Begin VB.TextBox TxtReceive 
      Height          =   1935
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Text            =   "FrmClient.frx":0314
      Top             =   480
      Width           =   3735
   End
   Begin VB.TextBox TxtErr 
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Text            =   "TxtErr"
      Top             =   0
      Width           =   5655
   End
   Begin MSWinsockLib.Winsock TcpClient 
      Left            =   4080
      Top             =   1440
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   4560
      TabIndex        =   7
      Top             =   1560
      Width           =   975
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "名称："
      Height          =   180
      Left            =   4440
      TabIndex        =   6
      Top             =   1200
      Width           =   540
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000011&
      X1              =   0
      X2              =   5640
      Y1              =   2670
      Y2              =   2670
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      X1              =   0
      X2              =   5640
      Y1              =   2640
      Y2              =   2640
   End
End
Attribute VB_Name = "FrmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim myname As String
Private isConnectedFlag As Boolean
Private sClientChatName As String  '保存连接用户的名称
Const msgTitle As String = "Winsock聊天客户端示例"

Private Sub cmdDisconnect_Click()
   If TcpClient.State = sckConnected Then
      TcpClient.Close
      isConnectedFlag = TcpClient.State = sckConnected
      Me.Caption = "TCP Client Closed"
      cmdDisConnect.Enabled = isConnectedFlag
      cmdConnect.Enabled = Not isConnectedFlag
   End If
End Sub

Private Sub cmdSend_Click()
   Call TransmitMessage
End Sub

Private Sub Form_Load()
   TxtErr.Text = ""
   TxtSend.Text = ""
   TxtReceive.Text = ""
   myname = "Client"
   Label2.Caption = myname
End Sub

Private Sub cmdConnect_Click()
  'Winsock控件的名称是tcpClient，为定义远程端口，
  '可以使用IP地址（"14.15.15.16"）或计算机的名字（LocalHostName）
   TcpClient.RemoteHost = TcpClient.LocalHostName
   TcpClient.RemotePort = 1544
  '使用连接方法打开一个连接
  '如果失败，则激活tcpClient_Error事件
   TcpClient.Connect
   cmdConnect.Enabled = TcpClient.State = sckClosed
connect_exit:
   Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
   TcpClient.Close
End Sub

Private Sub tcpClient_Close()
   If isConnectedFlag = True Then
      If TcpClient.State = sckClosing Then
        '确保避免循环
         isConnectedFlag = False
        '更新窗体标题
         Me.Caption = "TCP客户端正关闭..."
        '通知用户
         MsgBox "到' " & sClientChatName & _
                " '的连接意外终止。", _
                vbExclamation Or vbOKOnly, msgTitle
        '关闭连接
         TcpClient.Close
         cmdDisConnect.Enabled = isConnectedFlag
         cmdConnect.Enabled = Not isConnectedFlag
      End If
   End If
   Me.Caption = "TCP客户端已经关闭"
End Sub

Private Sub tcpClient_Connect()
   If isConnectedFlag = False Then
      '首次连接到服务器，将客户端名称传递给服务器
      If TcpClient.State = sckConnected Then
         TcpClient.SendData myname
      End If
      TxtSend.SetFocus
   End If
   cmdSend.Enabled = TcpClient.State = sckConnected
   cmdDisConnect.Enabled = TcpClient.State = sckConnected
End Sub

Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
   Dim strData As String  '保存输入数据
   Dim buff As String
   If isConnectedFlag = True Then
     '建立了连接，设置连接标志isConnectedFlag值，
     '程序会认为以后的输入数据为聊天内容
      TcpClient.GetData strData
     '如果文本框txtReceive中有数据（不是第一行），
     '此时，需要在各行之间插入VBcrlf换行符。
      If Len(TxtReceive.Text) Then
         buff = buff & vbCrLf & sClientChatName & " :" & vbTab & strData
      Else
         buff = buff & sClientChatName & " :" & vbTab & strData
      End If
     '假如新的字符串到达了文本框txtReceive的最后，则进行滚动
      With TxtReceive
         .SelStart = Len(TxtReceive.Text)
         .SelText = buff
         .SelStart = Len(TxtReceive.Text)
      End With
   Else
     '设置isConnectedFlat标志，以避免下次再次进入本部分
      isConnectedFlag = True
      TcpClient.GetData strData
      sClientChatName = strData
      Me.Caption = "TCP客户端:正与" & sClientChatName & "聊天..."
   End If
End Sub

Private Sub tcpClient_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)
   Select Case Number
      Case 10061
         MsgBox "错误: " & Number & vbCrLf & Description & _
                vbCrLf & vbCrLf & _
                "Winsock聊天演示程序中的服务器端未运行" & _
                "或未建立正确的连接。", _
                vbExclamation Or vbOKOnly Or vbMsgBoxSetForeground, _
                msgTitle
      Case 2: MsgBox "2"
      Case 3: MsgBox "3"
      Case Else
         MsgBox "错误: " & Number & vbCrLf & Description, _
         vbOKOnly Or vbExclamation Or vbMsgBoxSetForeground, _
         msgTitle
   End Select
   CancelDisplay = True
   TcpClient.Close
  '使能连接命令按钮
   cmdConnect.Enabled = TcpClient.State = sckClosed
End Sub

Private Sub txtSend_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
      Call TransmitMessage
   End If
End Sub

Private Sub TransmitMessage()
   Dim buff As String
   On Local Error GoTo TransmitMessage_error
   TcpClient.SendData TxtSend.Text
   If Len(TxtReceive.Text) Then
      buff = buff & vbCrLf & myname & " :" & vbTab & TxtSend.Text
   Else
      buff = buff & myname & " :" & vbTab & TxtSend.Text
   End If
   With TxtReceive
      .SelStart = Len(TxtReceive.Text)
      .SelText = buff
      .SelStart = Len(TxtReceive.Text)
   End With
  '清除输入文本框
   TxtSend.Text = ""
TransmitMessage_exit:
   Exit Sub
TransmitMessage_error:
   Select Case Err
      Case sckBadState:
         MsgBox Err.Description & "." & vbCrLf & _
                "客户端未连接到服务器端", _
                vbExclamation Or vbOKOnly, msgTitle
      Case Else
         MsgBox Err.Description & ".", _
                vbExclamation Or vbOKOnly, msgTitle
   End Select
   Resume TransmitMessage_exit
End Sub