tcpCommServer.vb 39 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045
  1. Imports System
  2. Imports System.Threading
  3. Imports System.Net
  4. Imports System.Net.Sockets
  5. Imports System.IO
  6. Imports System.Reflection
  7. Imports System.Runtime.InteropServices
  8. Public Class TcpCommServer
  9. Public errMsg As String
  10. ' Define the callback delegate type
  11. Public Delegate Sub ServerCallbackDelegate(ByVal bytes() As Byte, ByVal sessionID As Int32, ByVal dataChannel As Integer)
  12. ' Create Delegate object
  13. Public ServerCallbackObject As ServerCallbackDelegate
  14. Private Listener As TcpListener
  15. Private continue_running As Boolean = False
  16. Private blockSize As UInt16
  17. Private Port As Integer
  18. Private localAddr As IPAddress
  19. Private Mbps As UInt32
  20. Public IsRunning As Boolean = False
  21. Public SessionCollection As New ArrayList
  22. Private Class SessionCommunications
  23. Public UserBytesToBeSentAvailable As Boolean = False
  24. Public UserBytesToBeSent As New MemoryStream
  25. Public UserOutputChannel As Byte
  26. Public SystemBytesToBeSentAvailable As Boolean = False
  27. Public SystemBytesToBeSent() As Byte
  28. Public SystemOutputChannel As Byte
  29. Public theClient As TcpClient
  30. Public IsRunning As Boolean = False
  31. Public remoteIpAddress As System.Net.IPAddress
  32. Public bytesRecieved() As Byte
  33. Public sessionID As Int32
  34. Public disConnect As Boolean = False
  35. Public bytesSentThisSecond As Int32 = 0
  36. Public bytesRecievedThisSecond As Int32 = 0
  37. Public fileBytesRecieved As Int64 = 0
  38. Public filebytesSent As Int64 = 0
  39. Public SendingFile As Boolean = False
  40. Public FileBeingSentPath As String
  41. Public IncomingFileSize As Int64
  42. Public IncomingFileName As String
  43. Public ReceivingFile As Boolean = False
  44. Public sendPacketSize As Boolean = False
  45. Public fileReader As FileStream
  46. Public fileWriter As clsAsyncUnbuffWriter
  47. Public ReceivedFilesFolder As String = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\ServerReceivedFiles"
  48. Public userName As String
  49. Public password As String
  50. Public Sub New(ByVal _theClient As TcpClient, ByVal _sessionID As Int32)
  51. theClient = _theClient
  52. sessionID = _sessionID
  53. End Sub
  54. Public Sub Close()
  55. disConnect = True
  56. Try
  57. theClient.Client.Blocking = False
  58. theClient.Client.Close()
  59. Catch ex As Exception
  60. IsRunning = False
  61. End Try
  62. End Sub
  63. End Class
  64. Private Function StrToByteArray(ByVal text As String) As Byte()
  65. Dim encoding As New System.Text.UTF8Encoding()
  66. StrToByteArray = encoding.GetBytes(text)
  67. End Function
  68. Private Function BytesToString(ByVal data() As Byte) As String
  69. Dim enc As New System.Text.UTF8Encoding()
  70. BytesToString = enc.GetString(data)
  71. End Function
  72. ' CallbackForm must implement an UpdateUI Sub.
  73. Public Sub New(ByVal callbackMethod As ServerCallbackDelegate, Optional ByVal _throttledBytesPerSecond As UInt32 = 9000000)
  74. Mbps = _throttledBytesPerSecond
  75. ' BlockSize should be 62500 or 63100, depending on requested speed.
  76. ' Excellent performance, and works great with throttling.
  77. Dim _blockSize As UInt16
  78. ' Get corrected blocksize for throttling.
  79. If Mbps < 300000 Then
  80. If Mbps > 16000 Then
  81. blockSize = 4000
  82. Else
  83. blockSize = CUShort((Mbps / 4))
  84. End If
  85. ElseIf Mbps > 300000 And Mbps < 500000 Then
  86. blockSize = 16000
  87. ElseIf Mbps > 500000 And Mbps < 1000000 Then
  88. blockSize = 32000
  89. Else
  90. Dim count As UInt32 = 0
  91. Dim aFourth As Decimal = 0
  92. If Mbps > 25000000 Then
  93. _blockSize = 63100
  94. Else
  95. _blockSize = 62500
  96. End If
  97. aFourth = CDec(Mbps / 4)
  98. Do
  99. count += _blockSize
  100. If (count + _blockSize) > aFourth Then
  101. Mbps = CUInt(count * 4)
  102. blockSize = _blockSize
  103. Exit Do
  104. End If
  105. Loop
  106. End If
  107. ' Initialize the delegate object to point to the user's callback method.
  108. ServerCallbackObject = callbackMethod
  109. End Sub
  110. Public Sub ThrottleNetworkBps(ByVal bytesPerSecond As UInteger)
  111. ' Default value is 9000000 Mbps. Ok throughput, and
  112. ' good performance for the server (low CPU usage).
  113. Mbps = bytesPerSecond
  114. End Sub
  115. Public Sub Start(ByVal prt As Integer)
  116. Port = prt
  117. localAddr = GetLocalIpAddress()
  118. continue_running = True
  119. IsRunning = True
  120. Dim listenerThread As New Thread(AddressOf theListener)
  121. listenerThread.Name = "Server Listener Thread"
  122. listenerThread.Start()
  123. End Sub
  124. Public Sub StopRunning()
  125. Dim theresSillOneRunning As Boolean = True
  126. continue_running = False
  127. While theresSillOneRunning
  128. Try
  129. For Each item As SessionCommunications In SessionCollection
  130. item.Close()
  131. Next
  132. Catch ex As Exception
  133. End Try
  134. Try
  135. For Each item As SessionCommunications In SessionCollection
  136. If item.IsRunning Then Exit Try
  137. Next
  138. theresSillOneRunning = False
  139. Catch ex As Exception
  140. End Try
  141. End While
  142. Try
  143. Listener.Stop()
  144. Catch ex As Exception
  145. End Try
  146. IsRunning = False
  147. End Sub
  148. Private Function GetLocalIpAddress() As System.Net.IPAddress
  149. Dim strHostName As String
  150. Dim addresses() As System.Net.IPAddress
  151. strHostName = System.Net.Dns.GetHostName()
  152. addresses = System.Net.Dns.GetHostAddresses(strHostName)
  153. ' Find an IpV4 address
  154. For Each address As System.Net.IPAddress In addresses
  155. If address.ToString.Contains(".") then
  156. Return address
  157. End If
  158. Next
  159. ' No IpV4 address? Return the loopback address.
  160. Return System.Net.IPAddress.Loopback
  161. End Function
  162. Public Function GetBlocksize() As UInt16
  163. Return blockSize
  164. End Function
  165. Public Function GetFile(ByVal _path As String, ByVal sessionID As Int32) As Boolean
  166. Dim foundSession As Boolean = False
  167. GetFile = True
  168. ' Find the session we want to talk to and send it a Get File Request
  169. For Each session As SessionCommunications In SessionCollection
  170. If session.sessionID = sessionID Then
  171. ' we found it.
  172. foundSession = True
  173. Do
  174. If Not session.UserBytesToBeSentAvailable Then
  175. SyncLock session.UserBytesToBeSent
  176. session.UserBytesToBeSent.Close()
  177. session.UserBytesToBeSent = Nothing
  178. session.UserBytesToBeSent = New MemoryStream(StrToByteArray("GFR:" & _path))
  179. session.UserOutputChannel = 254 ' Text messages / commands on channel 254
  180. session.UserBytesToBeSentAvailable = True
  181. End SyncLock
  182. Exit Do
  183. End If
  184. If Not session.IsRunning Then Exit Do
  185. Application.DoEvents()
  186. Loop
  187. End If
  188. Next
  189. If Not foundSession Then Return False
  190. End Function
  191. Public Function SendFile(ByVal _path As String, ByVal sessionID As Int32) As Boolean
  192. Dim foundSession As Boolean = False
  193. SendFile = True
  194. ' Find the session we want to talk to and send it a Send File Request
  195. For Each session As SessionCommunications In SessionCollection
  196. If session.sessionID = sessionID Then
  197. ' we found it.
  198. foundSession = True
  199. Do
  200. If Not session.UserBytesToBeSentAvailable Then
  201. SyncLock session.UserBytesToBeSent
  202. session.UserBytesToBeSent.Close()
  203. session.UserBytesToBeSent = Nothing
  204. session.UserBytesToBeSent = New MemoryStream(StrToByteArray("SFR:" & _path))
  205. session.UserOutputChannel = 254 ' Text messages / commands on channel 254
  206. session.UserBytesToBeSentAvailable = True
  207. End SyncLock
  208. Exit Do
  209. End If
  210. If Not session.IsRunning Then Exit Do
  211. Application.DoEvents()
  212. Loop
  213. End If
  214. Next
  215. If Not foundSession Then Return False
  216. End Function
  217. Public Function SendBytes(ByVal bytes() As Byte, Optional ByVal channel As Byte = 1, Optional ByVal sessionID As Int32 = -1) As Boolean
  218. Dim foundSession As Boolean = False
  219. SendBytes = True
  220. If channel = 0 Or channel > 250 Then
  221. MsgBox("Data can not be sent using channel numbers less then 1 or greater then 250.", MsgBoxStyle.Critical, "TCP_Server")
  222. Exit Function
  223. End If
  224. If sessionID > -1 Then
  225. ' Find the session we want to talk to and send it the message
  226. For Each session As SessionCommunications In SessionCollection
  227. If session.sessionID = sessionID Then
  228. ' we found it.
  229. foundSession = True
  230. Do
  231. If Not session.UserBytesToBeSentAvailable Then
  232. SyncLock session.UserBytesToBeSent
  233. session.UserBytesToBeSent.Close()
  234. session.UserBytesToBeSent = Nothing
  235. session.UserBytesToBeSent = New MemoryStream(bytes)
  236. session.UserOutputChannel = channel
  237. session.UserBytesToBeSentAvailable = True
  238. End SyncLock
  239. Exit Do
  240. End If
  241. If Not session.IsRunning Then Exit Do
  242. Application.DoEvents()
  243. Loop
  244. End If
  245. Next
  246. If Not foundSession Then Return False
  247. ElseIf sessionID = -1 Then
  248. ' Send our message to everyone connected
  249. For Each session As SessionCommunications In SessionCollection
  250. If session.IsRunning Then
  251. Do
  252. If Not session.UserBytesToBeSentAvailable Then
  253. SyncLock session.UserBytesToBeSent
  254. session.UserBytesToBeSent.Close()
  255. session.UserBytesToBeSent = Nothing
  256. session.UserBytesToBeSent = New MemoryStream(bytes)
  257. session.UserOutputChannel = channel
  258. session.UserBytesToBeSentAvailable = True
  259. End SyncLock
  260. Exit Do
  261. End If
  262. If Not session.IsRunning Then Exit Do
  263. Application.DoEvents()
  264. Loop
  265. End If
  266. Next
  267. Else
  268. Return False
  269. End If
  270. End Function
  271. Private Function RcvBytes(ByVal data() As Byte, ByVal sessionID As Int32, Optional ByVal dataChannel As Integer = 1) As Boolean
  272. ' dataType: >0 = data channel, > 250 = internal messages. 0 is an invalid channel number (it's the puck)
  273. If dataChannel < 1 Then
  274. RcvBytes = False
  275. Exit Function
  276. End If
  277. Try
  278. ' Check to see if our app is closing
  279. If Not continue_running Then Exit Function
  280. ServerCallbackObject(data, sessionID, dataChannel)
  281. Catch ex As Exception
  282. RcvBytes = False
  283. ' An unexpected error.
  284. Debug.WriteLine("Unexpected error in server\RcvBytes: " & ex.Message)
  285. End Try
  286. End Function
  287. Private Function SendExternalSystemMessage(ByVal message As String, ByVal session As SessionCommunications) As Boolean
  288. session.SystemBytesToBeSent = StrToByteArray(message)
  289. session.SystemOutputChannel = 254 ' Text messages / commands on channel 254
  290. session.SystemBytesToBeSentAvailable = True
  291. End Function
  292. Private Function CheckSessionPermissions(ByVal session As SessionCommunications, ByVal cmd As String) As Boolean
  293. ' Your security code here...
  294. Return True
  295. End Function
  296. Private Function BeginFileSend(ByVal _path As String, ByVal session As SessionCommunications, ByVal fileLength As Long) As Boolean
  297. Try
  298. session.fileReader = New FileStream(_path, FileMode.Open, FileAccess.Read, FileShare.None, clsAsyncUnbuffWriter.GetPageSize)
  299. session.SendingFile = True
  300. BeginFileSend = True
  301. Catch ex As Exception
  302. BeginFileSend = False
  303. _path = ex.Message
  304. session.SendingFile = False
  305. End Try
  306. Try
  307. If Not BeginFileSend Then session.fileReader.Close()
  308. Catch ex As Exception
  309. End Try
  310. End Function
  311. Private Sub GetMoreFileBytesIfAvailable(ByVal session As SessionCommunications)
  312. Dim bytesRead As Int32 = 0
  313. If session.SendingFile And Not session.SystemBytesToBeSentAvailable Then
  314. Try
  315. If session.SystemBytesToBeSent.Length <> blockSize Then ReDim session.SystemBytesToBeSent(blockSize - 1)
  316. bytesRead = session.fileReader.Read(session.SystemBytesToBeSent, 0, blockSize)
  317. If bytesRead <> blockSize Then ReDim Preserve session.SystemBytesToBeSent(bytesRead - 1)
  318. If bytesRead > 0 Then
  319. session.SystemOutputChannel = 253 ' File transfer from server to client
  320. session.SystemBytesToBeSentAvailable = True
  321. Else
  322. ReDim session.SystemBytesToBeSent(blockSize - 1)
  323. SendExternalSystemMessage("->Done", session) ' Send the client a completion notice.
  324. session.SendingFile = False
  325. ' Clean up
  326. session.fileReader.Close()
  327. session.fileReader = Nothing
  328. GC.GetTotalMemory(True)
  329. End If
  330. Catch ex As Exception
  331. SendExternalSystemMessage("ERR: " & ex.Message, session)
  332. ' We're finished.
  333. ReDim session.SystemBytesToBeSent(blockSize - 1)
  334. session.SendingFile = False
  335. session.fileReader.Close()
  336. End Try
  337. End If
  338. End Sub
  339. Private Function GetFilenameFromPath(ByRef filePath As String) As String
  340. Dim filePathParts() As String
  341. If filePath.Trim = "" Then Return ""
  342. Try
  343. filePathParts = Split(filePath, "\")
  344. GetFilenameFromPath = filePathParts(filePathParts.Length - 1)
  345. Catch ex As Exception
  346. filePath = ex.Message
  347. Return ""
  348. End Try
  349. End Function
  350. Private Function CreateFolders(ByVal _path As String) As Boolean
  351. CreateFolders = True
  352. Dim parts() As String
  353. Dim path As String = ""
  354. Dim count As Int32
  355. parts = Split(_path, "\")
  356. path = parts(0)
  357. For count = 1 To parts.Length - 2
  358. path += "\" & parts(count)
  359. Try
  360. If Not Directory.Exists(path) Then
  361. Directory.CreateDirectory(path)
  362. End If
  363. Catch ex As Exception
  364. End Try
  365. Next
  366. End Function
  367. Private Function BeginToReceiveAFile(ByVal _path As String, ByVal session As SessionCommunications) As Boolean
  368. Dim readBuffer As Int32 = 0
  369. session.ReceivingFile = True
  370. BeginToReceiveAFile = True
  371. session.fileBytesRecieved = 0
  372. Try
  373. CreateFolders(_path) ' Just a 256k write buffer for the server. Let's try to avoid memory problems...
  374. session.fileWriter = New clsAsyncUnbuffWriter(_path, True, 1024 * 256, session.IncomingFileSize)
  375. Catch ex As Exception
  376. _path = ex.Message
  377. session.ReceivingFile = False
  378. End Try
  379. If Not session.ReceivingFile Then
  380. Try
  381. session.fileWriter.Close()
  382. Catch ex As Exception
  383. End Try
  384. Return False
  385. End If
  386. End Function
  387. Private Function HandleIncomingFileBytes(ByRef bytes() As Byte, ByVal session As SessionCommunications) As Boolean
  388. Try
  389. session.fileWriter.Write(bytes, bytes.Length)
  390. HandleIncomingFileBytes = True
  391. Catch ex As Exception
  392. HandleIncomingFileBytes = False
  393. End Try
  394. End Function
  395. Private Sub FinishReceivingTheFile(ByVal session As SessionCommunications)
  396. Try
  397. session.fileWriter.Close()
  398. session.fileWriter = Nothing
  399. session.ReceivingFile = False
  400. Catch ex As Exception
  401. session.ReceivingFile = False
  402. End Try
  403. End Sub
  404. Private Sub HandleIncomingSystemMessages(ByVal bytes() As Byte, ByVal channel As Int32, ByVal session As SessionCommunications)
  405. If channel = 254 Then ' Text commands / messages passed between server and client
  406. Dim message As String = BytesToString(bytes)
  407. Dim filePath As String
  408. Dim tmp As String = ""
  409. ' Get File Request: The client wants us to send them a file.
  410. If message.Length > 4 Then tmp = message.Substring(0, 4)
  411. If tmp = "GFR:" Then
  412. ' Get file path...
  413. filePath = message.Substring(4, message.Length - 4)
  414. ' Does it exist?
  415. If File.Exists(filePath) Then
  416. ' Do they have permission to get this file?
  417. If CheckSessionPermissions(session, "GFR") Then
  418. ' Are we already busy sending them a file?
  419. If Not session.SendingFile Then
  420. Dim _theFilesInfo As New FileInfo(filePath)
  421. If BeginFileSend(filePath, session, _theFilesInfo.Length) Then
  422. ' Send only the file NAME. It will have a different path on the other side.
  423. SendExternalSystemMessage("Sending:" & GetFilenameFromPath(filePath) & _
  424. ":" & _theFilesInfo.Length, session)
  425. Else
  426. ' FilePath contains the error message.
  427. SendExternalSystemMessage("ERR: " & filePath, session)
  428. End If
  429. Else
  430. ' There's already a GFR in progress.
  431. SendExternalSystemMessage("ERR: File: ''" & _
  432. session.FileBeingSentPath & _
  433. "'' is still in progress. Only one file " & _
  434. "may be transfered (from server to client) at a time.", session)
  435. End If
  436. Else
  437. ' This user doesn't have rights to "get" this file. Send an error.
  438. SendExternalSystemMessage("ERR: You do not have permission to receive files. Access Denied.", session)
  439. End If
  440. Else
  441. ' File doesn't exist. Send an error.
  442. SendExternalSystemMessage("ERR: The requested file can not be found by the server.", session)
  443. End If
  444. End If
  445. ' We're being informed that we will be receiving a file:
  446. If message.Length > 7 Then tmp = message.Substring(0, 8)
  447. If tmp = "Sending:" Then
  448. ' Strip away the headder...
  449. Dim msgParts() As String = Split(message, ":")
  450. session.IncomingFileSize = Convert.ToInt64(msgParts(2))
  451. session.IncomingFileName = msgParts(1)
  452. tmp = session.ReceivedFilesFolder & "\" & session.IncomingFileName
  453. SystemMessage("Receiving file: " & session.IncomingFileName)
  454. If Not BeginToReceiveAFile(tmp, session) Then
  455. SystemMessage("ERR: " & tmp)
  456. SendExternalSystemMessage("Abort->", session)
  457. End If
  458. End If
  459. If message = "<-Done" Then
  460. FinishReceivingTheFile(session)
  461. SystemMessage("<-Done")
  462. End If
  463. ' We've been notified that no file data will be forthcoming.
  464. If message = "Abort<-" Then
  465. WrapUpIncomingFile(session)
  466. SystemMessage("<-Aborted.")
  467. SendExternalSystemMessage("<-Aborted.", session)
  468. End If
  469. ' Send File Request: The client wants to send us a file.
  470. If message.Length > 4 Then tmp = message.Substring(0, 4)
  471. If tmp = "SFR:" Then
  472. If CheckSessionPermissions(session, "SFR") Then
  473. Dim parts() As String
  474. parts = Split(message, "SFR:")
  475. SendExternalSystemMessage("GFR:" & parts(1), session)
  476. Else
  477. ' This user doesn't have rights to send us a file. Send an error.
  478. SendExternalSystemMessage("ERR: You do not have permission to send files. Access Denied.", session)
  479. End If
  480. End If
  481. If message.Length > 4 Then tmp = message.Substring(0, 4)
  482. If tmp = "GDR:" Then ' Get Directory Request
  483. ' Send each file in the directory and all subdirectories.
  484. ' To be implemented in the future.
  485. End If
  486. If message.Length > 4 Then tmp = message.Substring(0, 4)
  487. If tmp = "ERR:" Then ' The client has sent us an error message.
  488. ' Pass it on up to the user.
  489. SystemMessage(message)
  490. End If
  491. If message = "Abort->" Then
  492. Try
  493. session.SendingFile = False
  494. ReDim session.SystemBytesToBeSent(blockSize - 1)
  495. SendExternalSystemMessage("->Aborted.", session)
  496. SystemMessage("->Aborted.")
  497. session.fileReader.Close()
  498. Catch ex As Exception
  499. End Try
  500. End If
  501. ElseIf channel = 253 Then ' File transfer from server to client
  502. ElseIf channel = 252 Then ' File transfer from client to server
  503. Try
  504. If session.ReceivingFile Then
  505. HandleIncomingFileBytes(bytes, session)
  506. session.fileBytesRecieved += bytes.Length
  507. End If
  508. Catch ex As Exception
  509. End Try
  510. ElseIf channel = 251 Then ' reserved.
  511. End If
  512. End Sub
  513. Private Function HandleOutgoingInternalSystemMessage(ByVal Stream As NetworkStream, _
  514. ByVal session As SessionCommunications) As Boolean
  515. Dim tmp(1) As Byte
  516. Dim _size As UShort
  517. 'Static OurTurn As Boolean = False
  518. HandleOutgoingInternalSystemMessage = False
  519. ' Create a one time outgoing system message to syncronize packet size.
  520. If Not session.sendPacketSize Then
  521. SendExternalSystemMessage("blocksize:" & blockSize.ToString, session)
  522. session.sendPacketSize = True
  523. End If
  524. GetMoreFileBytesIfAvailable(session)
  525. ' Handle outgoing system stuff here
  526. If session.SystemBytesToBeSentAvailable = True Then
  527. HandleOutgoingInternalSystemMessage = True
  528. If session.SystemBytesToBeSent.Length > blockSize Then
  529. ' Send Channel
  530. tmp(0) = session.SystemOutputChannel
  531. Stream.Write(tmp, 0, 1)
  532. ' Send packet size
  533. _size = blockSize
  534. tmp = BitConverter.GetBytes(_size)
  535. Stream.Write(tmp, 0, 2)
  536. ' Send packet
  537. Stream.Write(GetSome(session.SystemBytesToBeSent, blockSize, session.SystemBytesToBeSentAvailable, session), 0, _size)
  538. session.bytesSentThisSecond += 3 + blockSize
  539. Else
  540. ' Send Channel
  541. tmp(0) = session.SystemOutputChannel
  542. Stream.Write(tmp, 0, 1)
  543. ' Send packet size
  544. _size = convert.ToUInt16(session.SystemBytesToBeSent.Length)
  545. tmp = BitConverter.GetBytes(_size)
  546. Stream.Write(tmp, 0, 2)
  547. ' Send packet
  548. Stream.Write(session.SystemBytesToBeSent, 0, _size)
  549. session.bytesSentThisSecond += 3 + _size
  550. session.SystemBytesToBeSentAvailable = False
  551. End If
  552. End If
  553. End Function
  554. Private Function HandleOutgoingUserData(ByVal Stream As NetworkStream, ByVal session As SessionCommunications) As Boolean
  555. Dim tmp(1) As Byte
  556. Dim _size As UShort
  557. Dim notify As Boolean = False
  558. Static packet(0) As Byte
  559. If session.UserBytesToBeSentAvailable = True Then
  560. SyncLock session.UserBytesToBeSent
  561. Try
  562. If (session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position) > blockSize Then
  563. ' Send Channel
  564. tmp(0) = session.UserOutputChannel
  565. Stream.Write(tmp, 0, 1)
  566. ' Send packet size
  567. _size = blockSize
  568. tmp = BitConverter.GetBytes(_size)
  569. Stream.Write(tmp, 0, 2)
  570. ' Send packet
  571. If packet.Length <> _size Then ReDim packet(_size - 1)
  572. session.UserBytesToBeSent.Read(packet, 0, _size)
  573. 'session.theClient.NoDelay = True
  574. Stream.Write(packet, 0, _size)
  575. session.bytesSentThisSecond += 3 + _size
  576. ' Check to see if we've sent it all...
  577. If session.UserBytesToBeSent.Length = session.UserBytesToBeSent.Position Then
  578. session.UserBytesToBeSentAvailable = False
  579. notify = True
  580. End If
  581. Else
  582. ' Send Channel
  583. tmp(0) = session.UserOutputChannel
  584. Stream.Write(tmp, 0, 1)
  585. ' Send packet size
  586. _size = Convert.ToUInt16(session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position)
  587. tmp = BitConverter.GetBytes(_size)
  588. Stream.Write(tmp, 0, 2)
  589. ' Send packet
  590. If packet.Length <> _size Then ReDim packet(_size - 1)
  591. session.UserBytesToBeSent.Read(packet, 0, _size)
  592. 'session.theClient.NoDelay = True
  593. Stream.Write(packet, 0, _size)
  594. session.bytesSentThisSecond += 3 + _size
  595. session.UserBytesToBeSentAvailable = False
  596. notify = True
  597. End If
  598. Catch ex As Exception
  599. ' Report error attempting to send user data.
  600. Debug.WriteLine("Unexpected error in TcpCommServer\HandleOutgoingUserData: " & ex.Message)
  601. End Try
  602. End SyncLock
  603. ' Notify the user that the packet has been sent.
  604. If notify Then SystemMessage("UBS:" & session.sessionID & ":" & session.UserOutputChannel)
  605. Return True
  606. Else
  607. Return False
  608. End If
  609. 'If session.UserBytesToBeSentAvailable = True Then
  610. ' If (session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position) > blockSize Then
  611. ' ' Send Channel
  612. ' tmp(0) = session.UserOutputChannel
  613. ' Stream.Write(tmp, 0, 1)
  614. ' ' Send packet size
  615. ' _size = blockSize
  616. ' tmp = BitConverter.GetBytes(_size)
  617. ' Stream.Write(tmp, 0, 2)
  618. ' ' Send packet
  619. ' If packet.Length <> _size Then ReDim packet(_size - 1)
  620. ' session.UserBytesToBeSent.Read(packet, 0, _size)
  621. ' Stream.Write(packet, 0, _size)
  622. ' session.bytesSentThisSecond += 3 + _size
  623. ' ' Check to see if we've sent it all...
  624. ' If session.UserBytesToBeSent.Length = session.UserBytesToBeSent.Position Then
  625. ' session.UserBytesToBeSentAvailable = False
  626. ' SystemMessage("UBS:" & session.sessionID & ":" & session.UserOutputChannel)
  627. ' End If
  628. ' Else
  629. ' ' Send Channel
  630. ' tmp(0) = session.UserOutputChannel
  631. ' Stream.Write(tmp, 0, 1)
  632. ' ' Send packet size
  633. ' _size = (session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position)
  634. ' tmp = BitConverter.GetBytes(_size)
  635. ' Stream.Write(tmp, 0, 2)
  636. ' ' Send packet
  637. ' If packet.Length <> _size Then ReDim packet(_size - 1)
  638. ' session.UserBytesToBeSent.Read(packet, 0, _size)
  639. ' Stream.Write(packet, 0, _size)
  640. ' session.bytesSentThisSecond += 3 + _size
  641. ' session.UserBytesToBeSentAvailable = False
  642. ' SystemMessage("UBS:" & session.sessionID & ":" & session.UserOutputChannel)
  643. ' End If
  644. ' Return True
  645. 'Else
  646. ' Return False
  647. 'End If
  648. End Function
  649. Private Function GetSome(ByRef bytes() As Byte, ByVal chunkToBreakOff As Integer, _
  650. ByRef bytesToBeSentAvailable As Boolean, ByVal session As SessionCommunications, _
  651. Optional ByVal theseAreUserBytes As Boolean = False) As Byte()
  652. Dim tmp(chunkToBreakOff - 1) As Byte
  653. Array.Copy(bytes, 0, tmp, 0, chunkToBreakOff)
  654. GetSome = tmp
  655. If bytes.Length = chunkToBreakOff Then
  656. bytesToBeSentAvailable = False
  657. If theseAreUserBytes Then SystemMessage("UBS:" & session.sessionID & ":" & session.UserOutputChannel)
  658. Else
  659. Dim tmp2(bytes.Length - chunkToBreakOff - 1) As Byte
  660. Array.Copy(bytes, chunkToBreakOff, tmp2, 0, bytes.Length - chunkToBreakOff)
  661. bytes = tmp2
  662. End If
  663. End Function
  664. Private Sub SystemMessage(ByVal MsgText As String)
  665. RcvBytes(StrToByteArray(MsgText), -1, 255)
  666. End Sub
  667. ' Check to see if our app is closing (set in FormClosing event)
  668. Private Function theServerIsStopping(ByVal Server As TcpClient, ByVal session As SessionCommunications) As Boolean
  669. Try
  670. If Not continue_running Or session.disConnect Then
  671. theServerIsStopping = True
  672. Else
  673. theServerIsStopping = False
  674. End If
  675. Catch ex As Exception
  676. ' An unexpected error.
  677. Debug.WriteLine("Unexpected error in server\theServerIsStopping: " & ex.Message)
  678. End Try
  679. End Function
  680. Private Sub theListener()
  681. ' Start listening
  682. SystemMessage("Listening...")
  683. Listener = New TcpListener(localAddr, Port)
  684. Listener.Start()
  685. StartAccept()
  686. End Sub
  687. Private Function StartAccept() As Boolean
  688. Try
  689. Listener.BeginAcceptTcpClient(AddressOf HandleAsyncConnection, Listener)
  690. Return True
  691. Catch ex As Exception
  692. Return False
  693. End Try
  694. End Function
  695. Private Sub HandleAsyncConnection(ByVal res As IAsyncResult)
  696. Static conID As Int32 = 0
  697. If Not StartAccept() Then Exit Sub
  698. conID += 1
  699. If conID > 2000000000 Then conID = 1 ' 2 billion connections before the ID cycles
  700. Dim client As TcpClient = Listener.EndAcceptTcpClient(res)
  701. SessionCollection.Insert(0, New SessionCommunications(client, conID))
  702. SystemMessage("Connected.")
  703. 'ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Run), SessionCollection.Item(0))
  704. Dim newSession As New Thread(AddressOf Run)
  705. newSession.IsBackground = True
  706. newSession.Name = "Server Session #" & conID
  707. newSession.Start(SessionCollection.Item(0))
  708. End Sub
  709. Private Sub WrapUpIncomingFile(ByVal session As SessionCommunications)
  710. If session.ReceivingFile Then
  711. Try
  712. session.fileWriter.Close()
  713. session.fileWriter = Nothing
  714. GC.GetTotalMemory(True)
  715. Catch ex As Exception
  716. End Try
  717. Try
  718. File.Delete(session.ReceivedFilesFolder & "\" & session.IncomingFileName)
  719. Catch ex As Exception
  720. End Try
  721. End If
  722. End Sub
  723. Private Sub Run(ByVal _session As Object)
  724. Dim session As SessionCommunications = DirectCast(_session, SessionCommunications)
  725. Dim Server As TcpClient
  726. Dim Stream As NetworkStream
  727. Dim IpEndPoint As IPEndPoint
  728. Dim puck(1) As Byte : puck(0) = 0
  729. Dim theBuffer(blockSize - 1) As Byte
  730. Dim tmp(1) As Byte
  731. Dim dataChannel As Integer = 0
  732. Dim packetSize As UShort = 0
  733. Dim idleTimer, bandwidthTimer As Date
  734. Dim bytesread As Integer = 0
  735. Dim weHaveThePuck As Boolean = True
  736. Dim bandwidthUsedThisSecond As Int32 = 0
  737. Dim userOrSystemSwitcher As Integer = 0
  738. Try
  739. ' Create a local Server and Stream objects for clarity.
  740. Server = session.theClient
  741. Stream = Server.GetStream()
  742. Catch ex As Exception
  743. ' An unexpected error.
  744. Debug.WriteLine("Could not create local Server or Stream object in server. Message: " & ex.Message)
  745. Exit Sub
  746. End Try
  747. Try
  748. ' Get the remote machine's IP address.
  749. IpEndPoint = CType(Server.Client.RemoteEndPoint, Net.IPEndPoint)
  750. session.remoteIpAddress = IpEndPoint.Address
  751. ' Set the send and receive buffers to the maximum
  752. ' size allowable in this application...
  753. Server.Client.ReceiveBufferSize = 65535
  754. Server.Client.SendBufferSize = 65535
  755. ' no delay on partially filled packets...
  756. ' Send it all as fast as possible.
  757. Server.NoDelay = True
  758. ' Set the timers...
  759. idleTimer = Now
  760. bandwidthTimer = Now
  761. session.IsRunning = True
  762. ' Start the communication loop
  763. Do
  764. ' Check to see if our app is shutting down.
  765. If theServerIsStopping(Server, session) Then Exit Do
  766. ' Throttle network Mbps...
  767. bandwidthUsedThisSecond = session.bytesSentThisSecond + session.bytesRecievedThisSecond
  768. If bandwidthTimer.AddMilliseconds(250) >= Now And bandwidthUsedThisSecond >= (Mbps / 4) Then
  769. While bandwidthTimer.AddMilliseconds(250) > Now
  770. Thread.Sleep(1)
  771. End While
  772. End If
  773. If bandwidthTimer.AddMilliseconds(250) <= Now Then
  774. bandwidthTimer = Now
  775. session.bytesRecievedThisSecond = 0
  776. session.bytesSentThisSecond = 0
  777. bandwidthUsedThisSecond = 0
  778. End If
  779. ' Normal communications...
  780. If weHaveThePuck Then
  781. ' Send data if there is any to be sent...
  782. userOrSystemSwitcher += 1
  783. Select Case userOrSystemSwitcher
  784. Case 1
  785. If HandleOutgoingUserData(Stream, session) Then idleTimer = Now
  786. Case 2
  787. If HandleOutgoingInternalSystemMessage(Stream, session) Then idleTimer = Now
  788. End Select
  789. If userOrSystemSwitcher > 1 Then userOrSystemSwitcher = 0
  790. ' After sending out data, send the puck
  791. Stream.Write(puck, 0, 1)
  792. weHaveThePuck = False
  793. End If
  794. If theBuffer.Length < 2 Then ReDim theBuffer(1)
  795. ' Read in the control byte.
  796. Stream.Read(theBuffer, 0, 1)
  797. dataChannel = theBuffer(0)
  798. ' If it's just the puck (communictaion syncronization byte),
  799. ' set weHaveThePuck true, record the byte read for throttling,
  800. ' and that's all. dataChannel 0 is reserved for the puck.
  801. If dataChannel = 0 Then
  802. weHaveThePuck = True
  803. session.bytesRecievedThisSecond += 1
  804. Else
  805. ' It's not the puck: It's an incoming packet.
  806. ' Get the packet size:
  807. tmp(0) = Convert.ToByte(Stream.ReadByte)
  808. tmp(1) = Convert.ToByte(Stream.ReadByte)
  809. packetSize = BitConverter.ToUInt16(tmp, 0)
  810. session.bytesRecievedThisSecond += 2
  811. ' Get the packet:
  812. If theBuffer.Length <> packetSize Then ReDim theBuffer(packetSize - 1)
  813. Do
  814. ' Check to see if we're stopping...
  815. If theServerIsStopping(Server, session) Then Exit Do
  816. ' Read bytes in...
  817. bytesread += Stream.Read(theBuffer, bytesread, (packetSize - bytesread))
  818. Loop While bytesread < packetSize
  819. bytesread = 0
  820. ' Record bytes read for throttling...
  821. session.bytesRecievedThisSecond += packetSize
  822. ' Handle the packet...
  823. If dataChannel > 250 Then
  824. ' this is an internal system packet
  825. If Not theServerIsStopping(Server, session) Then HandleIncomingSystemMessages(theBuffer, dataChannel, session)
  826. Else
  827. ' Hand user data off to the calling thread.
  828. If Not theServerIsStopping(Server, session) Then RcvBytes(theBuffer, session.sessionID, dataChannel)
  829. End If
  830. idleTimer = Now
  831. End If
  832. ' Throttle CPU usage when idle.
  833. If Now > idleTimer.AddMilliseconds(500) Then
  834. Thread.Sleep(50)
  835. End If
  836. Loop
  837. Catch ex As Exception
  838. ' An unexpected error.
  839. Debug.WriteLine("Unexpected error in server: " & ex.Message)
  840. End Try
  841. Try
  842. session.fileReader.Close()
  843. Catch ex As Exception
  844. End Try
  845. Try
  846. Server.Client.Close()
  847. Server.Client.Blocking = False
  848. Catch ex As Exception
  849. End Try
  850. ' If we're in the middle of receiving a file,
  851. ' close the filestream, release the memory and
  852. ' delete the partial file.
  853. WrapUpIncomingFile(session)
  854. session.IsRunning = False
  855. SystemMessage("Session " & session.sessionID.ToString & " Stopped.")
  856. End Sub
  857. Protected Overrides Sub Finalize()
  858. MyBase.Finalize()
  859. End Sub
  860. End Class