Imports System.Net.Sockets
Imports System.Net
Imports System.IO
Imports System.Collections.Concurrent
Imports System.Threading
Public Class Server
Public errMsg As String
' Define the callback delegate type
Public Delegate Sub ServerCallbackDelegate(ByVal bytes() As Byte, ByVal sessionID As Int32, ByVal dataChannel As Byte)
' Create Delegate object
Public ServerCallbackObject As ServerCallbackDelegate
Private Listener As TcpListener
Private continue_running As Boolean = False
Private blockSize As UInt16
Private Port As Integer
Private localAddr As IPAddress
Private Mbps As UInt32
Private newSessionId As Int32 = 0
Public IsRunning As Boolean = False
Private serverState As currentState = currentState.stopped
Private enforceUniqueMachineIds As Boolean
Private SessionCollection As New Sessions
Private SessionCollectionLocker As New Object
Public Class message
Public bytes() As Byte
Public dataChannel As Byte
Public sessionID As Int32
End Class
Private Enum currentState
err = -1
stopped = 0
running = 1
idle = 2
End Enum
Private Class Sessions
Private sessionCollection As New List(Of SessionCommunications)
Private sessionLockObject As New Object
Private reusableSessions As New Concurrent.ConcurrentQueue(Of Int32)
Private newSessions As New Concurrent.ConcurrentQueue(Of TcpClient)
Private newSessionId As Int32 = 0
Public Function VerifyAndChangeUniqueMachineId(ByRef session As SessionCommunications, ByVal NewMachineId As String) As Boolean
Dim machineIdIsUnique As Boolean = True
SyncLock sessionLockObject
For count = 0 to sessionCollection.Count -1
If sessionCollection.Item(count).machineId = NewMachineId and sessionCollection.Item(count).machineIdValidated then
machineIdIsUnique = False
Exit For
End If
Next
If machineIdIsUnique = True then
session.machineId = NewMachineId
session.machineIdValidated = True
End If
End SyncLock
Return machineIdIsUnique
End Function
Public Sub AddSession(ByRef client As TcpClient, ByRef runThread As Thread, ByVal enforceUinqueIds As Boolean)
SyncLock sessionLockObject
Dim id As Int32 = GetReusableSessionID()
Dim session As SessionCommunications = Nothing
If id > -1 then
session = sessionCollection.Item(id)
'session.Close()
session.IsRunning = False
session.shuttingDown = True
session.machineId = ""
session.machineIdValidated = False
session.enforceUniqueMachineIds = enforceUinqueIds
Try
If session.theClient.Client isnot Nothing then session.theClient.Client.Dispose()
Catch ex As Exception
End Try
session.theClient = client
session.disConnect = False
session.shuttingDown = False
'session = New SessionCommunications(client, id)
'session.enforceUniqueMachineIds = enforceUinqueIds
'session.machineId = ""
'session.machineIdValidated = False
'sessionCollection.Item(id) = Nothing
'sessionCollection.Item(id) = session
Else
id = newSessionId
newSessionId += 1
session = New SessionCommunications(client, id)
sessionCollection.Add(session)
End If
If enforceUinqueIds = False then session.machineIdValidated = True
runThread.Name = "Server session #" & id.ToString()
runThread.Start(session)
End SyncLock
End Sub
Public Sub CloseSession(ByRef session As SessionCommunications)
SyncLock sessionLockObject
session.IsRunning = False
session.machineId = ""
session.machineIdValidated = False
ReuseSessionNumber(session.sessionID)
End SyncLock
End Sub
Public Sub AddSession(ByVal theNewSession as SessionCommunications)
SyncLock sessionLockObject
If sessionCollection.Count > theNewSession.sessionID then
sessionCollection.Item(theNewSession.sessionID) = Nothing
sessionCollection.Item(theNewSession.sessionID) = theNewSession
Else
sessionCollection.Add(theNewSession)
End If
End SyncLock
End Sub
Public Function GetReusableSessionID() As Int32
Dim sessionNumber As Int32 = -1
If reusableSessions.TryDequeue(sessionNumber) then
Return sessionNumber
End If
Return -1
End Function
Public Sub ReuseSessionNumber(ByVal sessionNumber As Int32)
reusableSessions.Enqueue(sessionNumber)
End Sub
Public Function GetSession(ByVal sessionID As Int32, ByRef session As SessionCommunications) As Boolean
Try
If sessionCollection.Item(sessionID).machineIdValidated = False then Return False
session = sessionCollection.Item(sessionID)
If session.machineIdValidated = False then Return False
If session is Nothing then Return False
If Not session.IsRunning then Return False
Return True
Catch ex As Exception
Return False
End Try
End Function
Public Function GetSession(ByVal MachineID As String, ByRef session As SessionCommunications) As Boolean
session = Nothing
SyncLock sessionLockObject
For Each connectedSession In sessionCollection
If connectedSession.IsRunning And connectedSession.machineId = MachineID And connectedSession.machineIdValidated = True Then
session = connectedSession
Exit For
End If
Next
End SyncLock
If session is Nothing then Return False
Return True
End Function
Public Function RemoveSession(ByRef session As SessionCommunications) As Boolean
Dim retVal As Boolean = True
SyncLock sessionLockObject
Try
sessionCollection.Remove(session)
Catch ex As Exception
retVal = False
End Try
End SyncLock
Return retVal
End Function
Public Sub Broadcast(ByVal msg As message)
Dim thisCopy As New List(Of SessionCommunications)
SyncLock sessionLockObject
For i As Int32 = 0 to sessionCollection.Count - 1
thisCopy.Add(sessionCollection.Item(i))
Next
End SyncLock
For i As Int32 = 0 To thisCopy.Count - 1
If thisCopy.Item(i) IsNot Nothing AndAlso thisCopy.Item(i).IsRunning Then
Try
thisCopy.Item(i).sendQueue.Enqueue(msg)
Catch ex As Exception
End Try
End If
Next
End Sub
Public Function GetSessionCollection() As List(Of SessionCommunications)
Dim thisCopy As New List(Of SessionCommunications)
SyncLock sessionLockObject
For i As Int32 = 0 to sessionCollection.Count - 1
If sessionCollection.Item(i).machineIdValidated = True Then thisCopy.Add(sessionCollection.Item(i))
Next
End SyncLock
Return thisCopy
End Function
Public Sub ShutDown()
SyncLock sessionLockObject
For Each session As SessionCommunications In sessionCollection
Try
If session IsNot Nothing Then session.Close()
Catch ex As Exception
End Try
Next
End SyncLock
End Sub
End Class
Public Class SessionCommunications
Public UserBytesToBeSentAvailable As Boolean = False
Public UserBytesToBeSent As New MemoryStream
Public UserOutputChannel As Byte
Public SystemBytesToBeSentAvailable As Boolean = False
Public SystemBytesToBeSent() As Byte
Public SystemOutputChannel As Byte
Public theClient As TcpClient
Public IsRunning As Boolean = False
Public remoteIpAddress As System.Net.IPAddress
Public bytesRecieved() As Byte
Public sessionID As Int32
Public disConnect As Boolean = False
Public bytesSentThisSecond As Int32 = 0
Public bytesRecievedThisSecond As Int32 = 0
Public fileBytesRecieved As Int64 = 0
Public filebytesSent As Int64 = 0
Public SendingFile As Boolean = False
Public FileBeingSentPath As String
Public IncomingFileSize As Int64
Public IncomingFileName As String
Public ReceivingFile As Boolean = False
Public sendPacketSize As Boolean = False
Public fileReader As FileStream
Public fileWriter As AsyncUnbuffWriter
Public ReceivedFilesFolder As String = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\ServerReceivedFiles"
Public userName As String
Public password As String
Public paused As Boolean
Public pauseSent As Boolean
Public sendQueue As ConcurrentQueue(Of message)
Public messageIn As MessageInQueue
Public machineId As String
Public shuttingDown As Boolean
Public enforceUniqueMachineIds As Boolean
Public machineIdValidated As Boolean
Public Sub SendErrorMessage(ByVal message As String)
message = "ERR: " & message
If sendQueue is Nothing then sendQueue = New ConcurrentQueue(Of message)
sendQueue.Enqueue(New message With { _
.bytes = Utilities.StrToByteArray(message),
.dataChannel = 254,
.sessionID = sessionID
})
End Sub
Public Sub QueueSystemMessage(ByVal message As String)
If sendQueue is Nothing then sendQueue = New ConcurrentQueue(Of message)
sendQueue.Enqueue(New message With { _
.bytes = Utilities.StrToByteArray(message),
.dataChannel = 254,
.sessionID = sessionID
})
End Sub
Public class MessageInQueue
Public queue As New ConcurrentQueue(Of message)
Private bgThread As New Threading.Thread(AddressOf Pump)
Private running As Boolean
Private callBack As ServerCallbackDelegate
Public Sub New(ByRef _callBack As ServerCallbackDelegate)
callBack = _callBack
running = True
bgThread.IsBackground = 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.sessionID, msg.dataChannel)
End If
End If
If queue.Count = 0 then Thread.Sleep(2)
End While
End Sub
End Class
Public Sub New(ByVal _theClient As TcpClient, ByVal _sessionID As Int32, Optional ByVal uniqueMachineIds As Boolean = True)
theClient = _theClient
sessionID = _sessionID
paused = False
pauseSent = False
shuttingDown = False
enforceUniqueMachineIds = uniqueMachineIds
machineIdValidated = False
End Sub
Public Sub Close(Optional ByVal secondsToWaitForSendQueueToEmpty As Int32 = 3, Optional ByVal closeInBackground As Boolean = False)
If closeInBackground = True Then
If messageIn IsNot Nothing Then messageIn.Close()
Dim bgThread As New Thread(AddressOf WaitClose)
bgThread.Start(New TimeSpan(0, 0, secondsToWaitForSendQueueToEmpty))
Return
End If
If messageIn IsNot Nothing Then messageIn.Close()
Dim emptySendQueueTimeout = Now.Add(New TimeSpan(0, 0, secondsToWaitForSendQueueToEmpty))
shuttingDown = True
Try
While (sendQueue.Count > 0) Or (UserBytesToBeSentAvailable = True)
Thread.Sleep(5)
If Now > emptySendQueueTimeout then Exit While
End While
Catch ex As Exception
' sendQueue is nothing... not interested in this error.
End Try
disConnect = True
End Sub
Private Sub WaitClose(ByVal o As Object)
Dim emptySendQueueTimeout = Now.Add(CType(o, TimeSpan))
shuttingDown = True
Try
While (sendQueue.Count > 0) Or (UserBytesToBeSentAvailable = True)
Thread.Sleep(5)
If Now > emptySendQueueTimeout then Exit While
End While
Catch ex As Exception
' sendQueue is nothing... not interested in this error.
End Try
Thread.Sleep(1000)
disConnect = True
End Sub
End Class
'''
''' Returns a current copy of the server's internal list of sessions as a List(Of SessionCommunications). It is possible that some sessions may be inactive,
''' or disconnected. Care should be taken to check the session.isRunning before using one,
''' because inactive or disconnected sessions may be overwritten by new connections at any moment.
'''
''' List(Of SessionCommunications)
'''
Public Function GetSessionCollection() As List(Of SessionCommunications)
Dim thisCollection As List(Of SessionCommunications) = SessionCollection.GetSessionCollection()
Return thisCollection
End Function
'''
''' Gets the session object associated with the sessionId. Returns Nothing for sessions where session.isRunning = False.
'''
'''
''' A TcpComm.Server.SessionCommunications object
'''
Public Function GetSession(ByVal sessionId As Int32) As SessionCommunications
Dim theSession As SessionCommunications = Nothing
' Sessions that are not running are not returned, so that they're sendqueues are not
' accidently inflated.
If SessionCollection.GetSession(sessionId, theSession) then Return theSession
Return Nothing
End Function
'''
''' Gets the first session object associated with the MachineID. Returns Nothing for sessions where session.isRunning = False.
'''
'''
''' A TcpComm.Server.SessionCommunications object
'''
Public Function GetSession(ByVal aMachineID As String) As SessionCommunications
GetSession = Nothing
SessionCollection.GetSession(aMachineID, GetSession)
Return GetSession
End Function
' CallbackForm must implement an UpdateUI Sub.
Public Sub New(ByVal callbackMethod As ServerCallbackDelegate, Optional ByVal _throttledBytesPerSecond As UInt32 = 9000000, Optional ByVal enforceUniqueMachineId As Boolean = True)
Mbps = _throttledBytesPerSecond
enforceUniqueMachineIds = enforceUniqueMachineId
' BlockSize should be 62500 or 63100, depending on requested speed.
' Excellent performance, and works great with throttling.
Dim _blockSize As UInt16
' Get corrected blocksize for throttling.
If Mbps < 300000 Then
If Mbps > 16000 Then
blockSize = 4000
Else
blockSize = CUShort((Mbps / 4))
End If
ElseIf Mbps > 300000 And Mbps < 500000 Then
blockSize = 16000
ElseIf Mbps > 500000 And Mbps < 1000000 Then
blockSize = 32000
Else
Dim count As UInt32 = 0
Dim aFourth As Decimal = 0
If Mbps > 25000000 Then
_blockSize = 63100
Else
_blockSize = 62500
End If
aFourth = CDec(Mbps / 4)
Do
count += _blockSize
If (count + _blockSize) > aFourth Then
Mbps = CUInt(count * 4)
blockSize = _blockSize
Exit Do
End If
Loop
End If
' Initialize the delegate object to point to the user's callback method.
ServerCallbackObject = callbackMethod
End Sub
Public Sub ThrottleNetworkBps(ByVal bytesPerSecond As UInteger)
' Default value is 9000000 Mbps. Ok throughput, and
' good performance for the server (low CPU usage).
Mbps = bytesPerSecond
End Sub
'''
''' 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 ByVal sessionid As Int32 = -1, _
Optional ByRef errMsg As String = "") As Boolean
If textMessage = "" then
errMsg = "Your text message must contain some text."
Return False
End If
Return SendBytes(Utilities.StrToByteArray(textMessage), channel , sessionid, errMsg)
End Function
Public Function Start(ByVal prt As Integer, Optional ByRef errorMessage As String = "") As Boolean
If serverState = currentState.running then
errorMessage = "The server is already running."
Return False
End If
serverState = currentState.idle
Dim listenerThread As New Thread(AddressOf theListener)
Try
Port = prt
localAddr = GetLocalIpAddress()
continue_running = True
IsRunning = True
listenerThread.Name = "Server Listener Thread"
listenerThread.Start()
Catch ex As Exception
errorMessage = ex.Message
Return False
End Try
While serverState <> currentState.running
Thread.Sleep(10)
If serverState = currentState.err Or serverState = currentState.stopped Then
errorMessage = errMsg
Return False
End If
End While
Return True
End Function
Public Sub Close()
continue_running = False
Try
Listener.Stop()
Catch ex As Exception
End Try
Try
SessionCollection.ShutDown()
Catch ex As Exception
End Try
IsRunning = False
ServerCallbackObject(Utilities.StrToByteArray("Server Stopped."), -1, 255)
serverState = currentState.stopped
End Sub
Private 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
Public Function GetBlocksize() As UInt16
Return blockSize
End Function
'''
''' Returns the size of the selected session's sendqueue. Returns -1 if the session is nothing, or session.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 a session's send queue for as long as the session 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(ByVal sessionId As Int32) As Int32
Dim sendQueueSize As Int32 = -1
Dim session As SessionCommunications = Nothing
If SessionCollection.GetSession(sessionId, session) Then
If session IsNot Nothing AndAlso session.IsRunning Then
GetSendQueueSize = session.sendQueue.Count
End If
End If
Return sendQueueSize
End Function
Public Function GetFile(ByVal _path As String, ByVal sessionID As Int32) As Boolean
Dim thisSession As SessionCommunications = Nothing
If SessionCollection.GetSession(sessionID, thisSession) then
If thisSession is Nothing then Return False
If Not thisSession.IsRunning then Return False
thisSession.sendQueue.Enqueue(New message With { _
.bytes = Utilities.StrToByteArray("GFR:" & _path),
.sessionID = sessionID,
.dataChannel = 254
})
Else
Return False
End If
Return True
End Function
Public Function SendFile(ByVal _path As String, ByVal sessionID As Int32) As Boolean
Dim thisSession As SessionCommunications = Nothing
If SessionCollection.GetSession(sessionID, thisSession) then
If thisSession is Nothing then Return False
If Not thisSession.IsRunning then Return False
If thisSession.shuttingDown Then
errMsg = "The session is shutting down, and will not accept any more outgoing messages."
Return False
End If
thisSession.sendQueue.Enqueue(New message With { _
.bytes = Utilities.StrToByteArray("SFR:" & _path),
.sessionID = sessionID,
.dataChannel = 254
})
Else
Return False
End If
Return True
End Function
Public Function SendBytes(ByVal bytes() As Byte, Optional ByVal channel As Byte = 1, Optional ByVal sessionID As Int32 = -1, _
Optional ByRef errMsg As String = "") As Boolean
Dim foundSession As Boolean = False
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
Dim msg As message = New message()
ReDim msg.bytes(bytes.Length -1)
msg.dataChannel = channel
msg.sessionID = sessionID
Buffer.BlockCopy(bytes, 0, msg.bytes, 0, bytes.Length)
If sessionID > -1 then
Dim targetSession As SessionCommunications = Nothing
If SessionCollection.GetSession(sessionID, targetSession) then
If targetSession.shuttingDown then
errMsg = "The session is shutting down, and will not accept any more outgoing messages."
Return False
End If
targetSession.sendQueue.Enqueue(msg)
Return True
End If
Else
SessionCollection.Broadcast(msg)
Return True
End If
errMsg = "The session you are trying to write to is no longer available."
Return False
End Function
Public Function SendBytes(ByRef bytes() As Byte, ByVal offset As Int32, ByVal count As Int32, Optional ByVal channel As Byte = 1, Optional ByVal sessionID As Int32 = -1, _
Optional ByRef errMsg As String = "") As Boolean
Dim foundSession As Boolean = False
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
Dim msg As New message()
ReDim msg.bytes(count - 1)
Buffer.BlockCopy(bytes, offset, msg.bytes, 0, count)
msg.dataChannel = channel
msg.sessionID = sessionID
If sessionID > -1 then
Dim targetSession As SessionCommunications = Nothing
If SessionCollection.GetSession(sessionID, targetSession) then
If targetSession.shuttingDown then
errMsg = "The session is shutting down, and will not accept any more outgoing messages."
Return False
End If
targetSession.sendQueue.Enqueue(msg)
Return True
End If
Else
SessionCollection.Broadcast(msg)
Return True
End If
errMsg = "The session you are trying to write to is no longer available."
Return False
End Function
Public Function SendBytes(ByRef streamBytes As MemoryStream, Optional ByVal channel As Byte = 1, Optional ByVal sessionID As Int32 = -1, _
Optional ByRef errMsg As String = "") As Boolean
Dim foundSession As Boolean = False
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
Dim msg As message = New message()
ReDim msg.bytes(streamBytes.Length -1)
msg.dataChannel = channel
msg.sessionID = sessionID
streamBytes.Position = 0
streamBytes.Read(msg.bytes, 0, msg.bytes.Length)
If sessionID > -1 then
Dim targetSession As SessionCommunications = Nothing
If SessionCollection.GetSession(sessionID, targetSession) then
If targetSession.shuttingDown then
errMsg = "The session is shutting down, and will not accept any more outgoing messages."
Return False
End If
targetSession.sendQueue.Enqueue(msg)
Return True
End If
Else
SessionCollection.Broadcast(msg)
Return True
End If
errMsg = "The session you are trying to write to is no longer available."
Return False
End Function
Private Function RcvBytes(ByVal data() As Byte, ByVal session As SessionCommunications, Optional ByVal dataChannel As Byte = 1) As Boolean
' dataType: >0 = data channel, > 250 = internal messages. 0 is an invalid channel number (it's the puck)
If dataChannel < 1 Then
RcvBytes = False
Exit Function
End If
Try
' Check to see if our app is closing
If Not continue_running Then Return False
Dim passedData(data.Length - 1) As Byte
Array.Copy(data,passedData, data.Length)
If session isnot Nothing then
session.messageIn.queue.Enqueue(New message With { _
.bytes = passedData,
.dataChannel = dataChannel,
.sessionID = session.sessionID
})
Else
' These are internal system messages. There is no session associated with them
ServerCallbackObject(data, -1, dataChannel)
End If
Catch ex As Exception
' An unexpected error.
Debug.WriteLine("Unexpected error in server\RcvBytes: " & ex.Message)
Return False
End Try
Return True
End Function
Private Function SendExternalSystemMessage(ByVal message As String, ByVal session As SessionCommunications) As Boolean
session.SystemBytesToBeSent = Utilities.StrToByteArray(message)
session.SystemOutputChannel = 254 ' Text messages / commands on channel 254
session.SystemBytesToBeSentAvailable = True
Return True
End Function
Private Function CheckSessionPermissions(ByVal session As SessionCommunications, ByVal cmd As String) As Boolean
' Your security code here...
Return True
End Function
Private Function BeginFileSend(ByVal _path As String, ByVal session As SessionCommunications, ByVal fileLength As Long) As Boolean
Try
session.fileReader = New FileStream(_path, FileMode.Open, FileAccess.Read, FileShare.None, AsyncUnbuffWriter.GetPageSize)
session.SendingFile = True
BeginFileSend = True
Catch ex As Exception
BeginFileSend = False
_path = ex.Message
session.SendingFile = False
End Try
Try
If Not BeginFileSend Then session.fileReader.Close()
Catch ex As Exception
End Try
End Function
Private Sub GetMoreFileBytesIfAvailable(ByVal session As SessionCommunications)
Dim bytesRead As Int32 = 0
If session.SendingFile And Not session.SystemBytesToBeSentAvailable Then
Try
If session.SystemBytesToBeSent.Length <> blockSize Then ReDim session.SystemBytesToBeSent(blockSize - 1)
bytesRead = session.fileReader.Read(session.SystemBytesToBeSent, 0, blockSize)
If bytesRead <> blockSize Then ReDim Preserve session.SystemBytesToBeSent(bytesRead - 1)
If bytesRead > 0 Then
session.SystemOutputChannel = 253 ' File transfer from server to client
session.SystemBytesToBeSentAvailable = True
Else
ReDim session.SystemBytesToBeSent(blockSize - 1)
SendExternalSystemMessage("->Done", session) ' Send the client a completion notice.
session.SendingFile = False
' Clean up
session.fileReader.Close()
session.fileReader = Nothing
GC.GetTotalMemory(True)
End If
Catch ex As Exception
SendExternalSystemMessage("ERR: " & ex.Message, session)
' We're finished.
ReDim session.SystemBytesToBeSent(blockSize - 1)
session.SendingFile = False
session.fileReader.Close()
End Try
End If
End Sub
Private Function GetFilenameFromPath(ByRef filePath As String) As String
Dim filePathParts() As String
If filePath.Trim = "" Then Return ""
Try
filePathParts = Split(filePath, "\")
GetFilenameFromPath = filePathParts(filePathParts.Length - 1)
Catch ex As Exception
filePath = ex.Message
Return ""
End Try
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 Function BeginToReceiveAFile(ByVal _path As String, ByVal session As SessionCommunications) As Boolean
Dim readBuffer As Int32 = 0
session.ReceivingFile = True
BeginToReceiveAFile = True
session.fileBytesRecieved = 0
Try
CreateFolders(_path) ' Just a 256k write buffer for the server. Let's try to avoid memory problems...
session.fileWriter = New AsyncUnbuffWriter(_path, True, 1024 * 256, session.IncomingFileSize)
Catch ex As Exception
_path = ex.Message
session.ReceivingFile = False
End Try
If Not session.ReceivingFile Then
Try
session.fileWriter.Close()
Catch ex As Exception
End Try
Return False
End If
End Function
Private Function HandleIncomingFileBytes(ByRef bytes() As Byte, ByVal session As SessionCommunications) As Boolean
Try
session.fileWriter.Write(bytes, bytes.Length)
HandleIncomingFileBytes = True
Catch ex As Exception
HandleIncomingFileBytes = False
End Try
End Function
Private Sub FinishReceivingTheFile(ByVal session As SessionCommunications)
Try
session.fileWriter.Close()
session.fileWriter = Nothing
session.ReceivingFile = False
Catch ex As Exception
session.ReceivingFile = False
End Try
End Sub
Private Sub HandleIncomingSystemMessages(ByVal bytes() As Byte, ByVal channel As Byte, ByVal session As SessionCommunications)
If channel = 254 Then ' Text commands / messages passed between server and client
Dim message As String = Utilities.BytesToString(bytes)
Dim filePath As String
Dim tmp As String = ""
' Get File Request: The client wants us to send them a file.
If message.Length > 4 Then tmp = message.Substring(0, 4)
If tmp = "GFR:" Then
' Get file path...
filePath = message.Substring(4, message.Length - 4)
' Does it exist?
If File.Exists(filePath) Then
' Do they have permission to get this file?
If CheckSessionPermissions(session, "GFR") Then
' Are we already busy sending them a file?
If Not session.SendingFile Then
Dim _theFilesInfo As New FileInfo(filePath)
If BeginFileSend(filePath, session, _theFilesInfo.Length) Then
' Send only the file NAME. It will have a different path on the other side.
SendExternalSystemMessage("Sending:" & GetFilenameFromPath(filePath) & _
":" & _theFilesInfo.Length, session)
Else
' FilePath contains the error message.
SendExternalSystemMessage("ERR: " & filePath, session)
End If
Else
' There's already a GFR in progress.
SendExternalSystemMessage("ERR: File: ''" & _
session.FileBeingSentPath & _
"'' is still in progress. Only one file " & _
"may be transfered (from server to client) at a time.", session)
End If
Else
' This user doesn't have rights to "get" this file. Send an error.
SendExternalSystemMessage("ERR: You do not have permission to receive files. Access Denied.", session)
End If
Else
' File doesn't exist. Send an error.
SendExternalSystemMessage("ERR: The requested file can not be found by the server.", session)
End If
End If
' We're being informed that we will be receiving a file:
If message.Length > 7 Then tmp = message.Substring(0, 8)
If tmp = "Sending:" Then
' Strip away the headder...
Dim msgParts() As String = Split(message, ":")
session.IncomingFileSize = Convert.ToInt64(msgParts(2))
session.IncomingFileName = msgParts(1)
tmp = session.ReceivedFilesFolder & "\" & session.IncomingFileName
SystemMessage("Receiving file: " & session.IncomingFileName)
If Not BeginToReceiveAFile(tmp, session) Then
SystemMessage("ERR: " & tmp)
SendExternalSystemMessage("Abort->", session)
End If
End If
If message.Length > 10 Then tmp = message.Substring(0, 10)
If tmp = "MachineID:" Then
message = message.Substring(10, message.Length - 10)
message = message.Trim
If enforceUniqueMachineIds = True then
If message = "" then
'Send a connection Error:
session.QueueSystemMessage("CERR:This server requires a unique Machine ID.")
'And a connection rejection notice:
session.QueueSystemMessage("connection:rejected")
' Marke the session as invalidated, and set the machine name to nothing:
session.machineIdValidated = False
session.machineId = ""
Else
If SessionCollection.VerifyAndChangeUniqueMachineId(session, message) = False Then
'Send a connection Error:
session.QueueSystemMessage("CERR:This server requires a unique Machine ID.")
'And a connection rejection notice:
session.QueueSystemMessage("connection:rejected")
' Marke the session as invalidated, and set the machine name to nothing:
session.machineIdValidated = False
session.machineId = ""
Else
SystemMessage("Session#" & session.sessionID & " MachineID:" & session.machineId)
session.QueueSystemMessage("connection:accepted")
End If
End If
Else
session.machineId = message
SystemMessage("Session#" & session.sessionID & " MachineID:" & session.machineId)
session.QueueSystemMessage("connection:accepted")
End If
End If
If message = "<-Done" Then
FinishReceivingTheFile(session)
SystemMessage("<-Done")
End If
' We've been notified that no file data will be forthcoming.
If message = "Abort<-" Then
WrapUpIncomingFile(session)
SystemMessage("<-Aborted.")
SendExternalSystemMessage("<-Aborted.", session)
End If
' Send File Request: The client wants to send us a file.
If message.Length > 4 Then tmp = message.Substring(0, 4)
If tmp = "SFR:" Then
If CheckSessionPermissions(session, "SFR") Then
Dim parts() As String
parts = Split(message, "SFR:")
SendExternalSystemMessage("GFR:" & parts(1), session)
Else
' This user doesn't have rights to send us a file. Send an error.
SendExternalSystemMessage("ERR: You do not have permission to send files. Access Denied.", session)
End If
End If
If message.Length > 4 Then tmp = message.Substring(0, 4)
If tmp = "GDR:" Then ' Get Directory Request
' Send each file in the directory and all subdirectories.
' To be implemented in the future.
End If
If message.Length > 4 Then tmp = message.Substring(0, 4)
If tmp = "ERR:" Then ' The client has sent us an error message.
' Pass it on up to the user.
SystemMessage(message)
End If
' New queue throttling code
If message = "pause" Then
session.paused = True
End If
If message = "resume" Then
session.paused = False
End If
If message = "Abort->" Then
Try
session.SendingFile = False
ReDim session.SystemBytesToBeSent(blockSize - 1)
SendExternalSystemMessage("->Aborted.", session)
SystemMessage("->Aborted.")
session.fileReader.Close()
Catch ex As Exception
End Try
End If
' The client is disconnecting. Close the connection gracefully...
If message = "close" Then
' This will be caught by the try in the run sub, and execution
' will drop out of the communication loop immediately and
' begin the shutdown process.
Throw New Exception("Shutting session down gracefully.")
End If
ElseIf channel = 253 Then ' File transfer from server to client
ElseIf channel = 252 Then ' File transfer from client to server
Try
If session.ReceivingFile Then
HandleIncomingFileBytes(bytes, session)
session.fileBytesRecieved += bytes.Length
End If
Catch ex As Exception
End Try
ElseIf channel = 251 Then ' reserved.
End If
End Sub
Private Function HandleOutgoingInternalSystemMessage(ByVal Stream As NetworkStream, _
ByVal session As SessionCommunications) As Boolean
Dim tmp(1) As Byte
Dim _size As UShort
'Static OurTurn As Boolean = False
HandleOutgoingInternalSystemMessage = False
' Create a one time outgoing system message to syncronize packet size.
If Not session.sendPacketSize Then
SendExternalSystemMessage("blocksize:" & blockSize.ToString, session)
session.sendPacketSize = True
End If
GetMoreFileBytesIfAvailable(session)
' Handle outgoing system stuff here
If session.SystemBytesToBeSentAvailable = True Then
HandleOutgoingInternalSystemMessage = True
If session.SystemBytesToBeSent.Length > blockSize Then
' Send Channel
tmp(0) = session.SystemOutputChannel
Stream.Write(tmp, 0, 1)
' Send packet size
_size = blockSize
tmp = BitConverter.GetBytes(_size)
Stream.Write(tmp, 0, 2)
' Send packet
Stream.Write(GetSome(session.SystemBytesToBeSent, blockSize, session.SystemBytesToBeSentAvailable, session), 0, _size)
session.bytesSentThisSecond += 3 + blockSize
Else
' Send Channel
tmp(0) = session.SystemOutputChannel
Stream.Write(tmp, 0, 1)
' Send packet size
_size = Convert.ToUInt16(session.SystemBytesToBeSent.Length)
tmp = BitConverter.GetBytes(_size)
Stream.Write(tmp, 0, 2)
' Send packet
Stream.Write(session.SystemBytesToBeSent, 0, _size)
session.bytesSentThisSecond += 3 + _size
session.SystemBytesToBeSentAvailable = False
End If
End If
End Function
Private Function HandleOutgoingUserData(ByVal Stream As NetworkStream, ByVal session As SessionCommunications) 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 shutSessionDown As Boolean = False
If Not session.UserBytesToBeSentAvailable then
If session.sendQueue.TryDequeue(msg) then
session.UserBytesToBeSentAvailable = True
session.UserBytesToBeSent.SetLength(0)
session.UserBytesToBeSent.Write(msg.bytes, 0, msg.bytes.Length)
session.UserBytesToBeSent.Position = 0
session.UserOutputChannel = msg.dataChannel
End If
End If
If session.disConnect Then
SystemMessage("Session Stopped. (" & session.sessionID.ToString & ")")
session.machineId = ""
session.machineIdValidated = False
SessionCollection.CloseSession(session)
session.UserBytesToBeSentAvailable = True
Dim closeMessage As Byte() = Utilities.StrToByteArray("close")
session.UserBytesToBeSent.SetLength(0)
session.UserBytesToBeSent.Write(closeMessage, 0, closeMessage.Length)
session.UserBytesToBeSent.Position = 0
session.UserOutputChannel = 254
shutSessionDown = True
End If
If session.UserBytesToBeSentAvailable = True Then
Try
If (session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position) > blockSize Then
' Send Channel
tmp(0) = session.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)
session.UserBytesToBeSent.Read(packet, 0, _size)
'session.theClient.NoDelay = True
Stream.Write(packet, 0, _size)
session.bytesSentThisSecond += 3 + _size
' Check to see if we've sent it all...
If session.UserBytesToBeSent.Length = session.UserBytesToBeSent.Position Then
session.UserBytesToBeSentAvailable = False
notify = True
End If
Else
' Send Channel
tmp(0) = session.UserOutputChannel
Stream.Write(tmp, 0, 1)
' Send packet size
_size = Convert.ToUInt16(session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position)
tmp = BitConverter.GetBytes(_size)
Stream.Write(tmp, 0, 2)
' Send packet
If packet.Length <> _size Then ReDim packet(_size - 1)
session.UserBytesToBeSent.Read(packet, 0, _size)
'session.theClient.NoDelay = True
Stream.Write(packet, 0, _size)
session.bytesSentThisSecond += 3 + _size
session.UserBytesToBeSentAvailable = False
notify = True
End If
Catch ex As Exception
' Report error attempting to send user data.
Debug.WriteLine("Unexpected error in TcpCommServer\HandleOutgoingUserData: " & ex.Message)
End Try
' Notify the user that the packet has been sent.
If notify Then SystemMessage("UBS:" & session.sessionID & ":" & session.UserOutputChannel)
' This will drop execution out of the communications loop for this session, and
' begin this session's shutdown process.
If shutSessionDown then
'SystemMessage("Session Stopped. (" & session.sessionID.ToString & ")")
'SessionCollection.CloseSession(session.sessionID)
Throw New Exception("Shutting session down gracefully.")
End If
Return True
Else
Return False
End If
End Function
Private Function GetSome(ByRef bytes() As Byte, ByVal chunkToBreakOff As Integer, _
ByRef bytesToBeSentAvailable As Boolean, ByVal session As SessionCommunications, _
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:" & session.sessionID & ":" & session.UserOutputChannel)
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)
Dim bgMsg As New Thread(AddressOf BgMessage)
bgMsg.IsBackground = True
bgMsg.Start(MsgText)
End Sub
Private Sub BgMessage(ByVal _text As Object)
Dim msg As String = CType(_text, String)
RcvBytes(Utilities.StrToByteArray(msg), Nothing, 255)
End Sub
'Private Sub SystemMessage(ByVal MsgText As String, ByRef session As SessionCommunications)
' RcvBytes(Utilities.StrToByteArray(MsgText), session, 255)
'End Sub
' Check to see if our app is closing (set in FormClosing event)
Private Function theServerIsStopping(ByVal Server As TcpClient, ByVal session As SessionCommunications) As Boolean
If Not continue_running Or session.disConnect Then
theServerIsStopping = True
Else
theServerIsStopping = False
End If
End Function
Private Sub theListener()
Try
' Start listening
SystemMessage("Listening...")
Listener = New TcpListener(localAddr, Port)
Listener.Start()
StartAccept()
Catch ex As Exception
errMsg = ex.Message
serverState = currentState.err
Exit Sub
End Try
serverState = currentState.running
End Sub
Private Function StartAccept() As Boolean
' Manage the rate at which
' we accept new connections.
Thread.Sleep(10)
Try
Listener.BeginAcceptTcpClient(AddressOf HandleAsyncConnection, Listener)
Return True
Catch ex As Exception
Return False
End Try
End Function
Private Sub HandleAsyncConnection(ByVal res As IAsyncResult)
If Not StartAccept() Then Exit Sub
Try
SessionCollection.AddSession(Listener.EndAcceptTcpClient(res), New Thread(AddressOf Run), enforceUniqueMachineIds)
GC.GetTotalMemory(True)
Catch ex As Exception
End Try
End Sub
Private Sub WrapUpIncomingFile(ByVal session As SessionCommunications)
If session.ReceivingFile Then
Try
session.fileWriter.Close()
session.fileWriter = Nothing
GC.GetTotalMemory(True)
Catch ex As Exception
End Try
Try
File.Delete(session.ReceivedFilesFolder & "\" & session.IncomingFileName)
Catch ex As Exception
End Try
End If
End Sub
Private Sub Run(ByVal _session As Object)
Dim session As SessionCommunications = DirectCast(_session, SessionCommunications)
session.sendQueue = New ConcurrentQueue(Of message)
session.messageIn = New SessionCommunications.MessageInQueue(ServerCallbackObject)
Dim Server As TcpClient
Dim Stream As NetworkStream
Dim IpEndPoint As IPEndPoint
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 idleTimer, bandwidthTimer As Date
Dim bytesread As Integer = 0
Dim weHaveThePuck As Boolean = True
Dim bandwidthUsedThisSecond As Int32 = 0
Dim userOrSystemSwitcher As Integer = 0
Dim packetReceiveTimeout As Date
session.disConnect = False
Try
' Create a local Server and Stream objects for clarity.
Server = session.theClient
Stream = Server.GetStream()
Catch ex As Exception
' An unexpected error.
Debug.WriteLine("Could not create local Server or Stream object in server. Message: " & ex.Message)
Exit Sub
End Try
Stream.ReadTimeout = 5000
Try
' Get the remote machine's IP address.
IpEndPoint = CType(Server.Client.RemoteEndPoint, Net.IPEndPoint)
session.remoteIpAddress = IpEndPoint.Address
' Set the send and receive buffers to the maximum
' size allowable in this application...
Server.Client.ReceiveBufferSize = 65535
Server.Client.SendBufferSize = 65535
' no delay on partially filled packets...
' Send it all as fast as possible.
Server.NoDelay = True
' Set the timers...
idleTimer = Now
'bandwidthTimer = Now
bandwidthTimer = Now.AddMilliseconds(250)
session.IsRunning = True
SystemMessage("Connected.")
' Start the communication loop
Do
' Throttle network Mbps...
bandwidthUsedThisSecond = session.bytesSentThisSecond + session.bytesRecievedThisSecond
If bandwidthTimer >= Now And bandwidthUsedThisSecond >= (Mbps / 4) Then
While bandwidthTimer > Now
Thread.Sleep(1)
End While
End If
If bandwidthTimer <= Now Then
bandwidthTimer = Now.AddMilliseconds(250)
session.bytesRecievedThisSecond = 0
session.bytesSentThisSecond = 0
bandwidthUsedThisSecond = 0
End If
' Normal communications...
If weHaveThePuck Then
' Send data if there is any to be sent...
userOrSystemSwitcher += 1
Select Case userOrSystemSwitcher
Case 1
If Not session.paused Then
If HandleOutgoingUserData(Stream, session) Then idleTimer = Now
End If
Case 2
If HandleOutgoingInternalSystemMessage(Stream, session) Then idleTimer = Now
End Select
If userOrSystemSwitcher > 1 Then userOrSystemSwitcher = 0
' After sending out data, send the puck
Stream.Write(puck, 0, 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)
' If it's just the puck (communictaion syncronization byte),
' set weHaveThePuck true, record the byte read for throttling,
' and that's all. dataChannel 0 is reserved for the puck.
If dataChannel = 0 Then
weHaveThePuck = True
session.bytesRecievedThisSecond += 1
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)
session.bytesRecievedThisSecond += 2
' Get the packet:
If theBuffer.Length <> packetSize Then ReDim theBuffer(packetSize - 1)
packetReceiveTimeout = Now.AddSeconds(3)
Do
' Read bytes in...
bytesread += Stream.Read(theBuffer, bytesread, (packetSize - bytesread))
' We've been waiting for moew data for 3 seconds... we've lost connection.
If packetReceiveTimeout < Now Then Throw New Exception("Timeout waiting for data from client. Connection lost.")
Loop While bytesread < packetSize
bytesread = 0
' Record bytes read for throttling...
session.bytesRecievedThisSecond += packetSize
' Handle the packet...
If dataChannel > 250 Then
' this is an internal system packet
If Not theServerIsStopping(Server, session) Then HandleIncomingSystemMessages(theBuffer, dataChannel, session)
Else
' Hand user data off to the calling thread.
If Not theServerIsStopping(Server, session) Then RcvBytes(theBuffer, session, dataChannel)
End If
idleTimer = Now
End If
' Throttle CPU usage when idle.
If Now > idleTimer.AddMilliseconds(500) Then
Thread.Sleep(50)
End If
Loop
Catch ex As Exception
' An unexpected error.
If ex IsNot Nothing Then Debug.WriteLine("Unexpected error in server: " & ex.Message)
End Try
session.machineIdValidated = False
session.machineId = ""
Try
If session.fileReader IsNot Nothing Then session.fileReader.Close()
Catch ex As Exception
End Try
Try
Server.Client.Blocking = False
Server.Client.Close()
Catch ex As Exception
End Try
' If we're in the middle of receiving a file,
' close the filestream, release the memory and
' delete the partial file.
WrapUpIncomingFile(session)
If session.disConnect = False Then
SystemMessage("Session Stopped. (" & session.sessionID.ToString & ")")
SessionCollection.CloseSession(session)
End If
session.messageIn.Close()
End Sub
End Class