Imports System.Threading Imports System.Net Imports System.Net.Sockets Imports System.IO Imports System.Collections.Concurrent Imports System.Reflection Imports System.Runtime.InteropServices Imports System.Diagnostics Imports System.Collections.Generic Public Class Client Public errMsg As String ' Define the delegate type Public Delegate Sub ClientCallbackDelegate(ByVal bytes() As Byte, ByVal dataChannel As Byte) ' Create Delegate pointer Public ClientCallbackObject As ClientCallbackDelegate Private continue_running As Boolean = False Private bytes() As Byte Private blockSize As UInt16 Private IP As System.Net.IPAddress Private Port As Integer Private localAddr As IPAddress Private Client As TcpClient Private Stream As NetworkStream Private fileWriter As AsyncUnbuffWriter Private fileReader As FileStream Private FileBeingSentPath As String Private weHaveThePuck As Boolean = False Private isRunning As Boolean = False Private UserBytesToBeSentAvailable As Boolean = False Private UserBytesToBeSent As New MemoryStream Private UserOutputChannel As Byte Private SystemBytesToBeSentAvailable As Boolean = False Private SystemBytesToBeSent() As Byte Private SystemOutputChannel As Byte Private SendingFile As Boolean = False Private ReceivingFile As Boolean = False Private IncomingFileName As String Private IncomingFileSize As Int64 = 0 Private outgoingFileSize As UInt64 = 0 Private outgoingFileName As String Private fileBytesRecieved As Int64 = 0 Private filebytesSent As Int64 = 0 Private bytesSentThisSecond As Int32 = 0 Private bytesReceivedThisSecond As Int32 = 0 Private mbpsOneSecondAverage() As Int32 Private ReceivedFilesFolder As String = System.Environment.GetFolderPath(Environment.SpecialFolder.CommonDesktopDirectory) & "\ReceivedFiles" Private userName As String Private password As String Private machineId As String Private mbpsSyncObject As New AutoResetEvent(False) Private sendQueue As ConcurrentQueue(Of message) Private messageIn As MessageInQueue Private shuttingDown As Boolean Private reconnectMonitorDetails As New ReconnectData Private silentShutdown As Boolean = False Private connectionAccepted As Boolean = False Private connectionRejected = False Private disConnectComplete As Boolean Private Class ReconnectData Public ReconnectDuration As TimeSpan Public attemptTimeStamp As Date Public Reconnecting As Boolean Public ReconnectOnDisconnection Public ipAddress As String Public port As Int16 Public machineId As String End Class Private Sub ReconnectMonitor() Dim reconnectDots As Int16 = 0 Dim attemptMessage As String = "Attempting to reconnect" If continue_running = False then Exit Sub If Not connectionAccepted Then Exit Sub reconnectMonitorDetails.Reconnecting = True reconnectMonitorDetails.attemptTimeStamp = Now SystemMessage(attemptMessage) While Not Connect(reconnectMonitorDetails.ipAddress, reconnectMonitorDetails.port, reconnectMonitorDetails.machineId, "") If continue_running = False Then Exit While Thread.Sleep(1000) If Now > reconnectMonitorDetails.attemptTimeStamp.Add(reconnectMonitorDetails.ReconnectDuration) then Exit While If continue_running = False then Exit Sub attemptMessage += "." reconnectDots += 1 If reconnectDots > 3 then reconnectDots = 0 attemptMessage = "Attempting to reconnect" End If SystemMessage(attemptMessage) End While reconnectMonitorDetails.Reconnecting = False If isRunning = False then continue_running = False If Not silentShutdown Then SystemMessage("Disconnected.") End If End Sub Private Class message Public bytes() As Byte Public dataChannel As Byte End Class Private class MessageInQueue Public queue As New ConcurrentQueue(Of message) Private bgThread As New Threading.Thread(AddressOf Pump) Private running As Boolean Private callBack As ClientCallbackDelegate Public Sub New(ByRef _callBack As ClientCallbackDelegate) callBack = _callBack running = True bgThread.Start() End Sub Public Sub Close() running = False End Sub Private Sub Pump() Dim msg As message = Nothing While running If queue.Count > 0 then If queue.TryDequeue(msg) Then callBack(msg.bytes, msg.dataChannel) End If End If If queue.Count = 0 then Thread.Sleep(2) End While End Sub End Class Public Function isClientRunning() As Boolean Return isRunning End Function Public Sub SetReceivedFilesFolder(ByVal _path As String) ReceivedFilesFolder = _path End Sub Public Function GetIncomingFileName() As String Return IncomingFileName End Function Public Function GetOutgoingFileName() As String Return outgoingFileName End Function Public Function GetPercentOfFileReceived() As UInt16 If ReceivingFile Then Return CUShort((fileBytesRecieved / IncomingFileSize) * 100) Else Return 0 End If End Function Public Function GetPercentOfFileSent() As UInt16 If SendingFile Then Return CUShort((filebytesSent / outgoingFileSize) * 100) Else Return 0 End If End Function Public Function GetMbps() As String Dim currentMbps As Decimal = CalculateMbps(True) If currentMbps > 1000000 Then Return (currentMbps / 1000000).ToString("N2") & " Mbps" Else Return (currentMbps / 1000).ToString("N2") & " Kbps" End If End Function Public Function GetLocalIpAddress() As System.Net.IPAddress Dim strHostName As String Dim addresses() As System.Net.IPAddress strHostName = System.Net.Dns.GetHostName() addresses = System.Net.Dns.GetHostAddresses(strHostName) ' Find an IpV4 address For Each address As System.Net.IPAddress In addresses ' Return the first IpV4 IP Address we find in the list. If address.AddressFamily = AddressFamily.InterNetwork Then Return address End If Next ' No IpV4 address? Return the loopback address. Return System.Net.IPAddress.Loopback End Function Private Function GetIPFromHostname(ByVal hostname As String, Optional returnLoopbackOnFail As Boolean = True) As System.Net.IPAddress Dim addresses() As System.Net.IPAddress Try addresses = System.Net.Dns.GetHostAddresses(hostname) Catch ex As Exception If Not returnLoopbackOnFail Then Return Nothing Return System.Net.IPAddress.Loopback End Try ' Find an IpV4 address For Each address As System.Net.IPAddress In addresses ' Return the first IpV4 IP Address we find in the list. If address.AddressFamily = AddressFamily.InterNetwork Then Return address End If Next ' No IpV4 address? Return the loopback address. If returnLoopbackOnFail Then Return System.Net.IPAddress.Loopback Return Nothing End Function ''' ''' Starting a new client requires a callback sub, and optional reconnection cryteria. ''' ''' ''' Clients started whith ReconnectOnDisconnection = True will continue to attempt to reconnect for the time specifyed in ReconnectionDurationSeconds. ''' The number of seconds to attempt to reconnect to the server in the event that connection is lost. ''' Public Sub New(ByVal callbackMethod As ClientCallbackDelegate, Optional ByVal ReconnectOnDisconnection As Boolean = False, Optional ReconnectionDurationSeconds As Int32 = 15) blockSize = 10000 ' Initialize the delegate variable to point to the user's callback method. ClientCallbackObject = callbackMethod ' Reconnect code here: reconnectMonitorDetails.ReconnectOnDisconnection = ReconnectOnDisconnection reconnectMonitorDetails.ReconnectDuration = New TimeSpan(0, 0, 0, ReconnectionDurationSeconds) End Sub Public Function Connect(ByVal IP_Address As String, ByVal prt As Integer, Optional newMachineID As String = "", _ Optional ByRef errorMessage As String = "") As Boolean If isRunning then errorMessage = "The client is already connected.' Return False End If connectionAccepted = False connectionRejected = False disConnectComplete = False Try ' Attempt to get the ip address by parsing the IP_Address string: IP = System.Net.IPAddress.Parse(IP_Address) Catch ex As Exception ' We got an error - it's not an ip address. ' Maybe it's a hostname. IP = GetIPFromHostname(IP_Address, False) End Try If IP Is Nothing Then ' Handle invalid IP address passed here. errorMessage = "Could not connect to " & IP_Address & ". It is not a valid IP address or hostname on this network." Return False End If Port = prt continue_running = True errMsg = "" shuttingDown = False sendQueue = New ConcurrentQueue(Of message) messageIn = New MessageInQueue(ClientCallbackObject) Dim clientCommunicationThread As New Thread(AddressOf Run) clientCommunicationThread.Name = "ClientCommunication" clientCommunicationThread.Start() SetMachineID(newMachineID) ' Wait for connection... While isRunning = False And errMsg = "" Thread.Sleep(5) End While ' Are we connected? errorMessage = errMsg If isRunning = False Then messageIn.Close Return False Else While connectionAccepted = False Thread.Sleep(1) If connectionRejected = True then errorMessage = errMsg Return False End If If isRunning = False then errorMessage = errMsg messageIn.Close Return False End If End While End If Return True End Function ''' ''' Closes the TCP connection. ''' ''' Prevents all system messages from being passed to your callback ''' (including the disconnected notification) and retruns control quickly while the client shuts ''' down in the background. ''' Public Sub Close(Optional ByVal shutDownSilently As Boolean = False) silentShutdown = shutDownSilently shuttingDown = True ' If we're not running at all... If isRunning = False then continue_running = False If Not silentShutdown Then SystemMessage("Disconnected.") Exit Sub End If If messageIn isnot Nothing then messageIn.Close() If shutDownSilently = True then Dim bgClose As New Thread(AddressOf FinishClosing) bgClose.Start() Return End If FinishClosing() End Sub Private Sub FinishClosing() Dim timeout As Date = Now.AddSeconds(3) Try While (sendQueue.Count > 0) Or (UserBytesToBeSentAvailable = True) Thread.Sleep(5) If Now > timeout Then Exit While End While Catch ex As Exception ' sendQueue is nothing... not interested in this error. End Try continue_running = False While disConnectComplete = False Thread.Sleep(5) If Now > timeout then Exit While End While End Sub Private Sub DoInternalClose() Thread.Sleep(250) Close() End Sub Private Sub InternalClose() Dim bgClose As New Thread(AddressOf DoInternalClose) bgClose.Start() End Sub Public Function GetBlocksize() As UInt16 Return blockSize End Function ''' ''' Returns the size of the sendqueue. Returns -1 if isRunning = False. ''' CAUTION: Calling this function too often will result in decreased performance, and failing to call it at all may result ''' in an out of memory error. You can continue to add messages to the send queue for as long as the connection is active ''' (isRunning = True), but that doesn't mean they are being sent as fast as you are adding them to the queue (or at all, for that matter). ''' ''' An Int32 ''' Public Function GetSendQueueSize() As Int32 Dim sendQueueSize As Int32 = -1 If isRunning then GetSendQueueSize = sendQueue.Count Return sendQueueSize End Function Public Sub GetFile(ByVal _path As String) sendQueue.Enqueue(New message With { _ .bytes = Utilities.StrToByteArray("GFR:" & _path), .dataChannel = 254 }) End Sub Public Function SendFile(ByVal _path As String, Optional ByRef errMsg As String = "") As Boolean If shuttingDown then errMsg = "The client is shutting down. Outgoing files will not be sent." Return False End If sendQueue.Enqueue(New message With { _ .bytes = Utilities.StrToByteArray("SFR:" & _path), .dataChannel = 254 }) Return True End Function Public Sub CancelIncomingFileTransfer() sendQueue.Enqueue(New message With { _ .bytes = Utilities.StrToByteArray("Abort->"), .dataChannel = 254 }) FinishReceivingTheFile() Dim killFileThread As New System.Threading.Thread(AddressOf KillIncomingFile) killFileThread.Start(ReceivedFilesFolder & "\" & IncomingFileName) End Sub Private Sub KillIncomingFile(_path as Object) Dim filePath As String = CType(_path, String) Dim timeOut As New Stopwatch timeOut.Start() While timeOut.ElapsedMilliseconds < 1000 Try If Not File.Exists(filePath) then Exit While File.Delete(filePath) Catch ex As Exception End Try End While End Sub Public Sub CancelOutgoingFileTransfer() sendQueue.Enqueue(New message With { _ .bytes = Utilities.StrToByteArray("Abort<-"), .dataChannel = 254 }) StopSendingTheFile() End Sub Public Sub SetMachineID(ByVal id As String) machineId = id If id = "" then id = " " sendQueue.Enqueue(New message With { _ .bytes = Utilities.StrToByteArray("MachineID:" & id), .dataChannel = 254 }) End Sub Public Function GetMachineID() As String Return machineId End Function Public Function GetErrorMessage() As String Return errMsg End Function Public Function SendBytes(ByVal bytes() As Byte, Optional ByVal channel As Byte = 1, Optional ByRef errMsg As String = "") As Boolean If shuttingDown then errMsg = "This client is shutting down. Bytes can not be sent." Return False End If If channel = 0 Or channel > 250 Then errMsg = "Data can not be sent using channel numbers less then 1 or greater then 250." Return False End If If bytes is Nothing or bytes.Length = 0 then errMsg = "bytes() must contain more then 0 bytes, and not be nothing." Return False End If If shuttingDown then errMsg = "The client is shutting down. Outgoing messages will not be accepted." Return False End If sendQueue.Enqueue(New message With { _ .bytes = bytes, .dataChannel = channel }) Return True End Function Public Function SendBytes(ByRef bytes() As Byte, ByVal offset As Int32, ByVal count As Int32, Optional ByVal channel As Byte = 1, Optional ByRef errMsg As String = "") As Boolean If shuttingDown then errMsg = "This client is shutting down. Bytes can not be sent." Return False End If If channel = 0 Or channel > 250 Then errMsg = "Data can not be sent using channel numbers less then 1 or greater then 250." Return False End If If bytes is Nothing or bytes.Length = 0 then errMsg = "bytes() must contain more then 0 bytes, and not be nothing." Return False End If If shuttingDown then errMsg = "The client is shutting down. Outgoing messages will not be accepted." Return False End If Dim msg As New message() ReDim msg.bytes(count - 1) Buffer.BlockCopy(bytes, offset, msg.bytes, 0, count) msg.dataChannel = channel sendQueue.Enqueue(msg) Return True End Function Public Function SendBytes(ByRef streamBytes As MemoryStream, Optional ByVal channel As Byte = 1, Optional ByRef errMsg As String = "") As Boolean If shuttingDown then errMsg = "This client is shutting down. Bytes can not be sent." Return False End If If channel = 0 Or channel > 250 Then errMsg = "Data can not be sent using channel numbers less then 1 or greater then 250." Return False End If If bytes is Nothing or bytes.Length = 0 then errMsg = "bytes() must contain more then 0 bytes, and not be nothing." Return False End If If shuttingDown then errMsg = "The client is shutting down. Outgoing messages will not be accepted." Return False End If Dim msg As New message() ReDim msg.bytes(streamBytes.Length - 1) streamBytes.Position = 0 streamBytes.Read(msg.bytes, 0, msg.bytes.Length) msg.dataChannel = channel sendQueue.Enqueue(msg) Return True End Function ''' ''' This is a convienience function that handles the work of converting the text you would like to send to a byte array. ''' Passes back the return value and errMsg of SendBytes(). Returns True on success and False on falure. Check the errMsg ''' string for send failure explanations. ''' ''' ''' ''' ''' ''' Public Function SendText(ByVal textMessage As String, Optional ByVal channel As Byte = 1, _ Optional ByRef errMsg As String = "") As Boolean If shuttingDown then errMsg = "This client is shutting down. Text can not be sent." Return False End If If textMessage = "" then errMsg = "Your text message must contain some text." Return False End If Return SendBytes(Utilities.StrToByteArray(textMessage), channel, errMsg) End Function Private Function RcvBytes(ByVal data() As Byte, Optional ByVal dataChannel As Byte = 1) As Boolean ' dataType: >0 = data channel, 251 and up = internal messages. 0 is an invalid channel number (it's the puck) If dataChannel < 1 Or Not continue_running Then Return False Try Dim passedData(data.Length - 1) As Byte Array.Copy(data, passedData, data.Length) messageIn.queue.Enqueue(New message With { _ .bytes = passedData, .dataChannel = dataChannel }) 'ClientCallbackObject(data, datachannel) Catch ex As Exception ' An unexpected error. Debug.WriteLine("Unexpected error in Client\RcvBytes: " & ex.Message) Return False End Try Return True End Function Private Function CreateFolders(ByVal _path As String) As Boolean CreateFolders = True Dim parts() As String Dim path As String = "" Dim count As Int32 parts = Split(_path, "\") path = parts(0) For count = 1 To parts.Length - 2 path += "\" & parts(count) Try If Not Directory.Exists(path) Then Directory.CreateDirectory(path) End If Catch ex As Exception End Try Next End Function Private Sub SendExternalSystemMessage(ByVal message As String) SystemBytesToBeSent = Utilities.StrToByteArray(message) SystemOutputChannel = 254 ' Text messages / commands on channel 254 SystemBytesToBeSentAvailable = True End Sub Private Function BeginToReceiveAFile(ByVal _path As String) As Boolean Dim readBuffer As Int32 = 0 ReceivingFile = True BeginToReceiveAFile = True fileBytesRecieved = 0 Try CreateFolders(_path) fileWriter = New AsyncUnbuffWriter(_path, True, _ 1024 * (AsyncUnbuffWriter.GetPageSize()), IncomingFileSize) Catch ex As Exception _path = ex.Message ReceivingFile = False End Try If Not ReceivingFile Then Try fileWriter.Close() Catch ex As Exception End Try Return False End If End Function Private Function HandleIncomingFileBytes(ByRef bytes() As Byte) As Boolean Try fileWriter.Write(bytes, bytes.Length) HandleIncomingFileBytes = True Catch ex As Exception HandleIncomingFileBytes = False End Try End Function Private Sub FinishReceivingTheFile() Try fileWriter.Close() fileWriter = Nothing ReceivingFile = False Catch ex As Exception ReceivingFile = False End Try End Sub Private Sub StopSendingTheFile() Try SendingFile = False fileReader.Close() fileReader = Nothing GC.GetTotalMemory(True) Catch ex As Exception SendingFile = False GC.GetTotalMemory(True) End Try End Sub Private Sub WrapUpIncomingFile() If ReceivingFile Then Try fileWriter.Close() fileWriter = Nothing GC.GetTotalMemory(True) Catch ex As Exception End Try Try File.Delete(ReceivedFilesFolder & "\" & IncomingFileName) Catch ex As Exception End Try End If End Sub Private Function CheckSessionPermissions(ByVal cmd As String) As Boolean ' Your security code here... Return True End Function Private Function BeginFileSend(ByVal _path As String, ByVal fileLength As Long) As Boolean filebytesSent = 0 Try fileReader = New FileStream(_path, FileMode.Open, FileAccess.Read, FileShare.None, AsyncUnbuffWriter.GetPageSize) SendingFile = True BeginFileSend = True Catch ex As Exception BeginFileSend = False _path = ex.Message SendingFile = False End Try Try If Not BeginFileSend Then fileReader.Close() Catch ex As Exception End Try End Function Private Sub GetMoreFileBytesIfAvailable() Dim bytesRead As Integer If SendingFile And Not SystemBytesToBeSentAvailable Then Try If SystemBytesToBeSent.Length <> blockSize Then ReDim SystemBytesToBeSent(blockSize - 1) bytesRead = fileReader.Read(SystemBytesToBeSent, 0, blockSize) If bytesRead <> blockSize Then ReDim Preserve SystemBytesToBeSent(bytesRead - 1) If bytesRead > 0 Then SystemOutputChannel = 252 ' File transfer from client to server SystemBytesToBeSentAvailable = True filebytesSent += bytesRead Else ReDim SystemBytesToBeSent(blockSize - 1) SendExternalSystemMessage("<-Done") ' Send the server a completion notice. SystemMessage("<-Done") SendingFile = False ' Clean up fileReader.Close() fileReader = Nothing GC.GetTotalMemory(True) End If Catch ex As Exception SendExternalSystemMessage("ERR: " & ex.Message) ' We're finished. ReDim SystemBytesToBeSent(blockSize - 1) SendingFile = False fileReader.Close() End Try End If End Sub Private Function GetFilenameFromPath(ByVal filePath As String) As String Dim filePathParts() As String If filePath.Trim = "" Then Return "" filePathParts = Split(filePath, "\") GetFilenameFromPath = filePathParts(filePathParts.Length - 1) End Function Private Sub HandleIncomingSystemMessages(ByVal bytes() As Byte, ByVal channel As Byte) If channel = 254 Then ' Text commands / messages passed between server and client Dim message As String = Utilities.BytesToString(bytes) Dim tmp As String = "" Dim filePath As String ' Get File Request: The server wants us to send them a file. If message.Length > 4 Then tmp = message.Substring(0, 4) If tmp = "GFR:" Then ' Get File Request ' Get file path... filePath = message.Substring(4, message.Length - 4) ' Does it exist? If File.Exists(message.Substring(4, message.Length - 4)) Then ' Are we already busy sending them a file? If Not SendingFile Then Dim _theFilesInfo As New FileInfo(filePath) outgoingFileName = GetFilenameFromPath(filePath) outgoingFileSize = CULng(_theFilesInfo.Length) If BeginFileSend(filePath, _theFilesInfo.Length) Then ' Send only the file NAME. It will have a different path on the other side. SendExternalSystemMessage("Sending:" & outgoingFileName & _ ":" & outgoingFileSize.ToString) SystemMessage("Sending file:" & outgoingFileName) Else ' FilePath contains the error message. SendExternalSystemMessage("ERR: " & filePath) End If Else ' There's already a GFR in progress. SendExternalSystemMessage("ERR: File: ''" & _ FileBeingSentPath & _ "'' is still in progress. Only one file " & _ "may be transfered (from client to server) at a time.") End If Else ' File doesn't exist. Send an error. SendExternalSystemMessage("ERR: The requested file can not be found by the server.") End If End If If message.Length > 7 Then tmp = message.Substring(0, 8) If tmp = "Sending:" Then ' Strip away the headder... Dim msgParts() As String = Split(message, ":") IncomingFileSize = Convert.ToInt64(msgParts(2)) IncomingFileName = msgParts(1) tmp = ReceivedFilesFolder & "\" & IncomingFileName SystemMessage("Receiving file: " & IncomingFileName) If Not BeginToReceiveAFile(tmp) Then SystemMessage("ERR: " & tmp) SendExternalSystemMessage("Abort<-") End If End If If message.Length > 10 Then tmp = message.Substring(0, 10) If tmp = "blocksize:" Then Dim msgParts() As String = Split(message, ":") blockSize = Convert.ToUInt16(msgParts(1)) End If If message = "->Done" Then FinishReceivingTheFile() SystemMessage("->Done") End If ' We've been notified that no file data will be forthcoming. If message = "Abort->" Then FinishReceivingTheFile() SystemMessage("->Aborted.") Process.GetCurrentProcess().PriorityClass = ProcessPriorityClass.Normal Try File.Delete(ReceivedFilesFolder & "\" & IncomingFileName) Catch ex As Exception End Try End If ' Send File Request: The server wants to send us a file. If message.Length > 4 Then tmp = message.Substring(0, 4) If tmp = "SFR:" Then If CheckSessionPermissions("SFR") Then Dim parts() As String parts = Split(message, "SFR:") SendExternalSystemMessage("GFR:" & parts(1)) Else ' This user doesn't have rights to this file. Send an error. SendExternalSystemMessage("ERR: You do not have permission to send files. Access Denied.") End If End If ' Notification that the server has complied with our ' request to stop sending bytes for this ' (server->client) file transfer. If message = "->Aborted." Then SystemMessage("->Aborted.") WrapUpIncomingFile() End If ' Notification that the server has complied with our ' request to stop recieving bytes for this ' (client->server) file transfer. If message = "<-Aborted." Then SystemMessage("<-Aborted.") End If If message.Length > 4 Then tmp = message.Substring(0, 4) If tmp = "ERR:" Then ' The server has sent us an error message. ' Pass it on up to the user. SystemMessage(message) End If If message.Length > 5 Then tmp = message.Substring(0, 5) If tmp = "CERR:" Then ' The server has sent us a connection error message. ' Pass it on up to the user. errMsg = message.Replace("CERR:", "") End If ' New queue throttling code If message = "pause" Then 'sendBuffer.PauseSending() End If If message = "resume" Then 'sendBuffer.ResumeSending() End If ' Preform gracefull shutdown. If message = "close" then 'SystemMessage("Disconnected by server.") continue_running = False 'disConnectComplete = True Throw New Exception("Shutting down gracefully") End If If message = "connection:rejected" then 'continue_running = False connectionRejected = True InternalClose() End If If message = "connection:accepted" then connectionAccepted = True End If ElseIf channel = 253 Then ' File transfer from server to client Try If ReceivingFile Then HandleIncomingFileBytes(bytes) fileBytesRecieved += bytes.LongLength End If Catch ex As Exception End Try ElseIf channel = 252 Then ' File transfer from client to server ElseIf channel = 251 Then ' reserved. End If End Sub Private Function HandleOutgoingInternalSystemMessage() As Boolean Dim tmp(1) As Byte HandleOutgoingInternalSystemMessage = False Dim _size As Integer GetMoreFileBytesIfAvailable() ' Handle outgoing system stuff here If SystemBytesToBeSentAvailable = True Then HandleOutgoingInternalSystemMessage = True If SystemBytesToBeSent.Length > blockSize Then ' Send Channel tmp(0) = SystemOutputChannel Stream.Write(tmp, 0, 1) bytesSentThisSecond += 1 ' Send packet size _size = blockSize tmp = BitConverter.GetBytes(_size) Stream.Write(tmp, 0, 2) bytesSentThisSecond += 2 ' Send packet Stream.Write(GetSome(SystemBytesToBeSent, blockSize, SystemBytesToBeSentAvailable), 0, _size) bytesSentThisSecond += _size Else ' Send Channel tmp(0) = SystemOutputChannel Stream.Write(tmp, 0, 1) bytesSentThisSecond += 1 ' Send packet size _size = SystemBytesToBeSent.Length tmp = BitConverter.GetBytes(_size) Stream.Write(tmp, 0, 2) bytesSentThisSecond += 2 ' Send packet Stream.Write(SystemBytesToBeSent, 0, _size) bytesSentThisSecond += _size SystemBytesToBeSentAvailable = False End If End If End Function Private Function HandleOutgoingUserData() As Boolean Dim tmp(1) As Byte Dim _size As UShort Dim notify As Boolean = False Static packet(0) As Byte Dim msg As message = Nothing Dim stopMessageSent As Boolean = False If Not UserBytesToBeSentAvailable then If sendQueue.TryDequeue(msg) then UserBytesToBeSentAvailable = True UserBytesToBeSent.SetLength(0) UserBytesToBeSent.Write(msg.bytes, 0, msg.bytes.Length) UserBytesToBeSent.Position = 0 UserOutputChannel = msg.dataChannel End If End If If theClientIsStopping() then UserBytesToBeSentAvailable = True Dim closeMessage As Byte() = Utilities.StrToByteArray("close") UserBytesToBeSent.SetLength(0) UserBytesToBeSent.Write(closeMessage, 0, closeMessage.Length) UserBytesToBeSent.Position = 0 UserOutputChannel = 254 stopMessageSent = True End If If UserBytesToBeSentAvailable = True Then Try If (UserBytesToBeSent.Length - UserBytesToBeSent.Position) > blockSize Then ' Send Channel tmp(0) = UserOutputChannel Stream.Write(tmp, 0, 1) ' Send packet size _size = blockSize tmp = BitConverter.GetBytes(_size) Stream.Write(tmp, 0, 2) ' Send packet If packet.Length <> _size Then ReDim packet(_size - 1) UserBytesToBeSent.Read(packet, 0, _size) 'Client.NoDelay = True Stream.Write(packet, 0, _size) bytesSentThisSecond += 3 + _size ' Check to see if we've sent it all... If UserBytesToBeSent.Length = UserBytesToBeSent.Position Then UserBytesToBeSentAvailable = False notify = True End If Else ' Send Channel tmp(0) = UserOutputChannel Stream.Write(tmp, 0, 1) ' Send packet size _size = Convert.ToUInt16(UserBytesToBeSent.Length - UserBytesToBeSent.Position) tmp = BitConverter.GetBytes(_size) Stream.Write(tmp, 0, 2) ' Send packet If packet.Length <> _size Then ReDim packet(_size - 1) UserBytesToBeSent.Read(packet, 0, _size) 'Client.NoDelay = True Stream.Write(packet, 0, _size) bytesSentThisSecond += 3 + _size UserBytesToBeSentAvailable = False notify = True End If Catch ex As Exception ' Report error attempting to send user data. Debug.WriteLine("Unexpected error in TcpCommClient\HandleOutgoingUserData: " & ex.Message) End Try ' Notify the user that the packet has been sent. If notify Then SystemMessage("UBS:" & UserOutputChannel) If stopMessageSent then Throw New Exception("Client closing gracefully.") Return True Else Return False End If End Function Private Function GetSome(ByRef bytes() As Byte, ByVal chunkToBreakOff As Integer, _ ByRef bytesToBeSentAvailable As Boolean, _ Optional ByVal theseAreUserBytes As Boolean = False) As Byte() Dim tmp(chunkToBreakOff - 1) As Byte Array.Copy(bytes, 0, tmp, 0, chunkToBreakOff) GetSome = tmp If bytes.Length = chunkToBreakOff Then bytesToBeSentAvailable = False If theseAreUserBytes Then SystemMessage("UBS") Else Dim tmp2(bytes.Length - chunkToBreakOff - 1) As Byte Array.Copy(bytes, chunkToBreakOff, tmp2, 0, bytes.Length - chunkToBreakOff) bytes = tmp2 End If End Function Private Sub SystemMessage(ByVal MsgText As String) If silentShutdown = True then Return If isRunning then RcvBytes(Utilities.StrToByteArray(MsgText), 255) Else Dim bgMsg As New Thread(AddressOf BgMessage) bgMsg.IsBackground = True bgMsg.Start(MsgText) End If End Sub Private Sub BgMessage(ByVal _text As Object) Dim msg As String = CType(_text, String) ClientCallbackObject(Utilities.StrToByteArray(msg), 255) End Sub ' Check to see if our app is closing (set in FormClosing event) Private Function theClientIsStopping() As Boolean If continue_running = False then Return True Return False End Function Private Function CalculateMbps(Optional ByVal GetMbps As Boolean = False) As Decimal Static averagesCounter As Integer = 0 Static tmr As Date = Now Static lastread As Int32 = 0 Dim looper As Short = 0 Dim tmp As Int32 = 0 If mbpsOneSecondAverage Is Nothing Then ReDim mbpsOneSecondAverage(9) If Now >= tmr.AddMilliseconds(250) Then averagesCounter += 1 If averagesCounter < 0 Then averagesCounter = 0 Select Case averagesCounter Case 0 SyncLock (mbpsSyncObject) Try mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond bytesSentThisSecond = 0 bytesReceivedThisSecond = 0 Catch ex As Exception averagesCounter = -1 End Try End SyncLock Case 1 SyncLock (mbpsSyncObject) Try mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond bytesSentThisSecond = 0 bytesReceivedThisSecond = 0 Catch ex As Exception averagesCounter = -1 End Try End SyncLock Case 2 SyncLock (mbpsSyncObject) Try mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond bytesSentThisSecond = 0 bytesReceivedThisSecond = 0 Catch ex As Exception averagesCounter = -1 End Try End SyncLock Case 3 SyncLock (mbpsSyncObject) Try mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond bytesSentThisSecond = 0 bytesReceivedThisSecond = 0 Catch ex As Exception averagesCounter = -1 End Try End SyncLock End Select If averagesCounter > 2 Then averagesCounter = -1 tmr = Now End If ' Did they ask us for the Mbps? If GetMbps Then For looper = 0 To 3 SyncLock (mbpsSyncObject) tmp += mbpsOneSecondAverage(looper) End SyncLock Next CalculateMbps = tmp Else CalculateMbps = 0 End If End Function Private Sub Run() Dim puck(1) As Byte : puck(0) = 0 Dim theBuffer(blockSize - 1) As Byte Dim tmp(1) As Byte Dim dataChannel As Byte = 0 Dim packetSize As UShort = 0 Dim bytesread As Integer Dim userOrSystemSwitcher As Integer = 0 Dim PercentUsage As Short = -1 Dim connectionLossTimer As Date 'Dim CPUutil As New CpuMonitor 'CPUutil.Start() Try Client = New TcpClient Client.Connect(IP, Port) ' Connection Accepted. Stream = Client.GetStream() Stream.ReadTimeout = 5000 ' Set the send and receive buffers to the maximum ' size allowable in this application... Client.Client.ReceiveBufferSize = 65535 Client.Client.SendBufferSize = 65535 ' no delay on partially filled packets... ' Send it all as fast as possible. Client.NoDelay = True ' Pass a message up to the user about our status. isRunning = True SystemMessage("Connected.") ' Start the communication loop While True ' Check to see if our app is shutting down. 'If theClientIsStopping() Then Exit Do ' Normal communications... If weHaveThePuck Then ' Send user data if there is any to be sent. userOrSystemSwitcher += 1 Select Case userOrSystemSwitcher Case 1 HandleOutgoingUserData() Case 2 HandleOutgoingInternalSystemMessage() End Select If userOrSystemSwitcher > 1 Then userOrSystemSwitcher = 0 ' After sending our data, send the puck Stream.Write(puck, 0, 1) ' Uncomment this to see control bit traffic as part of your Mbps 'bytesSentThisSecond += 1 weHaveThePuck = False End If If theBuffer.Length < 2 Then ReDim theBuffer(1) ' Read in the control byte. Stream.Read(theBuffer, 0, 1) dataChannel = theBuffer(0) ' Uncomment this to see control bit traffic as part of your Mbps 'bytesReceivedThisSecond += 1 ' If it's just the puck (communictaion syncronization byte), ' set weHaveThePuck true and that's all. dataChannel 0 is ' reserved for the puck. If dataChannel = 0 Then weHaveThePuck = True Else ' It's not the puck: It's an incoming packet. ' Get the packet size: tmp(0) = Convert.ToByte(Stream.ReadByte) tmp(1) = Convert.ToByte(Stream.ReadByte) packetSize = BitConverter.ToUInt16(tmp, 0) If theBuffer.Length <> packetSize Then ReDim theBuffer(packetSize - 1) bytesReceivedThisSecond += 2 ' Get the packet: connectionLossTimer = Now Do ' Read bytes in... bytesread += Stream.Read(theBuffer, bytesread, (packetSize - bytesread)) ' If it takes longer then 3 seconds to get a packet, we've lost connection. If connectionLossTimer.AddSeconds(3) < Now Then Throw New Exception("Time out waiting for packet to arrive. Connection lost.") Loop While bytesread < packetSize bytesread = 0 ' Record bytes read for throttling... bytesReceivedThisSecond += packetSize ' Handle the packet... If dataChannel > 250 and continue_running Then ' this is an internal system packet HandleIncomingSystemMessages(theBuffer, dataChannel) Else ' Hand data off to the calling thread. RcvBytes(theBuffer, dataChannel) End If End If CalculateMbps(False) ' Measure and display the CPU usage of the client (this thread). 'If PercentUsage <> CPUutil.ThreadUsage Then ' PercentUsage = CPUutil.ThreadUsage ' SystemMessage("" & PercentUsage & "% Thread Usage (" & CPUutil.CPUusage & "% across all CPUs)") 'End If End While Catch ex As Exception ' Handle thrown errors here: If ex IsNot Nothing Then errMsg = "Error caught in run thread: " & ex.Message 'And ex.Message <> "Shutting down gracefully" End Try Try 'CPUutil.StopWatcher() 'If Not Client.Client Is Nothing Then Client.Client.Close() Client.Client.Dispose() Client.Close() Catch ex As Exception ' An unexpected error. Debug.WriteLine("Error atempting to shut down the theClient after Gracefull Disconnect: " & ex.Message) End Try Try If fileWriter IsNot Nothing Then fileWriter.Close() Catch ex As Exception End Try 'Try ' 'CPUutil.StopWatcher() ' 'If Not Client.Client Is Nothing Then Client.Client.Close() 'Catch ex As Exception ' ' An unexpected error. ' Debug.WriteLine("Unexpected error in Client\theClientIsStopping: " & ex.Message) 'End Try WrapUpIncomingFile() isRunning = False If messageIn IsNot Nothing Then messageIn.Close() If reconnectMonitorDetails.ReconnectOnDisconnection And _ Not reconnectMonitorDetails.Reconnecting And connectionAccepted Then reconnectMonitorDetails.ipAddress = IP.ToString() reconnectMonitorDetails.machineId = machineId reconnectMonitorDetails.port = Port Dim reconnectThread As New Thread(AddressOf ReconnectMonitor) reconnectThread.Start() End If ' Report disconnection here: If reconnectMonitorDetails.ReconnectOnDisconnection = False Then ' We've been disconnected and we are con configured to reconnect automatically, so we report it. SystemMessage("Disconnected.") Else ' We ARE configured to automatically reconnect, and we've been disconnected. ' If continue_running = False, then we've been deliberately disconnected ' by the server, and we should just report our status. ' If continue_running = True, then we've LOST connection, possibly due to network ' conditions, and we should not report it HERE. The automatic reconnect system ' will either reconnect, or report that we are disconnected after the reconnect ' duration has expired. If continue_running = False then SystemMessage("Disconnected.") End If disConnectComplete = True End Sub End Class