首页 > 应用开发 > IT综合 > VB.NET聊天程序 (转)

VB.NET聊天程序 (转)

原创 IT综合 作者:amyz 时间:2007-10-29 09:53:51 0 删除 编辑
VB.NET聊天程序 (转)[@more@]

' :  Wintalk.vb
' 摘要: 演示如何使用 library创建.

Option Explicit On
Option Strict On

Imports System
Imports System.IO
Imports System.Text
Imports System.Threading
Imports System.Net
Imports System.Net.Sockets
Imports System.Drawing
Imports System..Forms
Imports .VisualBasic


Class App
  'Entry point which delegates to C-style main Private Function
  Public Overloads Shared Sub Main()
  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
  Dim talkerObj As New Talker(endPoint, client)
  ' Pass the object reference to a new foobject
  Dim form As New TalkForm(talkerObj)
  ' Start the talker "talking"
  ' Run the applications message pump
  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 ParseArgs(args() As String) As Boolean
  If args.Length = 1 Then
  client = False
  endPoint = New IPEndPoint(IPAddress.Any, 5150)
  Return True
  End If
  Dim port As Integer
  Case Char.ToUpper(args(1).ToCharArray()(1))
  Case "L"c
  port = 5150
  If args.Length > 2 Then
  port = Convert.ToInt32(args(2))
  End If
  endPoint = New IPEndPoint(IPAddress.Any, port)
  client = False
  Case "C"c
  port = 5150
  Dim address As String = ""
  client = True
  If args.Length > 2 Then
  address = args(2)
  port = Convert.ToInt32(args(3))
  End If
  endPoint = New IPEndPoint(.Resolve(address).Addreist(0), port)
  Case Else
  Return False
  End Select
  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 & "-- Connects to an address and port." & ControlChars.CrLf & ControlChars.CrLf & _
  "Example Server - " & ControlChars.CrLf & _
  "Wintalk /L" & ControlChars.CrLf & ControlChars.CrLf & _
  "Example Client - " & ControlChars.CrLf & _
  "Wintalk /C ServerMachine 5150", "WinTalk Usage")
  End Sub 'ShowUsage
End Class 'App

' UI class for the sample
Class 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.Wrap = 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 Overrs Sub OnClosed(e As EventArgs)
  If Not (talkerObj Is Nothing) Then
  RemoveHandler talkerObj.Notifications, AddressOf HandleTalkerNotifications
  End If
  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 text
  Case Talker.Notification.Received
  receiveText.Text = data.ToString()
  receiveText.SelectionStart = Int32.MaxValue
  ' Respond to error notifications
  Case Talker.Notification.ErrorNotify
  ' Respond to end
  Case Talker.Notification.EndNotify
  MessageBox.Show(data.ToString(), "Closing WinTalk")
  Case Else
  End Select
  End Sub 'HandleTalkerNotifications
  ' 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!")
  End Sub 'Close
  ' Private UI elements
  Private receiveText As TextBox
  Private sendText As TextBox
  Private statusText As Label
  Private talkerObj As Talker

  Private Sub TalkForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

  End Sub

  Private Sub InitializeComponent()
  Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
  Me.ClientSize = New System.Drawing.Size(292, 273)
  Me.Name = "TalkForm"

  End Sub
End Class 'TalkForm

' An encapsulation of the Sockets class used for socket chatting
Class 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()
  End Sub 'Finalize
  ' Dispose of res and surpress finalization
  Public Sub Dispose() Implements IDisposable.Dispose
  If Not (reader Is Nothing) Then
  reader = Nothing
  End If
  If Not (writer Is Nothing) Then
  writer = Nothing
  End If
  If Not (socket Is Nothing) Then
  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
  End Enum 'Notification
  ' Nested enum for supported states
  Public Enum Status
  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)
  ' If not client, setup listner
  If Not client Then
  Dim listener As Socket

  listener = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
  listener.Blocking = True
  socket = listener.Accept()
  Catch e As SocketException
  ' If there is already a listener on this port try client
  If e.ErrorCode = 10048 Then
  client = True
  endPoint = New IPEndPoint(Dns.Resolve("").AddressList(0), endPoint.Port)
  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
  socket = temp
  End If

  ' If it all worked out, create stream objects
  If Not (socket Is Nothing) Then
  Dim stream As New NetworkStream(socket)
  reader = New StreamReader(stream)
  writer = New StreamWriter(stream)
  RaiseEvent Notifications(Notification.Initialized, Me)
  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.

  ' On 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.")
  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
  send = String.Format("R{0}:{1}", newText.Length, newText)
  End If
  ' Send the data and flush it out
  ' 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 commanuffer(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
  End If

  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
  counter = Convert.ToInt32(New String(commandBuffer, 1, counter - 1))
  If counter > 0 Then
  readMode = 2
  textObj.Length = 0
  If commandBuffer(0) = "R"c Then
  counter = 0
  prevReceiveText = String.Empty
  RaiseEvent Notifications(Notification.Received, prevReceiveText)
  End If
  End If
  End If
  Case 2
  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, prevReceiveText)
  End If
  Case Else
  readMode = 0
  Goto ContinueWhile1
  End Select
  End While
  End Sub 'ReceiveTalk

  Private 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 Status
End Class 'Talker


.NET Framework SDK有这个例子.

来自 “ ITPUB博客 ” ,链接:,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
  • 博文量
  • 访问量