YaLanCha-另一个LAN聊天应用程序? (YaLanCha - Yet Another LAN Chat Application?)
我需要一个简单的人对人聊天系统,仅在路由器防火墙后面的家庭网络中使用。 我唯一的要求是系统不需要中央服务器,并且除了“复制并运行”之外不需要任何类型的安装。 本聊天系统的预期用途将仅是简单的文本对话,并且能够将链接发送到网站。 我不需要或不需要任何高级功能,例如聊天室,表情符号,文件传输,语音聊天,群组广播或在线状态。 我只想要一个始终运行的系统,该系统准备好向家庭中的任何其他计算机发送/接收文本消息。 快速搜索网络产生了无数种可能性。 其中许多都是免费的,而且功能强大。 但是,最终,我发现自己不想要一个我真的不相信不会感染病毒或恶意软件的肿的聊天系统。With that in mind, I decided to roll my own chat system from scratch. I had written simple chat systems before using the Winsock control in VB6, but I left that language long ago for the newer .Net world. Unfortunately, the .Net framework does not provide a direct replacement for the Winsock control. This seemed a perfect time and opportunity to tackle the TcpClient and TcpListener classes -- something that had been on my "To Do" list for quite some time. Furthermore, I decided that I would use a standard WinForms project targetting the .Net framework 2.0, and only utilize standard, basic controls. With these constraints, the chat system would run on a wide variety of machines and could be modified and/or compiled by anyone using the free "Express" editions of Visual Studio.
考虑到这一点,我决定从头开始构建自己的聊天系统。 在VB6中使用Winsock控件之前,我已经编写了简单的聊天系统,但是很早以前我就将该语言留给了较新的.Net世界。 不幸的是,.Net框架并不能直接替代Winsock控件。 这似乎是解决TcpClient和TcpListener类的绝佳时机和机会-在我的“待办事项”列表中已经有相当长的一段时间了。 此外,我决定我将使用针对.Net Framework 2.0的标准WinForms项目,并且仅使用标准的基本控件。 有了这些限制,聊天系统将可以在各种机器上运行,并且可以由任何使用免费的Visual Studio“ Express”版本的人进行修改和/或编译。
For the record, my home network consists of three laptops, all running Windows 7 Professional with a single admin account on each. My laptop sits downstairs, next to the kitchen and television, which as a stay-at-home dad is my "command central". The other two laptops are upstairs, one at a central desk location and the other in my daughter's room. It is this latter location, in my daughter's room, that really prompted the "need" for this system. As a teenager she is often in her room with music playing and the door closed to keep her younger brothers at bay. It is under these conditions that she cannot hear me calling for her, even with an elevated voice level (yelling). By rolling my own chat system, I can quickly get her attention without requiring any other programs to be open on her system. This is quite useful when I'm busy in the kitchen and can't run upstairs (leaving dinner to burn on the stove).
作为记录,我的家庭网络由三台笔记本电脑组成,全部运行Windows 7 Professional,每台笔记本电脑上都有一个管理员帐户。 我的笔记本电脑坐在楼下,靠近厨房和电视,作为全职父亲,这是我的“指挥中心”。 另外两台笔记本电脑在楼上,一台在中央办公桌位置,另一台在我女儿的房间里。 正是后者在我女儿的房间中的位置,才真正促使人们对该系统的“需求”。 十几岁的时候,她经常在房间里玩音乐,并且关上门以防止弟弟进来。 在这种情况下,即使声音水平升高(发嘶声),她也听不到我的呼唤。 通过滚动自己的聊天系统,我可以快速吸引她的注意力,而无需在她的系统上打开任何其他程序。 当我在厨房里忙碌而不能上楼时(留下晚餐在炉子上燃烧),这很有用。
Besides my need to learn TcpListener and TcpClient, this was also a great excuse to write another article. Let's get started!...
除了需要学习TcpListener和TcpClient之外,这也是写另一篇文章的绝佳借口。 让我们开始吧!...
您上任了! -通过TcpListener的服务器 (You got served! - The Server via TcpListener)
由于系统将是对等系统,因此每台计算机都必须运行自己的服务器,该服务器能够处理多个并发连接。 使用TcpListener类仅需三个基本步骤,即可轻松实现这一目标。 但是,在此之前,我们必须确定服务器将在哪个端口上侦听传入的连接请求。 简而言之,只需选择一个大于1,024且小于或等于65,535的随机数。 低于1,024的端口号已经很好地用于其他服务,因此不应使用。 我决定使用50,000作为我的端口号。 选择该选项后,第一步是创建一个TcpListener实例,并将我们选择的端口号作为第二个参数传递:Dim Server As New TcpListener(IPAddress.Any, 50000)
Server.Start()
Dim client As TcpClient = Server.AcceptTcpClient
While True
Dim client As TcpClient = Server.AcceptTcpClient
End While
Obviously it's not very useful to simply accept the connection and then do nothing with the resulting TcpClient instance. Since AcceptTcpClient() is blocking, we need to hand the resulting TcpClient instances off to another thread so both server and client can be free to do their thing without worrying about what the other is doing. Here is how to spawn a new thread for each connection and pass the TcpClient to it:
显然,简单地接受连接然后对生成的TcpClient实例不执行任何操作不是很有用。 由于AcceptTcpClient()处于阻塞状态,因此我们需要将生成的TcpClient实例移交给另一个线程,以便服务器和客户端都可以自由地执行其操作,而不必担心对方在做什么。 这是为每个连接生成新线程并将TcpClient传递给它的方法:
While True
Dim client As TcpClient = Server.AcceptTcpClient
Dim T As New Thread(AddressOf StartChatForm)
T.Start(client)
End While
Private Sub StartChatForm(ByVal client As Object)
' ... do something with "client" in here ...
End Sub
That's it! We now have all the pieces to a working server that listens on port 50,000 and will accept multiple connections. Here is what it looks like put all together:
而已! 现在,我们可以将所有内容发送到工作的服务器,该服务器侦听端口50,000,并接受多个连接。 这是所有看起来像的东西:
Imports System.Net
Imports System.Threading
Imports System.Net.Sockets
Public Class ChatServer
Inherits ApplicationContext
Private Server As TcpListener = Nothing
Private ServerThread As Thread = Nothing
Public Sub New()
Server = New TcpListener(IPAddress.Any, 50000)
ServerThread = New Thread(AddressOf ConnectionListener)
ServerThread.IsBackground = True
ServerThread.Start()
End Sub
Private Sub ConnectionListener()
Server.Start()
While True
Dim client As TcpClient = Server.AcceptTcpClient()
Dim T As New Thread(AddressOf StartChatForm)
T.Start(client)
End While
End Sub
Private Sub StartChatForm(ByVal client As Object)
' ... do something with "client" in here ...
End Sub
End Class
单打广告-使用NetServerEnum()API查找网络中的可用计算机 (Singles Ads - Find available Computers in your Network with the NetServerEnum() API)
因此,既然我们有一个可以接受多个连接的工作服务器,我们如何连接到它? 由于网络中的每台计算机都将运行自己的服务器,因此更好的问题是,我们如何列出网络中的所有计算机? 使用NetServerEnum()API获得本地网络中的计算机列表非常容易。 这是它的签名:Public Declare Unicode Function NetServerEnum Lib "Netapi32.dll" ( _
ByVal Servername As Integer, ByVal Level As Integer, ByRef Buffer As Integer, ByVal PrefMaxLen As Integer, _
ByRef EntriesRead As Integer, ByRef TotalEntries As Integer, ByVal ServerType As Integer, _
ByVal DomainName As String, ByRef ResumeHandle As Integer) As Integer
After calling NetServerEnum(), we will get back a pointer to a buffer containing SERVER_INFO_101 structures which has the name of each network computer in the Name() field:
调用NetServerEnum()之后,我们将返回一个指向包含SERVER_INFO_101结构的缓冲区的指针,该结构在Name()字段中具有每台网络计算机的名称:
Public Structure SERVER_INFO_101
Public Platform_ID As Integer
<MarshalAsAttribute(UnmanagedType.LPWStr)> Public Name As String
Public Version_Major As Integer
Public Version_Minor As Integer
Public Type As Integer
<MarshalAsAttribute(UnmanagedType.LPWStr)> Public Comment As String
End Structure
Public Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Integer) As Integer
Public Shared Function GetNetworkComputers(Optional ByVal DomainName As String = Nothing) As List(Of String)
Dim level As Integer = 101
Dim MaxLenPref As Integer = -1
Dim ResumeHandle As Integer = 0
Dim ServerInfo As SERVER_INFO_101
Dim SV_TYPE_ALL As Integer = &HFFFFFFFF
Dim ret, EntriesRead, TotalEntries, BufPtr, CurPtr As Integer
Dim ReturnList As New List(Of String)
Try
ret = NetServerEnum(0, level, BufPtr, MaxLenPref, EntriesRead, TotalEntries, SV_TYPE_ALL, DomainName, ResumeHandle)
If ret = 0 Then
CurPtr = BufPtr
For i As Integer = 0 To EntriesRead - 1
ServerInfo = CType(Marshal.PtrToStructure(New IntPtr(CurPtr), GetType(SERVER_INFO_101)), SERVER_INFO_101)
CurPtr = CurPtr + Len(ServerInfo)
ReturnList.Add(ServerInfo.Name)
Next
End If
NetApiBufferFree(BufPtr)
Catch ex As Exception
End Try
Return ReturnList
End Function
lbComputers.DataSource = GetNetworkComputers
Here is an example of what is typically returned when run on my network:
这是在网络上运行时通常返回的示例:
![The NetServerEnum() API in action!](https://i-blog.csdnimg.cn/blog_migrate/61108d9a69404fd8e7f1880fad44f1f3.png)
错过的联系-我,想聊天。 您在网络上,但仅列出您的计算机名称。 (Missed Connections - Me, wanting to chat. You, on the network, but listing just your computer name.)
与服务器建立连接就像服务器接受连接一样简单。 首先,我们创建一个TcpClient实例,然后调用Connect()方法:Dim client As New TcpClient()
client.Connect(ConnectTo, 50000)
The ConnectTo parameter is simply a string, and can be a computer name such as "MIKE-LAPTOP" returned from the GetNetworkComputers() function outlined earlier. The system will resolve the computer name automatically and attempt to connect to the associated IP address. The second parameter is the port number to connect to and is the same 50,000 value I decided upon earlier when discussing the server code. If successfull, the TcpClient instance returned by Connect() can be used to send and receive messages.
ConnectTo参数只是一个字符串,并且可以是从前面概述的GetNetworkComputers()函数返回的计算机名称,例如“ MIKE-LAPTOP”。 系统将自动解析计算机名称,并尝试连接到关联的IP地址。 第二个参数是要连接的端口号,它是我之前讨论服务器代码时决定的50,000。 如果成功,则Connect()返回的TcpClient实例可用于发送和接收消息。
That's it! Really. The above two lines are all that is necessary to connect a client to a server.
而已! 真。 以上两行是将客户端连接到服务器所必需的。
简短交谈-使用TcpClient发送和接收消息 (Small Talk - Sending and Receiving Messages with TcpClient)
服务器使用AcceptTcpClient或通过客户端中的Connect()方法生成的TcpClient实例将处理会话的发送和接收流。 流只是字节序列,使用字节数组处理。 发送和接收数据都可以同步(阻塞)或异步(非阻塞)方式完成。 让我们先看一下发送数据,因为这是两者中比较容易的操作。 假设已经向我们提供了一个有效的TcpClient,我们将使用一个名为“ client”的变量来引用它:Dim client As TcpClient ' <--- Provided to us by our TcpListener Server
Dim msg As String = "Hello Client!"
Dim bytes() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(msg)
client.GetStream.Write(bytes, 0, bytes.Length)
client.GetStream.BeginWrite(bytes, 0, bytes.Length, AddressOf MyWriteCallBack, client.GetStream)
Public Sub MyWriteCallBack(ByVal ar As IAsyncResult)
CType(ar.AsyncState, NetworkStream).EndWrite(ar)
End Sub
In the callback, we use EndWrite() to complete the process started with BeginWrite(). Note that the callback is started immediately in its own thread as soon as BeginWrite() is called, and that the EndWrite() method is actually a blocking call. As such, if you need something to occur after the data is sent, you could trigger it from the callback after the line containing EndWrite(). Don't forget that the callback runs in its own thread, though, so take that into consideration if you need to interact with the GUI. Here's a simple example of wrapping the asynchronous send process in a procedure:
在回调中,我们使用EndWrite()完成以BeginWrite()开始的过程。 请注意,一旦调用BeginWrite(),则回调将立即在其自己的线程中启动,并且EndWrite()方法实际上是阻塞调用。 这样,如果您需要在发送数据后发生一些事情,则可以从包含EndWrite()的行之后的回调中触发它。 但是,不要忘记回调函数是在其自己的线程中运行的,因此,如果需要与GUI进行交互,请考虑到这一点。 这是一个将异步发送过程包装在过程中的简单示例:
Public Sub SendMessage(ByVal message As String)
Dim bytes() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(message)
client.GetStream.BeginWrite(bytes, 0, bytes.Length, AddressOf MyWriteCallBack, client.GetStream)
End Sub
Private Sub MyWriteCallBack(ByVal ar As IAsyncResult)
CType(ar.AsyncState, NetworkStream).EndWrite(ar)
End Sub
Right, with the write half taken care of, let's explore how to handle the read stream of the client. Unlike in a send operation where we know beforehand how much data is going to be sent, the amount of data received from the client isn't known until it actually comes across the line. Since we can't know beforehand how much data will arrive at any given time, we also cannot declare a byte array of the exact required size. Instead, we simply create a fixed size buffer, and fill it multiple times if necessary until all the received data has been obtained. The buffer below has been declared to handle 1,024 bytes at at time:
正确,写完一半后,让我们探讨如何处理客户端的读取流。 与我们事先知道要发送多少数据的发送操作不同,从客户端接收到的数据量直到实际到达线路时才知道。 由于我们无法预先知道在任何给定时间将到达多少数据,因此我们也无法声明确切大小的字节数组。 相反,我们仅创建一个固定大小的缓冲区,并在必要时多次填充它,直到获得所有接收到的数据为止。 已声明以下缓冲区一次可处理1,024字节:
Dim bytesRead As Integer
Dim buffer(1024) As Byte
bytesRead = client.GetStream.Read(buffer, 0, buffer.Length)
Just as with Write(), this version of Read() is a blocking synchronous call. The Read() function will just sit there until data has been received and is available. When execution resumes, the number of bytes read and placed into the buffer is returned from the function and stored in our bytesRead variable. If the connection was closed, Read() will return zero bytes so you should always check for that condition:
就像Write()一样,此版本的Read()是一个阻塞的同步调用。 Read()函数将一直坐在那里,直到接收到数据并可用为止。 恢复执行后,将从函数返回读取并放入缓冲区的字节数,并将其存储在我们的bytesRead变量中。 如果连接已关闭,Read()将返回零字节,因此您应始终检查该条件:
If bytesRead > 0 Then
' ... do something with "bytesRead" and "buffer" ...
End If
As before with the server and accepting clients, placing the Read() call inside a loop will ensure that all data received is processed:
与服务器和接受客户端一样,将Read()调用放入循环中将确保处理接收到的所有数据:
Dim bytesRead As Integer
Dim buffer(1024) As Byte
While True
bytesRead = client.GetStream.Read(buffer, 0, buffer.Length)
If bytesRead > 0 Then
Debug.Print(System.Text.ASCIIEncoding.ASCII.GetString(buffer, 0, bytesRead))
End If
End While
In summary, sending and receiving data with the TcpClient can be accomplished using byte arrays and is really quite easy. Plain text can be converted to a btye array using System.Text.ASCIIEncoding.
总而言之,使用TcpClient发送和接收数据可以使用字节数组来完成,而且非常容易。 可以使用System.Text.ASCIIEncoding将纯文本转换为btye数组。 ASCII码 ytes(),而反向操作可以通过System.Text.ASCIIEncoding完成。 ASCII码 tring()。
意识流-他说话很多,但没有任何意义! (Stream of Consciousness - He's talking a lot, but not really making any sense!)
因此,TcpClient将读取和写入流巧妙地封装在GetStream()方法中,该方法返回基础NetworkStream。 当我们说“流”时,我们真正的意思是什么? 将流视为没有可辨别的开始或结束的连续数据流。 后一部分非常重要,接下来我们将重点关注。 底层的TCP / IP协议可确保数据按正确的顺序到达,这非常有用,但不能保证数据在到达时如何分组在一起!For example, if we sent "halfway", it may arrive in two different chunks as "half" and "way". Another possibility is that different sends arrive as one big chunk. For instance, if we sent "halfway" and "there" as two different, distinct sends, they both may arrive toghether as "halfwaythere". This isn't perceived as a limitation or bug from the perspective of TCP/IP since all the data that was sent is indeed received in the same order! The point here is that the streams have no notion or knowledge of where your data breaks into discrete "messages". To the streams, everything is just an endless flow of bytes.
例如,如果我们发送“ halfway”,则它可能以“ half”和“ way”两个不同的块到达。 另一种可能性是,不同的发送作为一大块到达。 例如,如果我们以两个不同的不同发送方式发送“中途”和“那里”,则它们都可能一起作为“中途”到达。 从TCP / IP的角度来看,这不被视为限制或错误,因为发送的所有数据实际上都是按相同的顺序接收的! 这里的要点是,流不了解或不知道数据在何处分解为离散的“消息”。 对于流而言,一切只是字节的无尽流。
It is up to the designer, then, to come up with a protocol that will allow the receiver to discern when a complete message, or multiple messages, have been received. This can be accomplished using fixed numbers of bytes, special byte sequences or delimiters, or even a combination of both. The method I've chosen to employ in my chat application is to use special delimiter characters inserted between the codes and the actual messages typed by the users. Both the codes and the user messages are simple plain text so my delimiters can be any of the non-visible control characters available in the standard ASCII set (any of the ASCII values below 32). Specifically, I decided to use Chr(1) to denote the end of a complete message, and Chr(0) to delimit the values within the message. The format for a complete message in my protocol would then simply be:
然后,由设计者来决定一个协议,该协议将使接收者能够辨别何时已接收到一条完整消息或多条消息。 这可以通过使用固定数量的字节,特殊字节序列或定界符,甚至两者的组合来实现。 我选择在聊天应用程序中使用的方法是使用在代码和用户键入的实际消息之间插入的特殊定界符。 代码和用户消息都是简单的纯文本,因此我的定界符可以是标准ASCII集中可用的任何不可见控制字符(低于32的任何ASCII值)。 具体来说,我决定使用Chr(1)表示完整消息的结尾,并使用Chr(0)来界定消息中的值。 我的协议中完整消息的格式将简单地是:
SomePlainTextCodeChr(0) MessageTypedByUser Chr(1)
Chr(0) Chr(1)
The complete message would first be built as a standard string, and then coverted to a byte array:
完整的消息将首先构建为标准字符串,然后覆盖为字节数组:
Dim msg As String = "GREETING" & Chr(0) & "Idle_Mind" & Chr(1)
Dim bytes() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(msg)
On the receiving end, we convert all arriving bytes back to text and append that to the end of a standard string variable. After each concatenation we can now determine if one or more complete messages have arrived by checking for the presence of our "end of message" character Chr(1). If found, those complete messages are extracted from the string variable and passed on to the GUI for processing. Any partially received messages will remain in the string variable until the rest of the data for those partial messages arrives. When processing a complete message, we simply Split() the string using the field delimiter character of Chr(0) to separate out the different field values. This simple scheme allows us to pass different kinds of messages while keeping codes, values and the messages themselves neatly separated.
在接收端,我们将所有到达的字节转换回文本,并将其附加到标准字符串变量的末尾。 每次串联后,我们现在可以通过检查“消息结尾”字符Chr(1)的存在来确定是否已收到一条或多条完整消息。 如果找到,则从字符串变量中提取这些完整的消息,并将其传递到GUI进行处理。 任何部分接收的消息将保留在字符串变量中,直到这些部分消息的其余数据到达为止。 当处理一条完整的消息时,我们只需使用Chr(0)的字段定界符来对字符串进行Split()即可分离出不同的字段值。 这种简单的方案使我们可以传递各种消息,同时将代码,值和消息本身保持整齐的分离。
In the final application, I ended up using eight different codes:
在最终的应用程序中,我最终使用了八个不同的代码:
Public Enum MessageCodes ' Enter all codes below in --> UPPER CASE <---
ACK = 0
TEXT = 1
DISCONNECTED = 2
GREETING = 3
GREETINGRESPONSE = 4
PAGE = 5
TYPING = 6
TYPINGCANCEL = 7
End Enum
Private FieldMarker As String = Chr(0)
Private MessageMarker As String = Chr(1)
Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim bytesRead As Integer
Dim buffer(1024) As Byte
Dim Messages As String = ""
Dim MessageMarkerIndex As Integer
While True
bytesRead = client.GetStream.Read(buffer, 0, buffer.Length) ' <-- Blocks until Data is Received
If bytesRead > 0 Then ' <-- Zero is returned if Connection is Closed and no more data is available
Messages = Messages & System.Text.ASCIIEncoding.ASCII.GetString(buffer, 0, bytesRead) ' Append the received data to our message queue
MessageMarkerIndex = Messages.IndexOf(MessageMarker) ' See if the End of Message marker is present
While MessageMarkerIndex <> -1 ' If we have received at least one complete message
BackgroundWorker1.ReportProgress(0, Messages.Substring(0, MessageMarkerIndex)) ' Let the GUI handle the complete Message
Messages = Messages.Remove(0, MessageMarkerIndex + 1) ' Remove the processed message
MessageMarkerIndex = Messages.IndexOf(MessageMarker) ' See if there are more End of Message markers present
End While
End If
End While
End Sub
Private Sub BackgroundWorker1_ProgressChanged(ByVal sender As System.Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
If Not IsNothing(e.UserState) AndAlso TypeOf e.UserState Is String Then
Dim msg As String = CType(e.UserState, String)
Dim values() As String = msg.Split(FieldMarker)
If values.Length >= 2 Then ' Forward compatibility for messages with more than two fields
Dim strCode As String = values(0)
Dim value As String = values(1) ' All messages should have at least two fields (even if the second isn't used)
' ... do something with "strCode" and "value" ...
End If
End If
End Sub
The "do something" line is replaced with a big Select Case statement that takes different actions based on the received code.
“执行某事”行被一个大的Select Case语句替换,该语句根据收到的代码执行不同的操作。
选美大赛-全部组合成一个完整的包装! (Beauty Pageant - Putting it all together in a complete package!)
完成的项目从Sub Main开始,并将ApplicationContext传递给Application.Run()。 这与我以前的文章“在VB.Net 2008中使用NotifyIcon构建无格式WinForms应用程序”中描述的技术相同: https://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/A_2729-Building-a-Formless-WinForms-Application-with-a-NotifyIcon-in-VB-Net-2008.html https://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/A_2729-Building-a-Formless-WinForms-Application-with-a-NotifyIcon-in-VB-Net-2008.htmlBelow is the entirety of Module1 containing my Sub Main:
以下是包含我的Sub Main的整个Module1:
Module Module1
Private CS As New ChatServer
Public Sub Main()
Application.Run(CS)
End Sub
End Module
The complete ChatServer() class is very similar to the previously posted version, with additional code to display a TrayIcon, and code to start an instance of the ChatForm() form in its own thread:
完整的ChatServer()类与先前发布的版本非常相似,具有显示TrayIcon的其他代码以及用于在其自己的线程中启动ChatForm()表单实例的代码:
Imports System.Net
Imports System.Threading
Imports System.Net.Sockets
Public Class ChatServer
Inherits ApplicationContext
Private Server As TcpListener = Nothing
Private ServerThread As Thread = Nothing
Private WithEvents Tray As New NotifyIcon
Private Threads As New List(Of Thread)
Public Sub New()
Tray.Icon = My.Resources.Chat
Tray.Visible = True
Tray.Text = "LAN Chat"
Server = New TcpListener(IPAddress.Any, 50000) ' <-- Listen on Port 50,000
ServerThread = New Thread(AddressOf ConnectionListener)
ServerThread.IsBackground = True
ServerThread.Start()
End Sub
Private Sub ConnectionListener()
Try
Server.Start()
While True
Dim client As TcpClient = Server.AcceptTcpClient ' Blocks until Connection Request is Received
Dim T As New Thread(AddressOf StartChatForm)
Threads.Add(T)
T.Start(client)
End While
Catch ex As Exception
MessageBox.Show("Unable to Accept Connections", "LAN Chat Server Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try
Application.ExitThread()
End Sub
Private Sub StartChatForm(ByVal client As Object)
Application.Run(New ChatForm(CType(client, TcpClient))) ' Start a New ChatForm with the TcpClient Connection
Threads.Remove(Thread.CurrentThread) ' We don't get here until the ChatForm is closed
End Sub
Private Sub Tray_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Tray.Click
ChatStart.Show()
End Sub
Private Sub ChatServer_ThreadExit(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.ThreadExit
Tray.Visible = False
End Sub
End Class
The StartChatForm() method simply passes the TcpClient returned by the AcceptTcpClient() method off to a new instance of the ChatForm() form.
StartChatForm()方法只是将AcceptTcpClient()方法返回的TcpClient传递给ChatForm()表单的新实例。
Clicking the TrayIcon causes the ChatStart() form to show. The ChatStart() form simply lists all computers in the LAN using the previously mentioned NetServerEnum() API. After selecting another computer, that computer's name is passed off to an instance of the ChatForm() form:
单击TrayIcon会显示ChatStart()表单。 ChatStart()表单仅使用前面提到的NetServerEnum()API列出了LAN中的所有计算机。 选择另一台计算机后,该计算机的名称将传递给ChatForm()表单的实例:
Imports System.Runtime.InteropServices
Public Class ChatStart
Private Sub ChatStart_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown
btnRefresh.PerformClick()
End Sub
Private Sub btnRefresh_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRefresh.Click
btnRefresh.Enabled = False
lbComputers.DataSource = Nothing
BackgroundWorker1.RunWorkerAsync()
End Sub
Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
e.Result = ChatStart.GetNetworkComputers()
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
lbComputers.DataSource = CType(e.Result, List(Of String))
btnRefresh.Enabled = True
End Sub
Private Sub lbComputers_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbComputers.DoubleClick
btnChat.PerformClick()
End Sub
Private Sub btnChat_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnChat.Click
If lbComputers.SelectedIndex <> -1 Then
Dim chat As New ChatForm(lbComputers.SelectedItem.ToString)
chat.Show()
Me.Close()
End If
End Sub
#Region "NetServerEnum_API"
Public Const SV_TYPE_ALL As Integer = &HFFFFFFFF
Public Structure SERVER_INFO_101
Public Platform_ID As Integer
<MarshalAsAttribute(UnmanagedType.LPWStr)> Public Name As String
Public Version_Major As Integer
Public Version_Minor As Integer
Public Type As Integer
<MarshalAsAttribute(UnmanagedType.LPWStr)> Public Comment As String
End Structure
Public Declare Unicode Function NetServerEnum Lib "Netapi32.dll" ( _
ByVal Servername As Integer, ByVal Level As Integer, ByRef Buffer As Integer, ByVal PrefMaxLen As Integer, _
ByRef EntriesRead As Integer, ByRef TotalEntries As Integer, ByVal ServerType As Integer, _
ByVal DomainName As String, ByRef ResumeHandle As Integer) As Integer
Public Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Integer) As Integer
Public Shared Function GetNetworkComputers(Optional ByVal DomainName As String = Nothing) As List(Of String)
Dim ServerInfo As SERVER_INFO_101
Dim MaxLenPref As Integer = -1
Dim level As Integer = 101
Dim ResumeHandle As Integer = 0
Dim ret, EntriesRead, TotalEntries, BufPtr, CurPtr As Integer
Dim ReturnList As New List(Of String)
Try
ret = NetServerEnum(0, level, BufPtr, MaxLenPref, EntriesRead, TotalEntries, SV_TYPE_ALL, DomainName, ResumeHandle)
If ret = 0 Then
CurPtr = BufPtr
For i As Integer = 0 To EntriesRead - 1
ServerInfo = CType(Marshal.PtrToStructure(New IntPtr(CurPtr), GetType(SERVER_INFO_101)), SERVER_INFO_101)
CurPtr = CurPtr + Len(ServerInfo)
ReturnList.Add(ServerInfo.Name)
Next
End If
NetApiBufferFree(BufPtr)
Catch ex As Exception
End Try
Return ReturnList
End Function
#End Region
End Class
This leaves us with only the code for ChatForm() to post. The ChatForm() is created by passing either a TcpClient, which was received from the ChatServer() class, or a string computer name that was received from the StartChatForm() form:
这样我们只剩下ChatForm()发布的代码。 通过传递从ChatServer()类接收的TcpClient或从StartChatForm()表单接收的字符串计算机名,来创建ChatForm()。
Imports System.Net.Sockets
Public Class ChatForm
Public Enum Sound
ChatOpen
ChatMessage
ChatPage
ChatClose
End Enum
Public Enum MessageCodes ' Enter all codes below in --> UPPER CASE <---
ACK = 0
TEXT = 1
DISCONNECTED = 2
GREETING = 3
GREETINGRESPONSE = 4
PAGE = 5
TYPING = 6
TYPINGCANCEL = 7
End Enum
Private ConnectTo As String = ""
Private ChatClient As TcpClient = Nothing
Private FieldMarker As String = Chr(0)
Private MessageMarker As String = Chr(1)
Private Typing() As String = {"/", "-", "\", "|"}
Private Const AckIntervalInSeconds As Integer = 60
Private ContinueProcessingMessages As Boolean = True
Private SendFinalDisconnectMessage As Boolean = False
Private Shared Waves As New Dictionary(Of String, EmbeddedWave)
Public Sub New()
InitializeComponent()
End Sub
Public Sub New(ByVal ConnectTo As String)
InitializeComponent()
Me.ConnectTo = ConnectTo
Me.Text = "Connecting to " & ConnectTo & " ..."
End Sub
Public Sub New(ByVal ChatClient As TcpClient)
InitializeComponent()
Me.ChatClient = ChatClient
End Sub
Private Sub ChatForm_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown
AckTimer.Interval = TimeSpan.FromSeconds(AckIntervalInSeconds).TotalMilliseconds
SetChatState(False)
BackgroundWorker1.RunWorkerAsync()
End Sub
Private Sub SetChatState(ByVal state As Boolean)
cbMute.Enabled = state
cbFlash.Enabled = state
AckTimer.Enabled = state
btnSendPage.Enabled = state
btnSendMessage.Enabled = state
tbMessageToSend.Enabled = state
End Sub
Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
If IsNothing(ChatClient) Then ' We are initiating the connection
Try
ChatClient = New TcpClient()
ChatClient.Connect(ConnectTo, 50000) ' Blocks until connection is made
Catch ex As Exception
ContinueProcessingMessages = False
BackgroundWorker1.ReportProgress(-2) ' Connection Failed
End Try
Else
SendMessage(MessageCodes.GREETING, Environment.MachineName) ' We accepted a Connection: Send our name
End If
If Not IsNothing(ChatClient) AndAlso ChatClient.Connected Then
BackgroundWorker1.ReportProgress(1) ' Enable the Chat Interface
SendFinalDisconnectMessage = True
Dim bytesRead As Integer
Dim buffer(1024) As Byte
Dim Messages As String = ""
Dim MessageMarkerIndex As Integer
While ContinueProcessingMessages
Try
bytesRead = ChatClient.GetStream.Read(buffer, 0, buffer.Length) ' <-- Blocks until Data is Received
If bytesRead > 0 Then ' <-- Zero is returned if Connection is Closed and no more data is available
Messages = Messages & System.Text.ASCIIEncoding.ASCII.GetString(buffer, 0, bytesRead) ' Append the received data to our message queue
MessageMarkerIndex = Messages.IndexOf(MessageMarker) ' See if the End of Message marker is present
While MessageMarkerIndex <> -1 ' If we have received at least one complete message
BackgroundWorker1.ReportProgress(0, Messages.Substring(0, MessageMarkerIndex)) ' Let the GUI handle the complete Message
Messages = Messages.Remove(0, MessageMarkerIndex + 1) ' Remove the processed message
MessageMarkerIndex = Messages.IndexOf(MessageMarker) ' See if there are more End of Message markers present
End While
End If
Catch ex As Exception
ContinueProcessingMessages = False
BackgroundWorker1.ReportProgress(-1)
End Try
End While
End If
End Sub
Private Sub BackgroundWorker1_ProgressChanged(ByVal sender As System.Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
Select Case e.ProgressPercentage
Case -1 ' Raised From Exception in Receiving Loop in BackgroundWorker()
SendFinalDisconnectMessage = False
SetChatState(False)
Me.Text = Me.Text & " {Connection Lost}"
Case -2 ' Initial Connection Failed
SendFinalDisconnectMessage = False
Me.Text = "Failed to Connect!"
MessageBox.Show("No response from " & ConnectTo & " ...", "Connection Failed!", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Me.Close()
Case 1 ' Connection Made
SetChatState(True) ' Enable the Chat Interface
Case 0 ' Normal Message Received
If Not IsNothing(e.UserState) AndAlso TypeOf e.UserState Is String Then
Dim msg As String = CType(e.UserState, String)
Dim values() As String = msg.Split(FieldMarker)
If values.Length >= 2 Then ' Forward compatibility for messages with more than two fields
Dim strCode As String = values(0)
Dim value As String = values(1) ' All messages should have at least two fields (even if the second isn't used)
Try
Dim code As MessageCodes = [Enum].Parse(GetType(MessageCodes), strCode.ToUpper)
Select Case code
Case MessageCodes.ACK ' Ack signal received
Case MessageCodes.GREETING ' We have received a name from the other side
Me.Text = value
DisplayMessage(Color.Red, value & " Connected")
If Not cbMute.Checked Then
ChatForm.Play(Sound.ChatOpen)
End If
SendMessage(MessageCodes.GREETINGRESPONSE, Environment.MachineName) ' Send our name back...
Case MessageCodes.GREETINGRESPONSE ' We sent our name and have now received a name back
Me.Text = value
DisplayMessage(Color.Red, value & " Connected")
If Not cbMute.Checked Then
ChatForm.Play(Sound.ChatOpen)
End If
Case MessageCodes.TYPING ' The other side is typing a message...
Static index As Integer = -1
index = index + 1
If index > Typing.GetUpperBound(0) Then
index = 0
End If
lblStatus.Text = value & " " & Typing(index)
Case MessageCodes.TYPINGCANCEL ' The other side has cleared their message textbox
lblStatus.Text = ""
Case MessageCodes.TEXT ' A text message from the other person has arrived
DisplayMessage(Color.DarkGreen, value)
If Not cbMute.Checked Then
ChatForm.Play(Sound.ChatMessage)
End If
If cbFlash.Checked Then
FlashWindow(Me.Handle)
End If
Case MessageCodes.PAGE ' We have received a Page request
If Not cbMute.Checked Then
ChatForm.Play(Sound.ChatPage)
End If
Case MessageCodes.DISCONNECTED ' The other person closed their chat window
ContinueProcessingMessages = False
lblStatus.Text = ""
DisplayMessage(Color.Red, value)
Me.Text = Me.Text & " {Disconnected}"
SetChatState(False)
SendFinalDisconnectMessage = False
If Not cbMute.Checked Then
ChatForm.Play(Sound.ChatClose)
End If
End Select
Catch ex As Exception
End Try
End If
End If
End Select
End Sub
Private Function SendMessage(ByVal Code As MessageCodes, ByVal Value As String) As Boolean
Try ' Async Write so we don't lock up the GUI in the event of dropped connections
Dim msg() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(Code.ToString & FieldMarker & Value & MessageMarker)
ChatClient.GetStream.BeginWrite(msg, 0, msg.Length, AddressOf MyWriteCallBack, ChatClient.GetStream)
Return True
Catch ex As Exception
SendFinalDisconnectMessage = False
End Try
Return False
End Function
Public Sub MyWriteCallBack(ByVal ar As IAsyncResult)
Try
CType(ar.AsyncState, NetworkStream).EndWrite(ar)
Catch ex As Exception
End Try
End Sub
Private Sub AckTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AckTimer.Tick
SendMessage(MessageCodes.ACK, "Ack")
End Sub
Private Sub tbMessageToSend_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tbMessageToSend.TextChanged
If tbMessageToSend.TextLength > 0 Then
SendMessage(MessageCodes.TYPING, "Typing...")
Else
SendMessage(MessageCodes.TYPINGCANCEL, "Clear")
End If
End Sub
Private Sub btnSendMessage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSendMessage.Click
If tbMessageToSend.Text.Trim <> "" Then
If SendMessage(MessageCodes.TEXT, tbMessageToSend.Text) Then
DisplayMessage(Color.Black, tbMessageToSend.Text)
tbMessageToSend.Clear()
Else
SetChatState(False)
Me.Text = Me.Text & " {Connection Lost}"
End If
End If
End Sub
Private Sub DisplayMessage(ByVal clr As Color, ByVal msg As String)
Try
Dim SelStart As Integer = tbMessageToSend.SelectionStart
Dim SelLength As Integer = tbMessageToSend.SelectionLength
rtbConversation.SelectionStart = rtbConversation.TextLength
rtbConversation.SelectionColor = clr
rtbConversation.SelectedText = "[" & DateTime.Now.ToShortTimeString & "] " & msg & vbCrLf
rtbConversation.Focus()
rtbConversation.ScrollToCaret()
tbMessageToSend.Focus()
tbMessageToSend.SelectionStart = SelStart
tbMessageToSend.SelectionLength = SelLength
Catch ex As Exception
End Try
End Sub
Private Sub rtbConversation_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkClickedEventArgs) Handles rtbConversation.LinkClicked
Try
Process.Start(e.LinkText) ' Attemp to Open URL in the default browser
Catch ex As Exception
MessageBox.Show("Could not open URL: " & e.LinkText, "Unable to Open URL", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try
End Sub
Private Sub btnSendPage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSendPage.Click
SendMessage(MessageCodes.PAGE, "Paging")
End Sub
Private Sub ChatForm_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
If SendFinalDisconnectMessage Then
SendMessage(MessageCodes.DISCONNECTED, Environment.MachineName & " Disconnected")
End If
Try
If Not IsNothing(ChatClient) AndAlso ChatClient.Connected Then
ChatClient.Close()
End If
Catch ex As Exception
End Try
End Sub
Private Shared Sub Play(ByVal ChatSound As Sound)
Dim WaveName As String = ChatSound.ToString & ".wav"
If Not Waves.ContainsKey(WaveName) Then
Waves.Add(WaveName, New EmbeddedWave(WaveName))
End If
If Waves(WaveName).IsValid Then
Waves(WaveName).Play()
End If
End Sub
#Region "FlashWindowEx_API"
Public Const FLASHW_STOP As UInteger = 0
Public Const FLASHW_CAPTION As Int32 = &H1
Public Const FLASHW_TRAY As Int32 = &H2
Public Const FLASHW_ALL As Int32 = (FLASHW_CAPTION Or FLASHW_TRAY)
Public Const FLASHW_TIMERNOFG As Int32 = &HC
Public Structure FLASHWINFO
Public cbsize As Int32
Public hwnd As IntPtr
Public dwFlags As Int32
Public uCount As Int32
Public dwTimeout As Int32
End Structure
Public Declare Function FlashWindowEx Lib "user32.dll" (ByRef pfwi As FLASHWINFO) As Int32
Private Sub FlashWindow(ByVal handle As IntPtr)
Dim flash As New FLASHWINFO
flash.cbsize = System.Runtime.InteropServices.Marshal.SizeOf(flash)
flash.hwnd = handle
flash.dwFlags = FLASHW_ALL Or FLASHW_TIMERNOFG
FlashWindowEx(flash)
End Sub
#End Region
#Region "Class EmbeddeWave()"
Public Class EmbeddedWave
Private _WaveBytes() As Byte, _WaveLoaded As Boolean = False, _WaveName As String = ""
Public ReadOnly Property IsValid() As Boolean
Get
Return _WaveLoaded
End Get
End Property
Public ReadOnly Property Name() As String
Get
Return _WaveName
End Get
End Property
Private Sub New()
End Sub
Public Sub New(ByVal EmbeddedWaveName As String)
_WaveName = EmbeddedWaveName
_WaveLoaded = LoadEmbeddedWave()
End Sub
Private Function LoadEmbeddedWave() As Boolean
Dim resourceStream As System.IO.Stream = _
System.Reflection.Assembly.GetExecutingAssembly(). _
GetManifestResourceStream(Me.GetType.Namespace & "." & _WaveName)
If Not IsNothing(resourceStream) Then
Try
ReDim _WaveBytes(CInt(resourceStream.Length))
resourceStream.Read(_WaveBytes, 0, CInt(resourceStream.Length))
Return True
Catch ex As Exception
MessageBox.Show(ex.Message, "Load Embedded Wave Resource Failed", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End Try
Else
MessageBox.Show(_WaveName, "Embedded Wave Resource Not Found", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End If
End Function
Public Sub Play()
If IsValid Then
My.Computer.Audio.Play(_WaveBytes, AudioPlayMode.Background)
End If
End Sub
End Class
#End Region
End Class
![Testing the chat application on a single computer.](https://i-blog.csdnimg.cn/blog_migrate/dce7a0cfa14d945332f1a3167a5d12df.png)
I hope I've demystified how a simple chat application can be realized through the use of the TcpClient and TcpListener classes. These same basic concepts and techniques can be used to transfer other types of data such as images and files as well. Once you convert your information to byte arrays, and design a suitable communication protocol for them, the application can be more easily broken down into manageable pieces.
我希望我已经揭开了如何通过使用TcpClient和TcpListener类实现一个简单的聊天应用程序的神秘感。 这些相同的基本概念和技术也可以用于传输其他类型的数据,例如图像和文件。 将信息转换为字节数组并为其设计合适的通信协议后,可以更轻松地将应用程序分解为可管理的部分。
Happy chatting!
聊天愉快!
The full source code for this project can be downloaded here:
可以在这里下载该项目的完整源代码:
https://docs.google.com/file/d/0B0MXukqErympUGRFd2FjOGtRYzg/edit?usp=sharing https://docs.google.com/file/d/0B0MXukqErympUGRFd2FjOGtRYzg/edit?usp=sharing