TCP 聊天应用程序

引言

这是一个使用 TCP/IP 套接字实现的聊天应用程序。要运行此应用程序，您需要添加通过以太网进行通信的控件。

背景

这是为大学水平的研讨会创建的一个简单的应用程序。希望对通信编程的初学者有所帮助。

使用代码

在启动应用程序之前，需要编写几个部分的代码。我们需要创建两个窗体，一个充当服务器，另一个充当客户端。这样我们就可以将其操作为一个客户端-服务器聊天应用程序。

现在让我们看看服务器端窗体的代码

在编程过程中需要处理几个事件。

 '' Form Load
Private Sub Form_Load()
    On Error GoTo err
    tcpServer.LocalPort = 1001
    tcpServer.Listen
    Exit Sub
err:
    MsgBox Error
End Sub    

 
'' Commnad for Sending Message
Private Sub Command1_Click()
    On Error GoTo err
    If txtSendData.Text <> "" Then
        tcpServer.SendData txtSendData.Text
        main.AddItem (tcpServer.LocalHostName + " (You)  :  " + txtSendData.Text)
        Beep
        txtSendData.Text = ""
    End If
    Exit Sub
err:
    MsgBox("No Connection", vbInformation)
End Sub

 
'' Command to send the message in reserve format
Private Sub Command2_Click()
    Dim a
    a = StrReverse(txtSendData.Text)
    On Error GoTo err
    If txtSendData.Text <> "" Then
        tcpServer.SendData(a)
        main.AddItem(tcpServer.LocalHostName + " (You)  :  " + Trim(a))
        Beep
        txtSendData.Text = ""
    End If
    Exit Sub
err:
    MsgBox("No Connection", vbInformation)
End Sub


'' Code to accept incoming Client Connection Request
Private Sub tcpServer_ConnectionRequest (ByVal requestID As Long)
On Error GoTo err
If tcpServer.State <> sckClosed Then _
    tcpServer.Close
    tcpServer.Accept requestID
    Exit Sub
err:
    MsgBox Error
End Sub

'' Code to when the data recieved 
Private Sub tcpServer_DataArrival (ByVal bytesTotal As Long)
On Error GoTo err
    Dim strData As String
    tcpServer.GetData strData
    txtOutput.Text = strData
    main.AddItem (tcpServer.RemoteHostIP + " (Friend)  :  " + txtOutput.Text)
    Beep
    Exit Sub
err:
    MsgBox Error
End Sub

现在让我们看看客户端窗体的代码

'' Form Load
Private Sub Form_Load()
On Error GoTo err
    cmdDisconnect.Enabled = False
    tcpClient.RemotePort = 1001
    Exit Sub
err:    
    MsgBox Error
End Sub

'' Code for connecting to the server
Private Sub cmdConnect_Click()
On Error GoTo err
    tcpClient.RemoteHost = Trim(ip.Text)
    cmdDisconnect.Caption = "Disconnect To " & ip.Text
    tcpClient.Connect
    cmdDisconnect.Enabled = True
    cmdConnect.Enabled = False
    Exit Sub
err:
    MsgBox Error
End Sub

'' Code for  disconnecting from the server
Private Sub cmdDisconnect_Click()
      On Error GoTo err    
    tcpClient.Close
    cmdDisconnect.Enabled = False
    main.Clear
    txtSendData.Text = ""
    cmdConnect.Enabled = True
    Exit Sub
err:
    MsgBox Error
End Sub

'' Code to send the message to the server
Private Sub Command1_Click()
    On Error GoTo err
    If txtSendData.Text <> "" Then
        tcpClient.SendData txtSendData.Text
        main.AddItem (tcpClient.LocalIP + " (You)  :  " + txtSendData.Text)
        Beep
        txtSendData.Text = ""
    End If
    Exit Sub
err:
    MsgBox( "Connection not established", vbInformation)
End Sub
 
'' Code to send the message in the reverse format 
Private Sub Command2_Click()
    Dim a
    a = StrReverse(txtSendData.Text)
    On Error GoTo err
    If txtSendData.Text <> "" Then
        tcpClient.SendData(a)
        main.AddItem (tcpClient.LocalIP + " (You)  :  " + Trim(a))
        Beep
        txtSendData.Text = ""
    End If
    Exit Sub
err:
    MsgBox ("Connection not established", vbInformation)
End Sub
 
'' Code for when the data recieved 
Private Sub tcpClient_DataArrival (ByVal bytesTotal As Long)
    On Error GoTo err
    Dim strData As String
    tcpClient.GetData strData
    txtOutput.Text = strData
    main.AddItem (tcpClient.RemoteHost + " (Friend)  :  " + txtOutput.Text)
    Beep
    Exit Sub
err:
    MsgBox Error
End Sub