VB.NET chat program

zhaozj2021-02-08  202

'==================================================== =================== ' ============================================================================================================================================================================================================= ============

Option Explicit On Option Strict on ON OPTION STRICT ON

Imports SystemImports System.IOImports System.TextImports System.ThreadingImports System.NetImports System.Net.SocketsImports System.DrawingImports System.Windows.FormsImports Microsoft.VisualBasic

Class App 'Entry point which delegates to C-style main Private Function Public Overloads Shared Sub Main () Main (System.Environment.GetCommandLineArgs ()) End Sub' Entry point Overloads Public Shared Sub Main (args () As String) 'If the args parse in known way then run the app If ParseArgs (args) Then 'Create a custom Talker object Dim talkerObj As New Talker (endPoint, client)' Pass the object reference to a new form object Dim form As New TalkForm (talkerObj) 'Start the talker "talking" talkerObj.Start ()' Run the applications message pump Application.Run (form) End If End Sub 'Main' Parsed Argument Storage Private Shared endPoint As IPEndPoint Private Shared client As Boolean 'Parse command line arguments Private Shared function paarseargs (args () as string) as boolean try if args.length = 1 THEN Client = false endpoint = new iPadpoint (iPaddress.any, 5150) Return True end if Dim port as integer select case char.toupper ()) .tochararray ()) Case "L" c port = 5150 IF args.lend.Toint32 (args (2)) end if Endpoint = new iPndPoint (iPaddress.any, port) client = false case "c" c port = 5150 dim address as string = "127.0. 0.1 "

Client = true if args.length> 2 Then address = args (2) port = convert.TOINT32 (args (3)) end if Endpoint = New IpendPoint (DNS.Resolve (Address) .addresslist (0), Port) Case Else ShowUsage () Return False End Select Catch End Try Return True End Function 'ParseArgs' Show sample usage Private Shared Sub ShowUsage () MessageBox.Show ( "WinTalk [switch] [parameters ...]" & ControlChars.CrLf & ControlChars.CrLf & _ "/ L [Port]" & ControlChars.Tab & Controlchars.tab & "- Listens ON A Port. Default: 5150" & ControlChars.crlf & _ "/ C [address] [port]" & controlchars.tab & "-" & ControlChars.crf & ControlChars.crlf & _ "Example Server -" & ControlChars.crf & _ "Wintalk / L" & ControlChars.crlf & ControlChars.crlf & _ "Example Client -" & ControlChars.crlf & _ "Wintalk / C ServerMachine 5150", "Wintalk Usage" End Sub 'ShowusageEnd Class' App

'UI class for the sampleClass TalkForm Inherits Form Public Sub New (talkerObj As Talker)' Associate for method with the talker object Me.talkerObj = talkerObj AddHandler talkerObj.Notifications, AddressOf HandleTalkerNotifications' Create a UI elements Dim talkSplitter As New Splitter () Dim TalkPanel As New Panel ()

receiveText = New TextBox () sendText = New TextBox () 'we'll support up to 64k data in our text box controls receiveText.MaxLength = 65536 sendText.MaxLength = 65536 statusText = New Label ()' Initialize UI elements receiveText.Dock = DockStyle.Top receiveText.Multiline = True receiveText.ScrollBars = ScrollBars.Both receiveText.Size = New Size (506, 192) receiveText.TabIndex = 1 receiveText.Text = "" receiveText.WordWrap = False receiveText.ReadOnly = True talkPanel.Anchor = AnchorStyles.Top Or AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right talkPanel.Controls.AddRange (New Control () {sendText, talkSplitter, receiveText}) talkPanel.Size = New Size (506, 371) talkPanel.TabIndex = 0 Talksplitter.dock = DockStyle.top Talksplitter.Location = New Point (0, 192) Talksplitter.Size = New Size (506, 6 ) TalkSplitter.TabIndex = 2 talkSplitter.TabStop = False statusText.Dock = DockStyle.Bottom statusText.Location = New Point (0, 377) statusText.Size = New Size (507, 15) statusText.TabIndex = 1 statusText.Text = " Status: "sendText.Dock = DockStyle.Fill sendText.Location = New Point (0, 198) sendText.Multiline = True sendText.ScrollBars = ScrollBars.Both sendText.Size = New Size (506, 173) sendText.TabIndex = 0 sendText .Text = "" Sendtext.WordWrap =

False AddHandler sendText.TextChanged, AddressOf HandleTextChange sendText.Enabled = False AutoScaleBaseSize = New Size (5, 13) ClientSize = New Size (507, 392) Controls.AddRange (New Control () {statusText, talkPanel}) Me.Text = " Wintalk "

Me.ActiveControl = sendText End Sub 'New' When the app closes, dispose of the talker object Protected Overrides Sub OnClosed (e As EventArgs) If Not (talkerObj Is Nothing) Then RemoveHandler talkerObj.Notifications, AddressOf HandleTalkerNotifications talkerObj.Dispose () End If MyBase.OnClosed (e) End Sub 'OnClosed' Handle notifications from the talker object Private Sub HandleTalkerNotifications (notify As Talker.Notification, data As Object) Select Case notify Case Talker.Notification.Initialized 'Respond to status changes Case Talker.Notification .StatusChange Dim statusObj As Talker.Status = CType (data, Talker.Status) statusText.Text = String.Format ( "Status: {0}", statusObj) If statusObj = Talker.Status.Connected Then sendText.Enabled = True End IF 'respond to Received T ext Case Talker.Notification.Received receiveText.Text = data.ToString () receiveText.SelectionStart = Int32.MaxValue receiveText.ScrollToCaret () 'Respond to error notifications Case Talker.Notification.ErrorNotify Close (data.ToString ())' Respond to EndNotify MessageBox.show (Data.Tostring (), "Closing Wintalk") Close () Case Else Close () End Select End Sub 'HandleTalNotifications'

Handle text change notifications and send talk Private Sub HandleTextChange (sender As Object, e As EventArgs) If Not (talkerObj Is Nothing) Then talkerObj.SendTalk (CType (sender, TextBox) .Text) End If End Sub 'HandleTextChange' Close with an explanation Private OverLoads Sub Close (message As String) MessageBox.Show (message, "Error!") Close () End Sub 'Close' Private UI elements Private receiveText As TextBox Private sendText As TextBox Private statusText As Label Private talkerObj As TalkerPrivate Sub TalkForm_Load (Byval Sender as system.object, byval e as system.eventargs) Handles mybase.load

End Sub

Private subinitizecomponent () 'Talkform' me.autoscalebasesize = new system.drawing.size (6, 14) me.clientsize = new system.drawing.size (292, 273) me.name = "talkform"

End subndend class' talkform

'An encapsulation of the Sockets class used for socket chattingClass Talker Implements IDisposable' Construct a talker Public Sub New (endPoint As IPEndPoint, client As Boolean) Me.endPoint = endPoint Me.client = client socket = Nothing reader = Nothing writer = Nothing statusText = String.Empty prevSendText = String.Empty prevReceiveText = String.Empty End Sub 'New' Finalize a talker Overrides Protected Sub Finalize () Dispose () MyBase.Finalize () End Sub 'Finalize' Dispose of resources and surpress finalization Public Sub Dispose () IMPLEMENTS IDISPOSABLE.DISPOSE GC.SUPPRESSFINALIZE (ME) IF NOT (Reader Is Nothing) Then reader.close () Reader = Nothing end if not (Writer is nothing) Then Writer.close () Writer = Nothing end if not not (Socket is nothing) THEN socket.Close () socket = Nothing End If End Sub 'Dispose' Nested delegate class and matchine event Delegate Sub NotificationCallback (notify As Notification, data As Object) Public Event Notifications As NotificationCallback 'Nested enum for notifications Public Enum Notification Initialized = 1 StatusChange RECEIVED Endnotify ErrorNotify End Enum 'Notification' Nested Enum for Supported State Public Enum Status Listening Connected End Enum 'Status' Start Up The Talker'

s functionality Public Sub Start () ThreadPool.QueueUserWorkItem (New System.Threading.WaitCallback (AddressOf EstablishSocket)) End Sub 'Start' Establish a socket connection and start receiving Private Sub EstablishSocket (ByVal state As Object) Try 'If not client, setup listner If Not client Then Dim listener As SocketTry listener = New Socket (AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) listener.Blocking = True listener.Bind (endPoint) SetStatus (Status.Listening) listener.Listen (0) socket = listener.accept () listener.close () catch e as socketexceErtener on this port try client if E.ErrorCode = 10048 Then Client = true endpoint = new iPEND Point (. Dns.Resolve ( "127.0.0.1") AddressList (0), endPoint.Port) Else RaiseEvent Notifications (Notification.ErrorNotify, "Error Initializing Socket:" & ControlChars.CrLf & e.ToString ()) End If End TRY END IF

'Try a client connection If client Then Dim temp As New Socket (AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) temp.Blocking = True temp.Connect (endPoint) socket = temp End If

'If it all worked out, create stream objects If Not (socket Is Nothing) Then SetStatus (Status.Connected) Dim stream As New NetworkStream (socket) reader = New (stream) StreamReader writer = New (stream) StreamWriter RaiseEvent Notifications (Notification .Initialized, Me) Else RaiseEvent Notifications (Notification.ErrorNotify, "Failed to Establish Socket") End If 'Start receiving talk' Note: on w2k and later platforms, the NetworkStream.Read () 'method called in ReceiveTalke will generate an exception WHEN 'The Remote Connection Closes. WE HANDLE This Case IN Our' Catch Block Below. ReceiveTalk ()

'On Win9x platforms, NetworkStream.Read () returns 0 when' the remote connection closes, prompting a graceful return 'from ReceiveTalk () above. We will generate a Notification.End' message here to handle the case and shut down the remaining ' WinTalk instance. RaiseEvent Notifications (Notification.EndNotify, "Remote connection has closed.") Catch e As IOException Dim sockExcept As SocketException = CType (e.InnerException, SocketException) If Not (sockExcept Is Nothing) And 10054 = sockExcept.ErrorCode Then RaiseEvent Notifications (Notification.EndNotify, "Remote connection has closed.") Else RaiseEvent Notifications (Notification.ErrorNotify, "Socket Error:" & ControlChars.CrLf & e.Message) End If Catch e As Exception RaiseEvent Notifications (Notification.ErrorNotify, " Socket Error: "& ControlChars.crlf & E.MESSAGE) END TRY End Sub 'ESTABLISHSOCKET

'Send text to remote connection Public Sub SendTalk (ByVal newText As String) Dim send As String' Is this an append If prevSendText.Length <= newText.Length And String.CompareOrdinal (newText, 0, prevSendText, 0, prevSendText.Length) = 0 THEN DIM APPEND AS [String] = newText.Substring (prevsendtext.length) Send = string.format ("a {0}: {1}", append.length, append) OR A Complete Replacement else send = string .Format ("r {0}: {1}", newtext.length, newtext) end f 'send the data and flush it out f ww ()' Save the text for future comparison prevsendtext = newText End Sub 'SendTalk' Send a status notification Private Sub SetStatus (ByVal statusObj As Status) Me.statusObj = statusObj RaiseEvent Notifications (Notification.StatusChange, statusObj) End Sub 'SetStatus

'Receive chat from remote client Private Sub ReceiveTalk () Dim commandBuffer (19) As Char Dim oneBuffer (0) As Char Dim readMode As Integer = 1 Dim counter As Integer = 0 Dim textObj As New StringBuilder ()

While Readmode <> 0 if Reader.Read (Onebuffer, 0, 1) = 0 Then Readmode = 0 goto continuewhile1 Endix

Select Case readMode Case 1 If counter = commandBuffer.Length Then readMode = 0 Goto ContinueWhile1 End If If oneBuffer (0) <> ":" c Then commandBuffer (counter) = oneBuffer (0) counter = counter 1 Else counter = Convert. ToInt32 (New String (commandBuffer, 1, counter - 1)) If counter> 0 Then readMode = 2 textObj.Length = 0 Else If commandBuffer (0) = "R" c Then counter = 0 prevReceiveText = String.Empty RaiseEvent Notifications ( NOTIFICATION.RECEIVED, PrevReceiveText) End if End if Endix se 2 textObj.Append (oneBuffer (0)) counter = counter - 1 If counter = 0 Then Select Case commandBuffer (0) Case "R" c prevReceiveText = textObj.ToString () Case Else prevReceiveText = textObj.ToString () End SELECT READMODE = 1

RaiseEvent Notifications (Notification.Received, PrevReceirtExt) end if case else readmode = 0 goto ContinueWhile1 End SelectContinueWhile1: End While End Sub 'ReceiveTalkPrivate Socket As Socket

Private Reader As TextReader Private Writer As Textwriter

Private Client As Boolean Private Endpoint As IpendPoint

Private PrevsendText As String Private PrevreceiveText As String Private statusText As String

Private statusobj as statusend class' Talker

.NET Framework SDK has this example.

转载请注明原文地址:https://www.9cbs.com/read-2838.html

New Post(0)