Dim Server As New TcpListener(IPAddress.Any, 50000)
The IPAddress.Any option tells the TcpListener to listen for connections on all network interfaces. The second step is to tell the TcpListener to actually start listening for connections using the aptly named Start() method:
Server.Start()
The third and final step is to tell the TcpListener to accept any incoming connections using the AcceptTcpClient() method:
Dim client As TcpClient = Server.AcceptTcpClient
The AcceptTcpClient() method actually blocks until a connection request is received and only accepts one connection at a time. It returns a TcpClient instance that can be used to send and receive data to and from the client on the other side. Since the method only accepts one connection at a time, we place that call in a loop so that all pending connection requests are serviced:
While True
Dim client As TcpClient = Server.AcceptTcpClient
End While
While True
Dim client As TcpClient = Server.AcceptTcpClient
Dim T As New Thread(AddressOf StartChatForm)
T.Start(client)
End While
The StartChatForm() method simply has this signature:
Private Sub StartChatForm(ByVal client As Object)
' ... do something with "client" in here ...
End Sub
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
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 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
After calling NetServerEnum(), we have to manually free the memory used by that buffer with the NetApiBufferFree() API:
Public Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Integer) As Integer
As these APIs aren't really the focus of the article, though, let's skip the gory details and simply post a utility function which returns a List(Of String) containing available network computers:
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
The list of systems returned by GetNetworkComputers() could be assigned to the DataSource of a ListBox, making it easy to select a computer to connect to:
lbComputers.DataSource = GetNetworkComputers
Dim client As New TcpClient()
client.Connect(ConnectTo, 50000)
Dim client As TcpClient ' <--- Provided to us by our TcpListener Server
Now let's create a byte array from a string value so we can send it as a message:
Dim msg As String = "Hello Client!"
Dim bytes() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(msg)
To send the message, we simply use the GetStream() property of the TcpClient and call its Write() method:
client.GetStream.Write(bytes, 0, bytes.Length)
Using Write() is the synchronous version of sending data. Execution will halt at this line until all the data has been sent. If called directly from within a GUI, this could cause the interface to freeze until the send is complete. One solution would be to place the call to Write() on another thread. Another would be to execute the send as an asynchronous call using the BeginWrite() method. Here is how that would look:
client.GetStream.BeginWrite(bytes, 0, bytes.Length, AddressOf MyWriteCallBack, client.GetStream)
The BeginWrite() call looks the same as Write(), but has two extra parameters. The fourth parameter is a delegate to the callback which will be executed once all the data has been sent. The fifth parameter is the Network stream itself, and is passed so it can be accessed within the callback:
Public Sub MyWriteCallBack(ByVal ar As IAsyncResult)
CType(ar.AsyncState, NetworkStream).EndWrite(ar)
End Sub
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
Dim bytesRead As Integer
Dim buffer(1024) As Byte
Now we call GetStream() as before, followed by Read();
bytesRead = client.GetStream.Read(buffer, 0, buffer.Length)
If bytesRead > 0 Then
' ... do something with "bytesRead" and "buffer" ...
End If
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
As Read() is a blocking call, the above loop would need to be in its own thread if used in a GUI application. Note that there is also an alternate BeginRead() that works in a similar fashion to BeginWrite(). Using one or the other really comes down to preference and how you like to style your code. We'll visit this loop again in a little bit.
Dim msg As String = "GREETING" & Chr(0) & "Idle_Mind" & Chr(1)
Dim bytes() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(msg)
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
Here is a boiled down version of how the receive code might look using this approach:
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
Module Module1
Private CS As New ChatServer
Public Sub Main()
Application.Run(CS)
End Sub
End Module
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
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
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
There is additional code in there for processing and display all the different messages, as well as more code to optionally flash the taskbar entry and/or play sounds when messages are received. You can test the application on a single system by simply connecting to your own computer name from the list. The application will happily open two chat windows and allow you to have a witty conversation with yourself:
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (6)
Commented:
'The LabelStatus is actually something i was looking for (How it works?)'. Now it is clear
Thank you for the Source Code
Excellent work ...!!
Finally ...Thank you once more Mike..........
Author
Commented:Commented:
It says unavailable when trying to open the project on MVS 2k15
Excellent work on this program!
Commented:
Commented:
Thanks for posting the whole code along with logic well explained. I have a strange requirement, but I dare ask - I want to use this chatting feature be available from within Excel, i.e. whenever Excel is open, it should work as Listener and Server and be used for opening chat conversations with people on my network, provided they have the same program running in their active Excel application (possibly by putting this code inside PEROSNAL.XLSB. Possible?
Thanks a lot.
Mridul.
View More