Imports System.Net
Imports System.Threading
Imports System.Text
Imports System.Net.Sockets
Module Module1
Dim PortNumber As Integer = 1984 '侦听端口号
Dim Cmd As String = "Chat:" '提示符
Dim listener As Socket '侦听socket
Dim tListener As Thread '侦听线程
Dim Prompted As Boolean = False '用于线程间同步的标志变量
Sub Main()
Welcome() '欢迎信息
StartListener() '开始侦听
StartChatting() '准备好让用户发送消息
End Sub
Private Sub Welcome()
Dim txtMessage As String = vbCrLf & "Welcome! I am a console application for LAN chatting." & vbCrLf
Console.WriteLine(txtMessage)
End Sub
Private Sub StartListener()
Dim ready As Boolean = False
Dim LocalPoint As IPEndPoint
Dim msg As String
While Not ready '向用户询问侦听端口号。用户可以直接回车，表示选择默认的。
msg = GetParams("===Now, enter the local port you want to listen(" & PortNumber & "):")
If msg = "" Then msg = PortNumber
Try
PortNumber = Int(msg)
LocalPoint = New IPEndPoint(Dns.GetHostByName(Dns.GetHostName).AddressList(0), PortNumber)
listener = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
listener.Bind(LocalPoint)
ready = True
Catch ex As Exception
Console.WriteLine("※※※ERROR※※※ " & vbCrLf & ex.Message & vbCrLf)
End Try
End While
tListener = New Thread(AddressOf thrListener)
tListener.Start()
End Sub
Private Sub StartChatting()
Dim RemoteHost As String = Dns.GetHostName
Dim RemotePort As Integer = 1984
Dim RemotePoint As IPEndPoint
Dim ready As Boolean = False
Dim msg As String
While Not ready '向用户询问发送消息的目标主机和端口。用户可以直接回车，表示选择默认的。
msg = GetParams("---enter the name of the one you want to chat with(" & RemoteHost & "):")
If Not msg = "" Then RemoteHost = msg
msg = GetParams("---enter the port number that guy listening at(" & RemotePort & "):")
If msg = "" Then msg = RemotePort
Try
RemotePort = Int(msg)
RemotePoint = New IPEndPoint(Dns.GetHostByName(RemoteHost).AddressList(0), RemotePort)
ready = True
Catch ex As Exception
Console.WriteLine("※※※ERROR※※※ " & vbCrLf & ex.Message & vbCrLf)
End Try
End While
Console.WriteLine()
Console.WriteLine("OK, now you can chat. Type ""help"" to find out what you can do.")
Console.WriteLine()
Dim sender As New UdpClient
Dim Message As String = Prompt()
While True '用户现在可以开始发送消息
Prompted = False
Select Case Message.ToLower
Case "exit"
Exit While
Case "help"
ShowHelp()
Case Else
Dim ByArr As Byte() = Encoding.Unicode.GetBytes(Message)
sender.Send(ByArr, ByArr.Length, RemotePoint) '发出消息
End Select
Message = Prompt()
End While
tListener.Abort()
End
End Sub
Private Function GetParams(ByVal Msg As String) As String
Console.Write(Msg)
Return Console.ReadLine
End Function
Private Function Prompt() As String
If Not Prompted Then
Console.Write(Cmd)
Prompted = True
End If
Return Console.ReadLine
End Function
Private Sub thrListener() '侦听线程
Dim bytes(4096) As Byte
Dim NumGet As Integer
Dim Msg As String
While True
Debug.WriteLine("Waiting for a message...")
NumGet = listener.Receive(bytes) '接收
Prompted = False
Msg = Encoding.Unicode.GetString(bytes, 0, NumGet) '与发送消息一样使用unicode编码
Console.WriteLine(vbCrLf & ">>>>>>>>>" & Msg & vbCrLf)
If Not Prompted Then
Console.Write(Cmd)
Prompted = True
End If
End While
End Sub
Private Sub ShowHelp()
Console.WriteLine("")
Console.WriteLine("========================================================================")
Console.WriteLine("This program is very simple, you can type ""exit"" to exit program.")
Console.WriteLine("========================================================================")
Console.WriteLine("")
End Sub
End Module
本文地址：http://com.8s8s.com/it/it43293.htm