Comm.vb 112 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877
  1. Imports System.Threading
  2. Imports System.Net
  3. Imports System.Net.Sockets
  4. Imports System.IO
  5. Imports System.Collections.Concurrent
  6. Imports System.Reflection
  7. Imports System.Runtime.InteropServices
  8. Imports System.Diagnostics
  9. Imports System.Collections.Generic
  10. Public Class Comm
  11. Public Shared Function BytesToString(ByVal data() As Byte) As String
  12. Dim enc As New System.Text.UTF8Encoding()
  13. BytesToString = enc.GetString(data)
  14. End Function
  15. Public Shared Function StrToByteArray(ByVal text As String) As Byte()
  16. Dim encoding As New System.Text.UTF8Encoding()
  17. StrToByteArray = encoding.GetBytes(text)
  18. End Function
  19. Public Class clsAsyncUnbuffWriter
  20. '''' We need the page size for best performance - so we use GetSystemInfo and dwPageSize
  21. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  22. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  23. Public Class clsSystemInfo
  24. Private Class WinApi
  25. <DllImport("kernel32.dll")> _
  26. Public Shared Sub GetSystemInfo(<MarshalAs(UnmanagedType.Struct)> ByRef lpSystemInfo As SYSTEM_INFO)
  27. End Sub
  28. <StructLayout(LayoutKind.Sequential)> _
  29. Public Structure SYSTEM_INFO
  30. Friend uProcessorInfo As _PROCESSOR_INFO_UNION
  31. Public dwPageSize As UInteger
  32. Public lpMinimumApplicationAddress As IntPtr
  33. Public lpMaximumApplicationAddress As IntPtr
  34. Public dwActiveProcessorMask As IntPtr
  35. Public dwNumberOfProcessors As UInteger
  36. Public dwProcessorType As UInteger
  37. Public dwAllocationGranularity As UInteger
  38. Public dwProcessorLevel As UShort
  39. Public dwProcessorRevision As UShort
  40. End Structure
  41. <StructLayout(LayoutKind.Explicit)> _
  42. Public Structure _PROCESSOR_INFO_UNION
  43. <FieldOffset(0)> _
  44. Friend dwOemId As UInteger
  45. <FieldOffset(0)> _
  46. Friend wProcessorArchitecture As UShort
  47. <FieldOffset(2)> _
  48. Friend wReserved As UShort
  49. End Structure
  50. End Class
  51. Public Shared Function GetPageSize() As Integer
  52. Dim sysinfo As New WinApi.SYSTEM_INFO()
  53. WinApi.GetSystemInfo(sysinfo)
  54. Return CInt(sysinfo.dwPageSize)
  55. End Function
  56. End Class
  57. Private target As FileStream
  58. Private inputBuffer As MemoryStream
  59. Private bufferSize As Integer
  60. Private running As Boolean
  61. Private writing As Boolean
  62. Private readWait As Threading.ManualResetEvent
  63. Private writeWait As Threading.ManualResetEvent
  64. Private finishedWriting As Threading.ManualResetEvent
  65. Private totalWritten As Int64
  66. Private writeTimer As Stopwatch
  67. Public Function GetTotalBytesWritten() As Int64
  68. Return totalWritten
  69. End Function
  70. Public Function IsRunning() As Boolean
  71. Return running
  72. End Function
  73. Public Sub Close()
  74. writing = False
  75. writeWait.Set()
  76. finishedWriting.WaitOne()
  77. readWait.Set()
  78. End Sub
  79. Public Function GetActiveMiliseconds() As Int64
  80. Try
  81. Return writeTimer.ElapsedMilliseconds
  82. Catch ex As Exception
  83. Return 0
  84. End Try
  85. End Function
  86. Public Shared Function GetPageSize() As Integer
  87. Return clsSystemInfo.GetPageSize
  88. End Function
  89. Public Sub New(ByVal dest As String, _
  90. Optional ByVal unbuffered As Boolean = False, _
  91. Optional ByVal _bufferSize As Integer = (1024 * 1024), _
  92. Optional ByVal setLength As Int64 = 0)
  93. bufferSize = _bufferSize
  94. Dim options As FileOptions = FileOptions.SequentialScan
  95. If unbuffered Then options = FileOptions.WriteThrough Or FileOptions.SequentialScan
  96. readWait = New Threading.ManualResetEvent(False)
  97. writeWait = New Threading.ManualResetEvent(False)
  98. finishedWriting = New Threading.ManualResetEvent(False)
  99. readWait.Set()
  100. writeWait.Reset()
  101. finishedWriting.Reset()
  102. target = New FileStream(dest, _
  103. FileMode.Create, FileAccess.Write, FileShare.None, GetPageSize, options)
  104. If setLength > 0 Then target.SetLength(setLength)
  105. totalWritten = 0
  106. inputBuffer = New MemoryStream(bufferSize)
  107. running = True
  108. writing = True
  109. writeTimer = New Stopwatch
  110. Dim asyncWriter As New Threading.Thread(AddressOf WriteThread)
  111. With asyncWriter
  112. .Priority = Threading.ThreadPriority.Lowest
  113. .IsBackground = True
  114. .Name = "AsyncCopy writer"
  115. .Start()
  116. End With
  117. End Sub
  118. Public Function Write(ByVal someBytes() As Byte, ByVal numToWrite As Integer) As Boolean
  119. If Not running Then Return False
  120. If numToWrite < 1 Then Return False
  121. If numToWrite > inputBuffer.Capacity Then
  122. Throw New Exception("clsAsyncUnbuffWriter: someBytes() can not be larger then buffer capacity")
  123. End If
  124. If (inputBuffer.Length + numToWrite) > inputBuffer.Capacity Then
  125. If inputBuffer.Length > 0 Then
  126. readWait.Reset()
  127. writeWait.Set()
  128. readWait.WaitOne()
  129. If Not running Then Return False
  130. inputBuffer.Write(someBytes, 0, numToWrite)
  131. End If
  132. Else
  133. inputBuffer.Write(someBytes, 0, numToWrite)
  134. End If
  135. Return True
  136. End Function
  137. Private Sub WriteThread()
  138. Dim bytesThisTime As Int32 = 0
  139. Dim internalBuffer(bufferSize) As Byte
  140. writeTimer.Stop()
  141. writeTimer.Reset()
  142. writeTimer.Start()
  143. Do
  144. writeWait.WaitOne()
  145. writeWait.Reset()
  146. bytesThisTime = CInt(inputBuffer.Length)
  147. Buffer.BlockCopy(inputBuffer.GetBuffer, 0, internalBuffer, 0, bytesThisTime)
  148. inputBuffer.SetLength(0)
  149. readWait.Set()
  150. target.Write(internalBuffer, 0, bytesThisTime)
  151. totalWritten += bytesThisTime
  152. Loop While writing
  153. ' Flush inputBuffer
  154. If inputBuffer.Length > 0 Then
  155. bytesThisTime = CInt(inputBuffer.Length)
  156. Buffer.BlockCopy(inputBuffer.GetBuffer, 0, internalBuffer, 0, bytesThisTime)
  157. target.Write(internalBuffer, 0, bytesThisTime)
  158. totalWritten += bytesThisTime
  159. End If
  160. running = False
  161. writeTimer.Stop()
  162. Try
  163. target.Close()
  164. target.Dispose()
  165. Catch ex As Exception
  166. End Try
  167. finishedWriting.Set()
  168. inputBuffer.Close()
  169. inputBuffer.Dispose()
  170. inputBuffer = Nothing
  171. internalBuffer = Nothing
  172. target = Nothing
  173. GC.GetTotalMemory(True)
  174. End Sub
  175. End Class
  176. Public Class Server
  177. Public errMsg As String
  178. ' Define the callback delegate type
  179. Public Delegate Sub ServerCallbackDelegate(ByVal bytes() As Byte, ByVal sessionID As Int32, ByVal dataChannel As Byte)
  180. 'Private Delegate Sub SendQueueDelegate(ByVal bytes() As Byte, ByVal dataChannel As Byte, ByVal sessionID As Int32)
  181. ' Create Delegate object
  182. Public ServerCallbackObject As ServerCallbackDelegate
  183. 'Private SendCallback As SendQueueDelegate
  184. Private Listener As TcpListener
  185. Private continue_running As Boolean = False
  186. Private blockSize As UInt16
  187. Private Port As Integer
  188. Private localAddr As IPAddress
  189. Private Mbps As UInt32
  190. Private newSessionId As Int32 = 0
  191. Public IsRunning As Boolean = False
  192. Private serverState As currentState = currentState.stopped
  193. Public Class message
  194. Public bytes() As Byte
  195. Public dataChannel As Byte
  196. Public sessionID As Int32
  197. End Class
  198. Private Enum currentState
  199. err = -1
  200. stopped = 0
  201. running = 1
  202. idle = 2
  203. End Enum
  204. Private Class Sessions
  205. Private sessionCollection As New List(Of SessionCommunications)
  206. Private sessionLockObject As New Object
  207. Private reusableSessions As New Concurrent.ConcurrentQueue(Of Int32)
  208. Public Sub AddSession(ByVal theNewSession As SessionCommunications)
  209. Dim thisTask = System.Threading.Tasks.Task.Factory
  210. thisTask.StartNew(Sub()
  211. bgAddSession(theNewSession)
  212. End Sub)
  213. End Sub
  214. Public Function GetReusableSessionID() As Int32
  215. Dim sessionNumber As Int32 = -1
  216. If reusableSessions.TryDequeue(sessionNumber) Then
  217. Return sessionNumber
  218. End If
  219. Return -1
  220. End Function
  221. Private Sub bgAddSession(ByVal theNewSession As SessionCommunications)
  222. SyncLock sessionLockObject
  223. If sessionCollection.Count > theNewSession.sessionID Then
  224. sessionCollection.Item(theNewSession.sessionID) = Nothing
  225. sessionCollection.Item(theNewSession.sessionID) = theNewSession
  226. Else
  227. sessionCollection.Add(theNewSession)
  228. End If
  229. End SyncLock
  230. End Sub
  231. Public Sub ReuseSessionNumber(ByVal sessionNumber As Int32)
  232. reusableSessions.Enqueue(sessionNumber)
  233. End Sub
  234. Public Function GetSession(ByVal sessionID As Int32, ByRef session As SessionCommunications) As Boolean
  235. Try
  236. session = sessionCollection.Item(sessionID)
  237. If session Is Nothing Then Return False
  238. If Not session.IsRunning Then Return False
  239. Return True
  240. Catch ex As Exception
  241. Return False
  242. End Try
  243. End Function
  244. Public Function GetSession(ByVal MachineID As String, ByRef session As SessionCommunications) As Boolean
  245. session = Nothing
  246. SyncLock sessionLockObject
  247. For Each connectedSession In sessionCollection
  248. If connectedSession.IsRunning And connectedSession.machineId = MachineID Then
  249. session = connectedSession
  250. Exit For
  251. End If
  252. Next
  253. End SyncLock
  254. If session Is Nothing Then Return False
  255. Return True
  256. End Function
  257. Public Sub Broadcast(ByVal msg As message)
  258. Dim thisCopy As New List(Of SessionCommunications)
  259. SyncLock sessionLockObject
  260. For i As Int32 = 0 To sessionCollection.Count - 1
  261. thisCopy.Add(sessionCollection.Item(i))
  262. Next
  263. End SyncLock
  264. For i As Int32 = 0 To thisCopy.Count - 1
  265. If thisCopy.Item(i) IsNot Nothing AndAlso thisCopy.Item(i).IsRunning Then
  266. Try
  267. thisCopy.Item(i).sendQueue.Enqueue(msg)
  268. Catch ex As Exception
  269. End Try
  270. End If
  271. Next
  272. End Sub
  273. Public Function GetSessionCollection() As List(Of SessionCommunications)
  274. Dim thisCopy As New List(Of SessionCommunications)
  275. SyncLock sessionLockObject
  276. For i As Int32 = 0 To sessionCollection.Count - 1
  277. 'If sessionCollection.Item(i).IsRunning then thisCopy.Add(sessionCollection.Item(i))
  278. thisCopy.Add(sessionCollection.Item(i))
  279. Next
  280. End SyncLock
  281. Return thisCopy
  282. End Function
  283. Public Sub ShutDown()
  284. SyncLock sessionLockObject
  285. For Each session As SessionCommunications In sessionCollection
  286. Try
  287. If session IsNot Nothing AndAlso session.IsRunning Then session.Close()
  288. Catch ex As Exception
  289. End Try
  290. Next
  291. End SyncLock
  292. End Sub
  293. End Class
  294. Public Class SessionCommunications
  295. Public UserBytesToBeSentAvailable As Boolean = False
  296. Public UserBytesToBeSent As New MemoryStream
  297. Public UserOutputChannel As Byte
  298. Public SystemBytesToBeSentAvailable As Boolean = False
  299. Public SystemBytesToBeSent() As Byte
  300. Public SystemOutputChannel As Byte
  301. Public theClient As TcpClient
  302. Public IsRunning As Boolean = False
  303. Public remoteIpAddress As System.Net.IPAddress
  304. Public bytesRecieved() As Byte
  305. Public sessionID As Int32
  306. Public disConnect As Boolean = False
  307. Public bytesSentThisSecond As Int32 = 0
  308. Public bytesRecievedThisSecond As Int32 = 0
  309. Public fileBytesRecieved As Int64 = 0
  310. Public filebytesSent As Int64 = 0
  311. Public SendingFile As Boolean = False
  312. Public FileBeingSentPath As String
  313. Public IncomingFileSize As Int64
  314. Public IncomingFileName As String
  315. Public ReceivingFile As Boolean = False
  316. Public sendPacketSize As Boolean = False
  317. Public fileReader As FileStream
  318. Public fileWriter As clsAsyncUnbuffWriter
  319. Public ReceivedFilesFolder As String = System.Environment.GetFolderPath(Environment.SpecialFolder.CommonDesktopDirectory) & "\ServerReceivedFiles"
  320. Public userName As String
  321. Public password As String
  322. Public paused As Boolean
  323. Public pauseSent As Boolean
  324. Public sendQueue As ConcurrentQueue(Of message)
  325. Public messageIn As MessageInQueue
  326. Public machineId As String
  327. Public Class MessageInQueue
  328. Public queue As New ConcurrentQueue(Of message)
  329. Private bgThread As New Threading.Thread(AddressOf Pump)
  330. Private running As Boolean
  331. Private callBack As ServerCallbackDelegate
  332. Public Sub New(ByRef _callBack As ServerCallbackDelegate)
  333. callBack = _callBack
  334. running = True
  335. bgThread.IsBackground = True
  336. bgThread.Start()
  337. End Sub
  338. Public Sub Close()
  339. running = False
  340. End Sub
  341. Private Sub Pump()
  342. Dim lastSuccessfullPump As New Date
  343. Dim msg As message = Nothing
  344. While running
  345. If queue.TryDequeue(msg) Then
  346. callBack(msg.bytes, msg.sessionID, msg.dataChannel)
  347. lastSuccessfullPump = Now
  348. End If
  349. If Now > lastSuccessfullPump.AddMilliseconds(5) Then Thread.Sleep(1)
  350. End While
  351. End Sub
  352. End Class
  353. Public Sub New(ByVal _theClient As TcpClient, ByVal _sessionID As Int32)
  354. theClient = _theClient
  355. sessionID = _sessionID
  356. paused = False
  357. pauseSent = False
  358. End Sub
  359. Public Sub Close(Optional ByVal wait As Int32 = 500)
  360. Dim bgThread As New Thread(AddressOf WaitClose)
  361. bgThread.Start(wait)
  362. End Sub
  363. Private Sub WaitClose(ByVal waitmilliseconds As Object)
  364. Dim wait As Int32 = CType(waitmilliseconds, Int32)
  365. Thread.Sleep(wait)
  366. disConnect = True
  367. End Sub
  368. End Class
  369. Private SessionCollection As New Sessions
  370. Private SessionCollectionLocker As New Object
  371. ''' <summary>
  372. ''' 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,
  373. ''' or disconnected. Care should be taken to check the session.isRunning before using one,
  374. ''' because inactive or disconnected sessions may be overwritten by new connections at any moment.
  375. ''' </summary>
  376. ''' <returns>List(Of SessionCommunications)</returns>
  377. ''' <remarks></remarks>
  378. Public Function GetSessionCollection() As List(Of SessionCommunications)
  379. Dim thisCollection As List(Of SessionCommunications) = SessionCollection.GetSessionCollection()
  380. Return thisCollection
  381. End Function
  382. ''' <summary>
  383. ''' Gets the session object associated with the sessionId. Returns Nothing for sessions where session.isRunning = False.
  384. ''' </summary>
  385. ''' <param name="sessionId"></param>
  386. ''' <returns>A TcpComm.Server.SessionCommunications object</returns>
  387. ''' <remarks></remarks>
  388. Public Function GetSession(ByVal sessionId As Int32) As SessionCommunications
  389. Dim theSession As SessionCommunications = Nothing
  390. ' Sessions that are not running are not returned, so that they're sendqueues are not
  391. ' accidently inflated.
  392. If SessionCollection.GetSession(sessionId, theSession) Then Return theSession
  393. Return Nothing
  394. End Function
  395. ''' <summary>
  396. ''' Gets the first session object associated with the MachineID. Returns Nothing for sessions where session.isRunning = False.
  397. ''' </summary>
  398. ''' <param name="aMachineID"></param>
  399. ''' <returns>A TcpComm.Server.SessionCommunications object</returns>
  400. ''' <remarks></remarks>
  401. Public Function GetSession(ByVal aMachineID As String) As SessionCommunications
  402. GetSession = Nothing
  403. SessionCollection.GetSession(aMachineID, GetSession)
  404. Return GetSession
  405. End Function
  406. ' CallbackForm must implement an UpdateUI Sub.
  407. Public Sub New(ByVal callbackMethod As ServerCallbackDelegate, Optional ByVal _throttledBytesPerSecond As UInt32 = 9000000)
  408. Mbps = _throttledBytesPerSecond
  409. ' BlockSize should be 62500 or 63100, depending on requested speed.
  410. ' Excellent performance, and works great with throttling.
  411. Dim _blockSize As UInt16
  412. ' Get corrected blocksize for throttling.
  413. If Mbps < 300000 Then
  414. If Mbps > 16000 Then
  415. blockSize = 4000
  416. Else
  417. blockSize = CUShort((Mbps / 4))
  418. End If
  419. ElseIf Mbps > 300000 And Mbps < 500000 Then
  420. blockSize = 16000
  421. ElseIf Mbps > 500000 And Mbps < 1000000 Then
  422. blockSize = 32000
  423. Else
  424. Dim count As UInt32 = 0
  425. Dim aFourth As Decimal = 0
  426. If Mbps > 25000000 Then
  427. _blockSize = 63100
  428. Else
  429. _blockSize = 62500
  430. End If
  431. aFourth = CDec(Mbps / 4)
  432. Do
  433. count += _blockSize
  434. If (count + _blockSize) > aFourth Then
  435. Mbps = CUInt(count * 4)
  436. blockSize = _blockSize
  437. Exit Do
  438. End If
  439. Loop
  440. End If
  441. ' Initialize the delegate object to point to the user's callback method.
  442. ServerCallbackObject = callbackMethod
  443. End Sub
  444. Public Sub ThrottleNetworkBps(ByVal bytesPerSecond As UInteger)
  445. ' Default value is 9000000 Mbps. Ok throughput, and
  446. ' good performance for the server (low CPU usage).
  447. Mbps = bytesPerSecond
  448. End Sub
  449. ''' <summary>
  450. ''' This is a convienience function that handles the work of converting the text you would like to send to a byte array.
  451. ''' Passes back the return value and errMsg of SendBytes(). Returns True on success and False on falure. Check the errMsg
  452. ''' string for send failure explanations.
  453. ''' </summary>
  454. ''' <param name="textMessage"></param>
  455. ''' <param name="channel"></param>
  456. ''' <param name="sessionid"></param>
  457. ''' <param name="errMsg"></param>
  458. ''' <returns></returns>
  459. ''' <remarks></remarks>
  460. Public Function SendText(ByVal textMessage As String, Optional ByVal channel As Byte = 1, Optional ByVal sessionid As Int32 = -1, _
  461. Optional ByRef errMsg As String = "") As Boolean
  462. If textMessage = "" Then
  463. errMsg = "Your text message must contain some text."
  464. Return False
  465. End If
  466. Return SendBytes(StrToByteArray(textMessage), channel, sessionid, errMsg)
  467. End Function
  468. Public Function Start(ByVal prt As Integer, Optional ByRef errorMessage As String = "") As Boolean
  469. If serverState = currentState.running Then
  470. errorMessage = "The server is already running."
  471. Return False
  472. End If
  473. serverState = currentState.idle
  474. Dim listenerThread As New Thread(AddressOf theListener)
  475. Try
  476. Port = prt
  477. localAddr = GetLocalIpAddress()
  478. continue_running = True
  479. IsRunning = True
  480. listenerThread.Name = "Server Listener Thread"
  481. listenerThread.Start()
  482. Catch ex As Exception
  483. errorMessage = ex.Message
  484. Return False
  485. End Try
  486. While serverState <> currentState.running
  487. Thread.Sleep(10)
  488. If serverState = currentState.err Or serverState = currentState.stopped Then
  489. errorMessage = errMsg
  490. Return False
  491. End If
  492. End While
  493. Return True
  494. End Function
  495. Public Sub Close()
  496. continue_running = False
  497. Try
  498. Listener.Stop()
  499. Catch ex As Exception
  500. End Try
  501. Try
  502. SessionCollection.ShutDown()
  503. Catch ex As Exception
  504. End Try
  505. IsRunning = False
  506. ServerCallbackObject(StrToByteArray("Server Stopped."), -1, 255)
  507. serverState = currentState.stopped
  508. End Sub
  509. Private Function GetLocalIpAddress() As System.Net.IPAddress
  510. Dim strHostName As String
  511. Dim addresses() As System.Net.IPAddress
  512. strHostName = System.Net.Dns.GetHostName()
  513. addresses = System.Net.Dns.GetHostAddresses(strHostName)
  514. ' Find an IpV4 address
  515. For Each address As System.Net.IPAddress In addresses
  516. ' Return the first IpV4 IP Address we find in the list.
  517. If address.AddressFamily = AddressFamily.InterNetwork Then
  518. Return address
  519. End If
  520. Next
  521. ' No IpV4 address? Return the loopback address.
  522. Return System.Net.IPAddress.Loopback
  523. End Function
  524. Public Function GetBlocksize() As UInt16
  525. Return blockSize
  526. End Function
  527. ''' <summary>
  528. ''' Returns the size of the selected session's sendqueue. Returns -1 if the session is nothing, or session.isRunning = False.
  529. ''' CAUTION: Calling this function too often will result in decreased performance, and failing to call it at all may result
  530. ''' 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
  531. ''' (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).
  532. ''' </summary>
  533. ''' <param name="sessionId"></param>
  534. ''' <returns>An Int32</returns>
  535. ''' <remarks></remarks>
  536. Public Function GetSendQueueSize(ByVal sessionId As Int32) As Int32
  537. Dim sendQueueSize As Int32 = -1
  538. Dim session As SessionCommunications = Nothing
  539. If SessionCollection.GetSession(sessionId, session) Then
  540. If session IsNot Nothing AndAlso session.IsRunning Then
  541. GetSendQueueSize = session.sendQueue.Count
  542. End If
  543. End If
  544. Return sendQueueSize
  545. End Function
  546. Public Function GetFile(ByVal _path As String, ByVal sessionID As Int32) As Boolean
  547. Dim thisSession As SessionCommunications = Nothing
  548. If SessionCollection.GetSession(sessionID, thisSession) Then
  549. If thisSession Is Nothing Then Return False
  550. If Not thisSession.IsRunning Then Return False
  551. thisSession.sendQueue.Enqueue(New message With { _
  552. .bytes = StrToByteArray("GFR:" & _path),
  553. .sessionID = sessionID,
  554. .dataChannel = 254
  555. })
  556. Else
  557. Return False
  558. End If
  559. Return True
  560. End Function
  561. Public Function SendFile(ByVal _path As String, ByVal sessionID As Int32) As Boolean
  562. Dim thisSession As SessionCommunications = Nothing
  563. If SessionCollection.GetSession(sessionID, thisSession) Then
  564. If thisSession Is Nothing Then Return False
  565. If Not thisSession.IsRunning Then Return False
  566. thisSession.sendQueue.Enqueue(New message With { _
  567. .bytes = StrToByteArray("SFR:" & _path),
  568. .sessionID = sessionID,
  569. .dataChannel = 254
  570. })
  571. Else
  572. Return False
  573. End If
  574. Return True
  575. End Function
  576. Public Function SendBytes(ByVal bytes() As Byte, Optional ByVal channel As Byte = 1, Optional ByVal sessionID As Int32 = -1, _
  577. Optional ByRef errMsg As String = "") As Boolean
  578. Dim foundSession As Boolean = False
  579. If channel = 0 Or channel > 250 Then
  580. errMsg = "Data can not be sent using channel numbers less then 1 or greater then 250."
  581. Return False
  582. End If
  583. If sessionID > -1 Then
  584. Dim targetSession As SessionCommunications = Nothing
  585. If SessionCollection.GetSession(sessionID, targetSession) Then
  586. targetSession.sendQueue.Enqueue(New message With { _
  587. .bytes = bytes,
  588. .dataChannel = channel,
  589. .sessionID = sessionID
  590. })
  591. Return True
  592. End If
  593. Else
  594. SessionCollection.Broadcast(New message With { _
  595. .bytes = bytes,
  596. .dataChannel = channel,
  597. .sessionID = sessionID
  598. })
  599. Return True
  600. End If
  601. errMsg = "The session you are trying to write to is no longer available."
  602. Return False
  603. End Function
  604. Private Function RcvBytes(ByVal data() As Byte, ByVal session As SessionCommunications, Optional ByVal dataChannel As Byte = 1) As Boolean
  605. ' dataType: >0 = data channel, > 250 = internal messages. 0 is an invalid channel number (it's the puck)
  606. If dataChannel < 1 Then
  607. RcvBytes = False
  608. Exit Function
  609. End If
  610. Try
  611. ' Check to see if our app is closing
  612. If Not continue_running Then Return False
  613. Dim passedData(data.Length - 1) As Byte
  614. Array.Copy(data, passedData, data.Length)
  615. If session.sessionID > -1 Then
  616. session.messageIn.queue.Enqueue(New message With { _
  617. .bytes = passedData,
  618. .dataChannel = dataChannel,
  619. .sessionID = session.sessionID
  620. })
  621. Else
  622. ' These are internal system messages. There is no session associated with them
  623. ServerCallbackObject(data, session.sessionID, dataChannel)
  624. End If
  625. Catch ex As Exception
  626. ' An unexpected error.
  627. Debug.WriteLine("Unexpected error in server\RcvBytes: " & ex.Message)
  628. Return False
  629. End Try
  630. Return True
  631. End Function
  632. Private Sub SendExternalSystemMessage(ByVal message As String, ByVal session As SessionCommunications)
  633. session.SystemBytesToBeSent = StrToByteArray(message)
  634. session.SystemOutputChannel = 254 ' Text messages / commands on channel 254
  635. session.SystemBytesToBeSentAvailable = True
  636. End Sub
  637. Private Function CheckSessionPermissions(ByVal session As SessionCommunications, ByVal cmd As String) As Boolean
  638. ' Your security code here...
  639. Return True
  640. End Function
  641. Private Function BeginFileSend(ByVal _path As String, ByVal session As SessionCommunications, ByVal fileLength As Long) As Boolean
  642. Try
  643. session.fileReader = New FileStream(_path, FileMode.Open, FileAccess.Read, FileShare.None, clsAsyncUnbuffWriter.GetPageSize)
  644. session.SendingFile = True
  645. BeginFileSend = True
  646. Catch ex As Exception
  647. BeginFileSend = False
  648. _path = ex.Message
  649. session.SendingFile = False
  650. End Try
  651. Try
  652. If Not BeginFileSend Then session.fileReader.Close()
  653. Catch ex As Exception
  654. End Try
  655. End Function
  656. Private Sub GetMoreFileBytesIfAvailable(ByVal session As SessionCommunications)
  657. Dim bytesRead As Int32 = 0
  658. If session.SendingFile And Not session.SystemBytesToBeSentAvailable Then
  659. Try
  660. If session.SystemBytesToBeSent.Length <> blockSize Then ReDim session.SystemBytesToBeSent(blockSize - 1)
  661. bytesRead = session.fileReader.Read(session.SystemBytesToBeSent, 0, blockSize)
  662. If bytesRead <> blockSize Then ReDim Preserve session.SystemBytesToBeSent(bytesRead - 1)
  663. If bytesRead > 0 Then
  664. session.SystemOutputChannel = 253 ' File transfer from server to client
  665. session.SystemBytesToBeSentAvailable = True
  666. Else
  667. ReDim session.SystemBytesToBeSent(blockSize - 1)
  668. SendExternalSystemMessage("->Done", session) ' Send the client a completion notice.
  669. session.SendingFile = False
  670. ' Clean up
  671. session.fileReader.Close()
  672. session.fileReader = Nothing
  673. GC.GetTotalMemory(True)
  674. End If
  675. Catch ex As Exception
  676. SendExternalSystemMessage("ERR: " & ex.Message, session)
  677. ' We're finished.
  678. ReDim session.SystemBytesToBeSent(blockSize - 1)
  679. session.SendingFile = False
  680. session.fileReader.Close()
  681. End Try
  682. End If
  683. End Sub
  684. Private Function GetFilenameFromPath(ByRef filePath As String) As String
  685. Dim filePathParts() As String
  686. If filePath.Trim = "" Then Return ""
  687. Try
  688. filePathParts = Split(filePath, "\")
  689. GetFilenameFromPath = filePathParts(filePathParts.Length - 1)
  690. Catch ex As Exception
  691. filePath = ex.Message
  692. Return ""
  693. End Try
  694. End Function
  695. Private Function CreateFolders(ByVal _path As String) As Boolean
  696. CreateFolders = True
  697. Dim parts() As String
  698. Dim path As String = ""
  699. Dim count As Int32
  700. parts = Split(_path, "\")
  701. path = parts(0)
  702. For count = 1 To parts.Length - 2
  703. path += "\" & parts(count)
  704. Try
  705. If Not Directory.Exists(path) Then
  706. Directory.CreateDirectory(path)
  707. End If
  708. Catch ex As Exception
  709. End Try
  710. Next
  711. End Function
  712. Private Function BeginToReceiveAFile(ByVal _path As String, ByVal session As SessionCommunications) As Boolean
  713. Dim readBuffer As Int32 = 0
  714. session.ReceivingFile = True
  715. BeginToReceiveAFile = True
  716. session.fileBytesRecieved = 0
  717. Try
  718. CreateFolders(_path) ' Just a 256k write buffer for the server. Let's try to avoid memory problems...
  719. session.fileWriter = New clsAsyncUnbuffWriter(_path, True, 1024 * 256, session.IncomingFileSize)
  720. Catch ex As Exception
  721. _path = ex.Message
  722. session.ReceivingFile = False
  723. End Try
  724. If Not session.ReceivingFile Then
  725. Try
  726. session.fileWriter.Close()
  727. Catch ex As Exception
  728. End Try
  729. Return False
  730. End If
  731. End Function
  732. Private Function HandleIncomingFileBytes(ByRef bytes() As Byte, ByVal session As SessionCommunications) As Boolean
  733. Try
  734. session.fileWriter.Write(bytes, bytes.Length)
  735. HandleIncomingFileBytes = True
  736. Catch ex As Exception
  737. HandleIncomingFileBytes = False
  738. End Try
  739. End Function
  740. Private Sub FinishReceivingTheFile(ByVal session As SessionCommunications)
  741. Try
  742. session.fileWriter.Close()
  743. session.fileWriter = Nothing
  744. session.ReceivingFile = False
  745. Catch ex As Exception
  746. session.ReceivingFile = False
  747. End Try
  748. End Sub
  749. Private Sub HandleIncomingSystemMessages(ByVal bytes() As Byte, ByVal channel As Byte, ByVal session As SessionCommunications)
  750. If channel = 254 Then ' Text commands / messages passed between server and client
  751. Dim message As String = BytesToString(bytes)
  752. Dim filePath As String
  753. Dim tmp As String = ""
  754. ' Get File Request: The client wants us to send them a file.
  755. If message.Length > 4 Then tmp = message.Substring(0, 4)
  756. If tmp = "GFR:" Then
  757. ' Get file path...
  758. filePath = message.Substring(4, message.Length - 4)
  759. ' Does it exist?
  760. If File.Exists(filePath) Then
  761. ' Do they have permission to get this file?
  762. If CheckSessionPermissions(session, "GFR") Then
  763. ' Are we already busy sending them a file?
  764. If Not session.SendingFile Then
  765. Dim _theFilesInfo As New FileInfo(filePath)
  766. If BeginFileSend(filePath, session, _theFilesInfo.Length) Then
  767. ' Send only the file NAME. It will have a different path on the other side.
  768. SendExternalSystemMessage("Sending:" & GetFilenameFromPath(filePath) & _
  769. ":" & _theFilesInfo.Length, session)
  770. Else
  771. ' FilePath contains the error message.
  772. SendExternalSystemMessage("ERR: " & filePath, session)
  773. End If
  774. Else
  775. ' There's already a GFR in progress.
  776. SendExternalSystemMessage("ERR: File: ''" & _
  777. session.FileBeingSentPath & _
  778. "'' is still in progress. Only one file " & _
  779. "may be transfered (from server to client) at a time.", session)
  780. End If
  781. Else
  782. ' This user doesn't have rights to "get" this file. Send an error.
  783. SendExternalSystemMessage("ERR: You do not have permission to receive files. Access Denied.", session)
  784. End If
  785. Else
  786. ' File doesn't exist. Send an error.
  787. SendExternalSystemMessage("ERR: The requested file can not be found by the server.", session)
  788. End If
  789. End If
  790. ' We're being informed that we will be receiving a file:
  791. If message.Length > 7 Then tmp = message.Substring(0, 8)
  792. If tmp = "Sending:" Then
  793. ' Strip away the headder...
  794. Dim msgParts() As String = Split(message, ":")
  795. session.IncomingFileSize = Convert.ToInt64(msgParts(2))
  796. session.IncomingFileName = msgParts(1)
  797. tmp = session.ReceivedFilesFolder & "\" & session.IncomingFileName
  798. SystemMessage("Receiving file: " & session.IncomingFileName)
  799. If Not BeginToReceiveAFile(tmp, session) Then
  800. SystemMessage("ERR: " & tmp)
  801. SendExternalSystemMessage("Abort->", session)
  802. End If
  803. End If
  804. If message.Length > 10 Then tmp = message.Substring(0, 10)
  805. If tmp = "MachineID:" Then
  806. message = message.Substring(10, message.Length - 10)
  807. session.machineId = message
  808. SystemMessage("Session#" & session.sessionID & " MachineID:" & session.machineId)
  809. End If
  810. If message = "<-Done" Then
  811. FinishReceivingTheFile(session)
  812. SystemMessage("<-Done")
  813. End If
  814. ' We've been notified that no file data will be forthcoming.
  815. If message = "Abort<-" Then
  816. WrapUpIncomingFile(session)
  817. SystemMessage("<-Aborted.")
  818. SendExternalSystemMessage("<-Aborted.", session)
  819. End If
  820. ' Send File Request: The client wants to send us a file.
  821. If message.Length > 4 Then tmp = message.Substring(0, 4)
  822. If tmp = "SFR:" Then
  823. If CheckSessionPermissions(session, "SFR") Then
  824. Dim parts() As String
  825. parts = Split(message, "SFR:")
  826. SendExternalSystemMessage("GFR:" & parts(1), session)
  827. Else
  828. ' This user doesn't have rights to send us a file. Send an error.
  829. SendExternalSystemMessage("ERR: You do not have permission to send files. Access Denied.", session)
  830. End If
  831. End If
  832. If message.Length > 4 Then tmp = message.Substring(0, 4)
  833. If tmp = "GDR:" Then ' Get Directory Request
  834. ' Send each file in the directory and all subdirectories.
  835. ' To be implemented in the future.
  836. End If
  837. If message.Length > 4 Then tmp = message.Substring(0, 4)
  838. If tmp = "ERR:" Then ' The client has sent us an error message.
  839. ' Pass it on up to the user.
  840. SystemMessage(message)
  841. End If
  842. ' New queue throttling code
  843. If message = "pause" Then
  844. session.paused = True
  845. End If
  846. If message = "resume" Then
  847. session.paused = False
  848. End If
  849. If message = "Abort->" Then
  850. Try
  851. session.SendingFile = False
  852. ReDim session.SystemBytesToBeSent(blockSize - 1)
  853. SendExternalSystemMessage("->Aborted.", session)
  854. SystemMessage("->Aborted.")
  855. session.fileReader.Close()
  856. Catch ex As Exception
  857. End Try
  858. End If
  859. ' The client is disconnecting. Close the connection gracefully...
  860. If message = "close" Then
  861. ' This will be caught by the try in the run sub, and execution
  862. ' will drop out of the communication loop immediately and
  863. ' begin the shutdown process.
  864. Throw New Exception("Gracefull shutdown in progress.")
  865. End If
  866. ElseIf channel = 253 Then ' File transfer from server to client
  867. ElseIf channel = 252 Then ' File transfer from client to server
  868. Try
  869. If session.ReceivingFile Then
  870. HandleIncomingFileBytes(bytes, session)
  871. session.fileBytesRecieved += bytes.Length
  872. End If
  873. Catch ex As Exception
  874. End Try
  875. ElseIf channel = 251 Then ' reserved.
  876. End If
  877. End Sub
  878. Private Function HandleOutgoingInternalSystemMessage(ByVal Stream As NetworkStream, _
  879. ByVal session As SessionCommunications) As Boolean
  880. Dim tmp(1) As Byte
  881. Dim _size As UShort
  882. 'Static OurTurn As Boolean = False
  883. HandleOutgoingInternalSystemMessage = False
  884. ' Create a one time outgoing system message to syncronize packet size.
  885. If Not session.sendPacketSize Then
  886. SendExternalSystemMessage("blocksize:" & blockSize.ToString, session)
  887. session.sendPacketSize = True
  888. End If
  889. GetMoreFileBytesIfAvailable(session)
  890. ' Handle outgoing system stuff here
  891. If session.SystemBytesToBeSentAvailable = True Then
  892. HandleOutgoingInternalSystemMessage = True
  893. If session.SystemBytesToBeSent.Length > blockSize Then
  894. ' Send Channel
  895. tmp(0) = session.SystemOutputChannel
  896. Stream.Write(tmp, 0, 1)
  897. ' Send packet size
  898. _size = blockSize
  899. tmp = BitConverter.GetBytes(_size)
  900. Stream.Write(tmp, 0, 2)
  901. ' Send packet
  902. Stream.Write(GetSome(session.SystemBytesToBeSent, blockSize, session.SystemBytesToBeSentAvailable, session), 0, _size)
  903. session.bytesSentThisSecond += 3 + blockSize
  904. Else
  905. ' Send Channel
  906. tmp(0) = session.SystemOutputChannel
  907. Stream.Write(tmp, 0, 1)
  908. ' Send packet size
  909. _size = Convert.ToUInt16(session.SystemBytesToBeSent.Length)
  910. tmp = BitConverter.GetBytes(_size)
  911. Stream.Write(tmp, 0, 2)
  912. ' Send packet
  913. Stream.Write(session.SystemBytesToBeSent, 0, _size)
  914. session.bytesSentThisSecond += 3 + _size
  915. session.SystemBytesToBeSentAvailable = False
  916. End If
  917. End If
  918. End Function
  919. Private Function HandleOutgoingUserData(ByVal Stream As NetworkStream, ByVal session As SessionCommunications) As Boolean
  920. Dim tmp(1) As Byte
  921. Dim _size As UShort
  922. Dim notify As Boolean = False
  923. Static packet(0) As Byte
  924. Dim msg As message = Nothing
  925. Dim shutSessionDown As Boolean = False
  926. If Not session.UserBytesToBeSentAvailable Then
  927. If session.sendQueue.TryDequeue(msg) Then
  928. session.UserBytesToBeSentAvailable = True
  929. session.UserBytesToBeSent = New MemoryStream(msg.bytes)
  930. session.UserOutputChannel = msg.dataChannel
  931. End If
  932. End If
  933. If session.disConnect Then
  934. session.UserBytesToBeSentAvailable = True
  935. session.UserBytesToBeSent = New MemoryStream(StrToByteArray("close"))
  936. session.UserOutputChannel = 254
  937. shutSessionDown = True
  938. End If
  939. If session.UserBytesToBeSentAvailable = True Then
  940. Try
  941. If (session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position) > blockSize Then
  942. ' Send Channel
  943. tmp(0) = session.UserOutputChannel
  944. Stream.Write(tmp, 0, 1)
  945. ' Send packet size
  946. _size = blockSize
  947. tmp = BitConverter.GetBytes(_size)
  948. Stream.Write(tmp, 0, 2)
  949. ' Send packet
  950. If packet.Length <> _size Then ReDim packet(_size - 1)
  951. session.UserBytesToBeSent.Read(packet, 0, _size)
  952. 'session.theClient.NoDelay = True
  953. Stream.Write(packet, 0, _size)
  954. session.bytesSentThisSecond += 3 + _size
  955. ' Check to see if we've sent it all...
  956. If session.UserBytesToBeSent.Length = session.UserBytesToBeSent.Position Then
  957. session.UserBytesToBeSentAvailable = False
  958. notify = True
  959. End If
  960. Else
  961. ' Send Channel
  962. tmp(0) = session.UserOutputChannel
  963. Stream.Write(tmp, 0, 1)
  964. ' Send packet size
  965. _size = Convert.ToUInt16(session.UserBytesToBeSent.Length - session.UserBytesToBeSent.Position)
  966. tmp = BitConverter.GetBytes(_size)
  967. Stream.Write(tmp, 0, 2)
  968. ' Send packet
  969. If packet.Length <> _size Then ReDim packet(_size - 1)
  970. session.UserBytesToBeSent.Read(packet, 0, _size)
  971. 'session.theClient.NoDelay = True
  972. Stream.Write(packet, 0, _size)
  973. session.bytesSentThisSecond += 3 + _size
  974. session.UserBytesToBeSentAvailable = False
  975. notify = True
  976. End If
  977. Catch ex As Exception
  978. ' Report error attempting to send user data.
  979. Debug.WriteLine("Unexpected error in TcpCommServer\HandleOutgoingUserData: " & ex.Message)
  980. End Try
  981. ' Notify the user that the packet has been sent.
  982. If notify Then SystemMessage("UBS:" & session.sessionID & ":" & session.UserOutputChannel)
  983. ' This will drop execution out of the communications loop for this session, and
  984. ' begin this session's shutdown process.
  985. If shutSessionDown Then Throw New Exception("Shutting session down gracefully.")
  986. Return True
  987. Else
  988. Return False
  989. End If
  990. End Function
  991. Private Function GetSome(ByRef bytes() As Byte, ByVal chunkToBreakOff As Integer, _
  992. ByRef bytesToBeSentAvailable As Boolean, ByVal session As SessionCommunications, _
  993. Optional ByVal theseAreUserBytes As Boolean = False) As Byte()
  994. Dim tmp(chunkToBreakOff - 1) As Byte
  995. Array.Copy(bytes, 0, tmp, 0, chunkToBreakOff)
  996. GetSome = tmp
  997. If bytes.Length = chunkToBreakOff Then
  998. bytesToBeSentAvailable = False
  999. If theseAreUserBytes Then SystemMessage("UBS:" & session.sessionID & ":" & session.UserOutputChannel)
  1000. Else
  1001. Dim tmp2(bytes.Length - chunkToBreakOff - 1) As Byte
  1002. Array.Copy(bytes, chunkToBreakOff, tmp2, 0, bytes.Length - chunkToBreakOff)
  1003. bytes = tmp2
  1004. End If
  1005. End Function
  1006. Private Sub SystemMessage(ByVal MsgText As String)
  1007. Dim bgMsg As New Thread(AddressOf BgMessage)
  1008. bgMsg.IsBackground = True
  1009. bgMsg.Start(MsgText)
  1010. End Sub
  1011. Private Sub BgMessage(ByVal _text As Object)
  1012. Dim msg As String = CType(_text, String)
  1013. RcvBytes(StrToByteArray(msg), New SessionCommunications(New TcpClient, -1), 255)
  1014. End Sub
  1015. Private Sub SystemMessage(ByVal MsgText As String, ByVal sessionId As Int32)
  1016. RcvBytes(StrToByteArray(MsgText), New SessionCommunications(New TcpClient, sessionId), 255)
  1017. End Sub
  1018. ' Check to see if our app is closing (set in FormClosing event)
  1019. Private Function theServerIsStopping(ByVal Server As TcpClient, ByVal session As SessionCommunications) As Boolean
  1020. If Not continue_running Or session.disConnect Then
  1021. theServerIsStopping = True
  1022. Else
  1023. theServerIsStopping = False
  1024. End If
  1025. End Function
  1026. Private Sub theListener()
  1027. Try
  1028. ' Start listening
  1029. SystemMessage("Listening...")
  1030. Listener = New TcpListener(localAddr, Port)
  1031. Listener.Start()
  1032. StartAccept()
  1033. Catch ex As Exception
  1034. errMsg = ex.Message
  1035. serverState = currentState.err
  1036. Exit Sub
  1037. End Try
  1038. serverState = currentState.running
  1039. End Sub
  1040. Private Function StartAccept() As Boolean
  1041. Try
  1042. Listener.BeginAcceptTcpClient(AddressOf HandleAsyncConnection, Listener)
  1043. Return True
  1044. Catch ex As Exception
  1045. Return False
  1046. End Try
  1047. End Function
  1048. Private Sub HandleAsyncConnection(ByVal res As IAsyncResult)
  1049. Dim client As TcpClient
  1050. If Not StartAccept() Then Exit Sub
  1051. client = Listener.EndAcceptTcpClient(res)
  1052. Dim thisTask = System.Threading.Tasks.Task.Factory
  1053. thisTask.StartNew(Sub()
  1054. HandleNewConnection(client)
  1055. End Sub)
  1056. End Sub
  1057. Private sessionIdIncrementLock As New Object
  1058. Private Sub HandleNewConnection(ByVal client As TcpClient)
  1059. Dim thisSessionId As Int32 = -1
  1060. Dim session As SessionCommunications
  1061. thisSessionId = SessionCollection.GetReusableSessionID
  1062. If thisSessionId = -1 Then
  1063. SyncLock sessionIdIncrementLock
  1064. thisSessionId = newSessionId
  1065. newSessionId += 1
  1066. End SyncLock
  1067. End If
  1068. Dim newSession As New Thread(AddressOf Run)
  1069. session = New SessionCommunications(client, thisSessionId)
  1070. newSession.IsBackground = True
  1071. newSession.Name = "Server Session #" & thisSessionId
  1072. newSession.Start(session)
  1073. SessionCollection.AddSession(session)
  1074. 'SystemMessage("Connected.")
  1075. End Sub
  1076. Private Sub WrapUpIncomingFile(ByVal session As SessionCommunications)
  1077. If session.ReceivingFile Then
  1078. Try
  1079. session.fileWriter.Close()
  1080. session.fileWriter = Nothing
  1081. GC.GetTotalMemory(True)
  1082. Catch ex As Exception
  1083. End Try
  1084. Try
  1085. File.Delete(session.ReceivedFilesFolder & "\" & session.IncomingFileName)
  1086. Catch ex As Exception
  1087. End Try
  1088. End If
  1089. End Sub
  1090. Private Sub Run(ByVal _session As Object)
  1091. Dim session As SessionCommunications = DirectCast(_session, SessionCommunications)
  1092. session.sendQueue = New ConcurrentQueue(Of message)
  1093. session.messageIn = New SessionCommunications.MessageInQueue(ServerCallbackObject)
  1094. Dim Server As TcpClient
  1095. Dim Stream As NetworkStream
  1096. Dim IpEndPoint As IPEndPoint
  1097. Dim puck(1) As Byte : puck(0) = 0
  1098. Dim theBuffer(blockSize - 1) As Byte
  1099. Dim tmp(1) As Byte
  1100. Dim dataChannel As Byte = 0
  1101. Dim packetSize As UShort = 0
  1102. Dim idleTimer, bandwidthTimer As Date
  1103. Dim bytesread As Integer = 0
  1104. Dim weHaveThePuck As Boolean = True
  1105. Dim bandwidthUsedThisSecond As Int32 = 0
  1106. Dim userOrSystemSwitcher As Integer = 0
  1107. Try
  1108. ' Create a local Server and Stream objects for clarity.
  1109. Server = session.theClient
  1110. Stream = Server.GetStream()
  1111. Catch ex As Exception
  1112. ' An unexpected error.
  1113. Debug.WriteLine("Could not create local Server or Stream object in server. Message: " & ex.Message)
  1114. Exit Sub
  1115. End Try
  1116. Try
  1117. ' Get the remote machine's IP address.
  1118. IpEndPoint = CType(Server.Client.RemoteEndPoint, Net.IPEndPoint)
  1119. session.remoteIpAddress = IpEndPoint.Address
  1120. ' Set the send and receive buffers to the maximum
  1121. ' size allowable in this application...
  1122. Server.Client.ReceiveBufferSize = 65535
  1123. Server.Client.SendBufferSize = 65535
  1124. ' no delay on partially filled packets...
  1125. ' Send it all as fast as possible.
  1126. Server.NoDelay = True
  1127. ' Set the timers...
  1128. idleTimer = Now
  1129. bandwidthTimer = Now
  1130. session.IsRunning = True
  1131. SystemMessage("Connected.")
  1132. ' Start the communication loop
  1133. Do
  1134. ' Throttle network Mbps...
  1135. bandwidthUsedThisSecond = session.bytesSentThisSecond + session.bytesRecievedThisSecond
  1136. If bandwidthTimer.AddMilliseconds(250) >= Now And bandwidthUsedThisSecond >= (Mbps / 4) Then
  1137. While bandwidthTimer.AddMilliseconds(250) > Now
  1138. Thread.Sleep(0)
  1139. End While
  1140. End If
  1141. If bandwidthTimer.AddMilliseconds(250) <= Now Then
  1142. bandwidthTimer = Now
  1143. session.bytesRecievedThisSecond = 0
  1144. session.bytesSentThisSecond = 0
  1145. bandwidthUsedThisSecond = 0
  1146. End If
  1147. ' Normal communications...
  1148. If weHaveThePuck Then
  1149. ' Send data if there is any to be sent...
  1150. userOrSystemSwitcher += 1
  1151. Select Case userOrSystemSwitcher
  1152. Case 1
  1153. If Not session.paused Then
  1154. If HandleOutgoingUserData(Stream, session) Then idleTimer = Now
  1155. End If
  1156. Case 2
  1157. If HandleOutgoingInternalSystemMessage(Stream, session) Then idleTimer = Now
  1158. End Select
  1159. If userOrSystemSwitcher > 1 Then userOrSystemSwitcher = 0
  1160. ' After sending out data, send the puck
  1161. Stream.Write(puck, 0, 1)
  1162. weHaveThePuck = False
  1163. End If
  1164. If theBuffer.Length < 2 Then ReDim theBuffer(1)
  1165. ' Read in the control byte.
  1166. Stream.Read(theBuffer, 0, 1)
  1167. dataChannel = theBuffer(0)
  1168. ' If it's just the puck (communictaion syncronization byte),
  1169. ' set weHaveThePuck true, record the byte read for throttling,
  1170. ' and that's all. dataChannel 0 is reserved for the puck.
  1171. If dataChannel = 0 Then
  1172. weHaveThePuck = True
  1173. session.bytesRecievedThisSecond += 1
  1174. Else
  1175. ' It's not the puck: It's an incoming packet.
  1176. ' Get the packet size:
  1177. tmp(0) = Convert.ToByte(Stream.ReadByte)
  1178. tmp(1) = Convert.ToByte(Stream.ReadByte)
  1179. packetSize = BitConverter.ToUInt16(tmp, 0)
  1180. session.bytesRecievedThisSecond += 2
  1181. ' Get the packet:
  1182. If theBuffer.Length <> packetSize Then ReDim theBuffer(packetSize - 1)
  1183. Do
  1184. ' Read bytes in...
  1185. bytesread += Stream.Read(theBuffer, bytesread, (packetSize - bytesread))
  1186. Loop While bytesread < packetSize
  1187. bytesread = 0
  1188. ' Record bytes read for throttling...
  1189. session.bytesRecievedThisSecond += packetSize
  1190. ' Handle the packet...
  1191. If dataChannel > 250 Then
  1192. ' this is an internal system packet
  1193. If Not theServerIsStopping(Server, session) Then HandleIncomingSystemMessages(theBuffer, dataChannel, session)
  1194. Else
  1195. ' Hand user data off to the calling thread.
  1196. If Not theServerIsStopping(Server, session) Then RcvBytes(theBuffer, session, dataChannel)
  1197. End If
  1198. idleTimer = Now
  1199. End If
  1200. ' Throttle CPU usage when idle.
  1201. If Now > idleTimer.AddMilliseconds(500) Then
  1202. Thread.Sleep(50)
  1203. End If
  1204. Loop
  1205. Catch ex As Exception
  1206. ' An unexpected error.
  1207. Debug.WriteLine("Unexpected error in server: " & ex.Message)
  1208. End Try
  1209. Try
  1210. session.fileReader.Close()
  1211. Catch ex As Exception
  1212. End Try
  1213. Try
  1214. Server.Client.Close()
  1215. Server.Client.Blocking = False
  1216. Catch ex As Exception
  1217. End Try
  1218. ' If we're in the middle of receiving a file,
  1219. ' close the filestream, release the memory and
  1220. ' delete the partial file.
  1221. WrapUpIncomingFile(session)
  1222. session.IsRunning = False
  1223. session.machineId = ""
  1224. SystemMessage("Session Stopped. (" & session.sessionID.ToString & ")")
  1225. session.messageIn.Close()
  1226. SessionCollection.ReuseSessionNumber(session.sessionID)
  1227. End Sub
  1228. End Class
  1229. Public Class Client
  1230. Public errMsg As String
  1231. ' Define the delegate type
  1232. Public Delegate Sub ClientCallbackDelegate(ByVal bytes() As Byte, ByVal dataChannel As Byte)
  1233. ' Create Delegate pointer
  1234. Public ClientCallbackObject As ClientCallbackDelegate
  1235. Private continue_running As Boolean = False
  1236. Private bytes() As Byte
  1237. Private blockSize As UInt16
  1238. Private IP As System.Net.IPAddress
  1239. Private Port As Integer
  1240. Private localAddr As IPAddress
  1241. Private Client As TcpClient
  1242. Private Stream As NetworkStream
  1243. Private fileWriter As clsAsyncUnbuffWriter
  1244. Private fileReader As FileStream
  1245. Private FileBeingSentPath As String
  1246. Private weHaveThePuck As Boolean = False
  1247. Private isRunning As Boolean = False
  1248. Private UserBytesToBeSentAvailable As Boolean = False
  1249. Private UserBytesToBeSent As New MemoryStream
  1250. Private UserOutputChannel As Byte
  1251. Private SystemBytesToBeSentAvailable As Boolean = False
  1252. Private SystemBytesToBeSent() As Byte
  1253. Private SystemOutputChannel As Byte
  1254. Private SendingFile As Boolean = False
  1255. Private ReceivingFile As Boolean = False
  1256. Private IncomingFileName As String
  1257. Private IncomingFileSize As Int64 = 0
  1258. Private outgoingFileSize As UInt64 = 0
  1259. Private outgoingFileName As String
  1260. Private fileBytesRecieved As Int64 = 0
  1261. Private filebytesSent As Int64 = 0
  1262. Private bytesSentThisSecond As Int32 = 0
  1263. Private bytesReceivedThisSecond As Int32 = 0
  1264. Private mbpsOneSecondAverage() As Int32
  1265. Private ReceivedFilesFolder As String = System.Environment.GetFolderPath(Environment.SpecialFolder.CommonDesktopDirectory) & "\ClientReceivedFiles"
  1266. Private userName As String
  1267. Private password As String
  1268. Private machineId As String
  1269. Public Shared ReadOnly Property AssemblyDirectory() As String
  1270. Get
  1271. Dim codeBase As String = Assembly.GetExecutingAssembly().CodeBase
  1272. Dim uri__1 As New UriBuilder(codeBase)
  1273. Dim path__2 As String = Uri.UnescapeDataString(uri__1.Path)
  1274. Return Path.GetDirectoryName(path__2)
  1275. End Get
  1276. End Property
  1277. Private Class message
  1278. Public bytes() As Byte
  1279. Public dataChannel As Byte
  1280. End Class
  1281. Private Class MessageInQueue
  1282. Public queue As New ConcurrentQueue(Of message)
  1283. Private bgThread As New Threading.Thread(AddressOf Pump)
  1284. Private running As Boolean
  1285. Private callBack As ClientCallbackDelegate
  1286. Public Sub New(ByRef _callBack As ClientCallbackDelegate)
  1287. callBack = _callBack
  1288. running = True
  1289. bgThread.Start()
  1290. End Sub
  1291. Public Sub Close()
  1292. running = False
  1293. End Sub
  1294. Private Sub Pump()
  1295. Dim lastSuccessfullPump As New Date
  1296. Dim msg As message = Nothing
  1297. While running
  1298. If queue.TryDequeue(msg) Then
  1299. callBack(msg.bytes, msg.dataChannel)
  1300. lastSuccessfullPump = Now
  1301. End If
  1302. If Now > lastSuccessfullPump.AddMilliseconds(25) Then Thread.Sleep(1)
  1303. End While
  1304. End Sub
  1305. End Class
  1306. Private sendQueue As ConcurrentQueue(Of message)
  1307. Private mbpsSyncObject As New AutoResetEvent(False)
  1308. Private messageIn As MessageInQueue
  1309. Public Function isClientRunning() As Boolean
  1310. Return isRunning
  1311. End Function
  1312. Public Sub SetReceivedFilesFolder(ByVal _path As String)
  1313. ReceivedFilesFolder = _path
  1314. End Sub
  1315. Public Function GetIncomingFileName() As String
  1316. Return IncomingFileName
  1317. End Function
  1318. Public Function GetOutgoingFileName() As String
  1319. Return outgoingFileName
  1320. End Function
  1321. Public Function GetPercentOfFileReceived() As UInt16
  1322. If ReceivingFile Then
  1323. Return CUShort((fileBytesRecieved / IncomingFileSize) * 100)
  1324. Else
  1325. Return 0
  1326. End If
  1327. End Function
  1328. Public Function GetPercentOfFileSent() As UInt16
  1329. If SendingFile Then
  1330. Return CUShort((filebytesSent / outgoingFileSize) * 100)
  1331. Else
  1332. Return 0
  1333. End If
  1334. End Function
  1335. Public Function GetMbps() As String
  1336. Dim currentMbps As Decimal = CalculateMbps(True)
  1337. If currentMbps > 1000000 Then
  1338. Return (currentMbps / 1000000).ToString("N2") & " Mbps"
  1339. Else
  1340. Return (currentMbps / 1000).ToString("N2") & " Kbps"
  1341. End If
  1342. End Function
  1343. Public Function GetLocalIpAddress() As System.Net.IPAddress
  1344. Dim strHostName As String
  1345. Dim addresses() As System.Net.IPAddress
  1346. strHostName = System.Net.Dns.GetHostName()
  1347. addresses = System.Net.Dns.GetHostAddresses(strHostName)
  1348. ' Find an IpV4 address
  1349. For Each address As System.Net.IPAddress In addresses
  1350. ' Return the first IpV4 IP Address we find in the list.
  1351. If address.AddressFamily = AddressFamily.InterNetwork Then
  1352. Return address
  1353. End If
  1354. Next
  1355. ' No IpV4 address? Return the loopback address.
  1356. Return System.Net.IPAddress.Loopback
  1357. End Function
  1358. Private Function GetIPFromHostname(ByVal hostname As String, Optional ByVal returnLoopbackOnFail As Boolean = True) As System.Net.IPAddress
  1359. Dim addresses() As System.Net.IPAddress
  1360. Try
  1361. addresses = System.Net.Dns.GetHostAddresses(hostname)
  1362. Catch ex As Exception
  1363. If returnLoopbackOnFail Then Return System.Net.IPAddress.Loopback
  1364. Return Nothing
  1365. End Try
  1366. ' Find an IpV4 address
  1367. For Each address As System.Net.IPAddress In addresses
  1368. ' Return the first IpV4 IP Address we find in the list.
  1369. If address.AddressFamily = AddressFamily.InterNetwork Then
  1370. Return address
  1371. End If
  1372. Next
  1373. ' No IpV4 address? Return the loopback address.
  1374. If returnLoopbackOnFail Then Return System.Net.IPAddress.Loopback
  1375. Return Nothing
  1376. End Function
  1377. Public Sub New(ByRef callbackMethod As ClientCallbackDelegate)
  1378. blockSize = 10000
  1379. ' Initialize the delegate variable to point to the user's callback method.
  1380. ClientCallbackObject = callbackMethod
  1381. End Sub
  1382. Public Function Connect(ByVal IP_Address As String, ByVal prt As Integer, Optional ByVal newMachineID As String = "", _
  1383. Optional ByRef errorMessage As String = "") As Boolean
  1384. Try
  1385. ' Attempt to get the ip address by parsing the IP_Address string:
  1386. IP = System.Net.IPAddress.Parse(IP_Address)
  1387. Catch ex As Exception
  1388. ' We got an error - it's not an ip address.
  1389. ' Maybe it's a hostname.
  1390. IP = GetIPFromHostname(IP_Address, False)
  1391. End Try
  1392. If IP Is Nothing Then
  1393. ' Handle invalid IP address passed here.
  1394. errorMessage = "Could not connect to " & IP_Address & ". It is not a valid IP address or hostname on this network."
  1395. Return False
  1396. End If
  1397. Port = prt
  1398. continue_running = True
  1399. errMsg = ""
  1400. sendQueue = New ConcurrentQueue(Of message)
  1401. messageIn = New MessageInQueue(ClientCallbackObject)
  1402. Dim clientCommunicationThread As New Thread(AddressOf Run)
  1403. clientCommunicationThread.Name = "ClientCommunication"
  1404. clientCommunicationThread.Start()
  1405. If Not newMachineID.Equals("") Then
  1406. SetMachineID(newMachineID)
  1407. End If
  1408. ' Wait for connection...
  1409. While Not isRunning And errMsg = ""
  1410. Thread.Sleep(5)
  1411. End While
  1412. ' Are we connected?
  1413. errorMessage = errMsg
  1414. If Not isRunning Then
  1415. messageIn.Close()
  1416. Return False
  1417. End If
  1418. Return True
  1419. End Function
  1420. Public Sub Close()
  1421. continue_running = False
  1422. End Sub
  1423. Public Function GetBlocksize() As UInt16
  1424. Return blockSize
  1425. End Function
  1426. ''' <summary>
  1427. ''' Returns the size of the sendqueue. Returns -1 if isRunning = False.
  1428. ''' CAUTION: Calling this function too often will result in decreased performance, and failing to call it at all may result
  1429. ''' in an out of memory error. You can continue to add messages to the send queue for as long as the connection is active
  1430. ''' (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).
  1431. ''' </summary>
  1432. ''' <returns>An Int32</returns>
  1433. ''' <remarks></remarks>
  1434. Public Function GetSendQueueSize() As Int32
  1435. Dim sendQueueSize As Int32 = -1
  1436. If isRunning Then GetSendQueueSize = sendQueue.Count
  1437. Return sendQueueSize
  1438. End Function
  1439. Public Sub GetFile(ByVal _path As String)
  1440. sendQueue.Enqueue(New message With { _
  1441. .bytes = StrToByteArray("GFR:" & _path),
  1442. .dataChannel = 254
  1443. })
  1444. End Sub
  1445. Public Sub SendFile(ByVal _path As String)
  1446. sendQueue.Enqueue(New message With { _
  1447. .bytes = StrToByteArray("SFR:" & _path),
  1448. .dataChannel = 254
  1449. })
  1450. End Sub
  1451. Public Sub CancelIncomingFileTransfer()
  1452. sendQueue.Enqueue(New message With { _
  1453. .bytes = StrToByteArray("Abort->"),
  1454. .dataChannel = 254
  1455. })
  1456. FinishReceivingTheFile()
  1457. Dim killFileThread As New System.Threading.Thread(AddressOf KillIncomingFile)
  1458. killFileThread.Start(ReceivedFilesFolder & "\" & IncomingFileName)
  1459. End Sub
  1460. Private Sub KillIncomingFile(ByVal _path As Object)
  1461. Dim filePath As String = CType(_path, String)
  1462. Dim timeOut As New Stopwatch
  1463. timeOut.Start()
  1464. While timeOut.ElapsedMilliseconds < 1000
  1465. Try
  1466. If Not File.Exists(filePath) Then Exit While
  1467. File.Delete(filePath)
  1468. Catch ex As Exception
  1469. End Try
  1470. End While
  1471. End Sub
  1472. Public Sub CancelOutgoingFileTransfer()
  1473. sendQueue.Enqueue(New message With { _
  1474. .bytes = StrToByteArray("Abort<-"),
  1475. .dataChannel = 254
  1476. })
  1477. StopSendingTheFile()
  1478. End Sub
  1479. Public Sub SetMachineID(ByVal id As String)
  1480. machineId = id
  1481. sendQueue.Enqueue(New message With { _
  1482. .bytes = StrToByteArray("MachineID:" & id),
  1483. .dataChannel = 254
  1484. })
  1485. End Sub
  1486. Public Function GetErrorMessage() As String
  1487. Return errMsg
  1488. End Function
  1489. Public Function SendBytes(ByVal bytes() As Byte, Optional ByVal channel As Byte = 1, Optional ByRef errMsg As String = "") As Boolean
  1490. If channel = 0 Or channel > 250 Then
  1491. errMsg = "Data can not be sent using channel numbers less then 1 or greater then 250."
  1492. Return False
  1493. End If
  1494. If bytes Is Nothing Or bytes.Length = 0 Then
  1495. errMsg = "bytes() must contain more then 0 bytes, and not be nothing."
  1496. Return False
  1497. End If
  1498. sendQueue.Enqueue(New message With { _
  1499. .bytes = bytes,
  1500. .dataChannel = channel
  1501. })
  1502. Return True
  1503. End Function
  1504. ''' <summary>
  1505. ''' This is a convienience function that handles the work of converting the text you would like to send to a byte array.
  1506. ''' Passes back the return value and errMsg of SendBytes(). Returns True on success and False on falure. Check the errMsg
  1507. ''' string for send failure explanations.
  1508. ''' </summary>
  1509. ''' <param name="textMessage"></param>
  1510. ''' <param name="channel"></param>
  1511. ''' <param name="errMsg"></param>
  1512. ''' <returns></returns>
  1513. ''' <remarks></remarks>
  1514. Public Function SendText(ByVal textMessage As String, Optional ByVal channel As Byte = 1, _
  1515. Optional ByRef errMsg As String = "") As Boolean
  1516. If textMessage = "" Then
  1517. errMsg = "Your text message must contain some text."
  1518. Return False
  1519. End If
  1520. Return SendBytes(StrToByteArray(textMessage), channel, errMsg)
  1521. End Function
  1522. Private Function RcvBytes(ByVal data() As Byte, Optional ByVal dataChannel As Byte = 1) As Boolean
  1523. ' dataType: >0 = data channel, 251 and up = internal messages. 0 is an invalid channel number (it's the puck)
  1524. If dataChannel < 1 Or Not continue_running Then Return False
  1525. Try
  1526. Dim passedData(data.Length - 1) As Byte
  1527. Array.Copy(data, passedData, data.Length)
  1528. messageIn.queue.Enqueue(New message With { _
  1529. .bytes = passedData,
  1530. .dataChannel = dataChannel
  1531. })
  1532. 'ClientCallbackObject(data, datachannel)
  1533. Catch ex As Exception
  1534. ' An unexpected error.
  1535. Debug.WriteLine("Unexpected error in Client\RcvBytes: " & ex.Message)
  1536. Return False
  1537. End Try
  1538. Return True
  1539. End Function
  1540. Private Function CreateFolders(ByVal _path As String) As Boolean
  1541. CreateFolders = True
  1542. Dim parts() As String
  1543. Dim path As String = ""
  1544. Dim count As Int32
  1545. parts = Split(_path, "\")
  1546. path = parts(0)
  1547. For count = 1 To parts.Length - 2
  1548. path += "\" & parts(count)
  1549. Try
  1550. If Not Directory.Exists(path) Then
  1551. Directory.CreateDirectory(path)
  1552. End If
  1553. Catch ex As Exception
  1554. End Try
  1555. Next
  1556. End Function
  1557. Private Sub SendExternalSystemMessage(ByVal message As String)
  1558. SystemBytesToBeSent = StrToByteArray(message)
  1559. SystemOutputChannel = 254 ' Text messages / commands on channel 254
  1560. SystemBytesToBeSentAvailable = True
  1561. End Sub
  1562. Private Function BeginToReceiveAFile(ByVal _path As String) As Boolean
  1563. Dim readBuffer As Int32 = 0
  1564. ReceivingFile = True
  1565. BeginToReceiveAFile = True
  1566. fileBytesRecieved = 0
  1567. Try
  1568. CreateFolders(_path)
  1569. fileWriter = New clsAsyncUnbuffWriter(_path, True, _
  1570. 1024 * (clsAsyncUnbuffWriter.GetPageSize()), IncomingFileSize)
  1571. Catch ex As Exception
  1572. _path = ex.Message
  1573. ReceivingFile = False
  1574. End Try
  1575. If Not ReceivingFile Then
  1576. Try
  1577. fileWriter.Close()
  1578. Catch ex As Exception
  1579. End Try
  1580. Return False
  1581. End If
  1582. End Function
  1583. Private Function HandleIncomingFileBytes(ByRef bytes() As Byte) As Boolean
  1584. Try
  1585. fileWriter.Write(bytes, bytes.Length)
  1586. HandleIncomingFileBytes = True
  1587. Catch ex As Exception
  1588. HandleIncomingFileBytes = False
  1589. End Try
  1590. End Function
  1591. Private Sub FinishReceivingTheFile()
  1592. Try
  1593. fileWriter.Close()
  1594. fileWriter = Nothing
  1595. ReceivingFile = False
  1596. Catch ex As Exception
  1597. ReceivingFile = False
  1598. End Try
  1599. End Sub
  1600. Private Sub StopSendingTheFile()
  1601. Try
  1602. SendingFile = False
  1603. fileReader.Close()
  1604. fileReader = Nothing
  1605. GC.GetTotalMemory(True)
  1606. Catch ex As Exception
  1607. SendingFile = False
  1608. GC.GetTotalMemory(True)
  1609. End Try
  1610. End Sub
  1611. Private Sub WrapUpIncomingFile()
  1612. If ReceivingFile Then
  1613. Try
  1614. fileWriter.Close()
  1615. fileWriter = Nothing
  1616. GC.GetTotalMemory(True)
  1617. Catch ex As Exception
  1618. End Try
  1619. Try
  1620. File.Delete(ReceivedFilesFolder & "\" & IncomingFileName)
  1621. Catch ex As Exception
  1622. End Try
  1623. End If
  1624. End Sub
  1625. Private Function CheckSessionPermissions(ByVal cmd As String) As Boolean
  1626. ' Your security code here...
  1627. Return True
  1628. End Function
  1629. Private Function BeginFileSend(ByVal _path As String, ByVal fileLength As Long) As Boolean
  1630. filebytesSent = 0
  1631. Try
  1632. fileReader = New FileStream(_path, FileMode.Open, FileAccess.Read, FileShare.None, clsAsyncUnbuffWriter.GetPageSize)
  1633. SendingFile = True
  1634. BeginFileSend = True
  1635. Catch ex As Exception
  1636. BeginFileSend = False
  1637. _path = ex.Message
  1638. SendingFile = False
  1639. End Try
  1640. Try
  1641. If Not BeginFileSend Then fileReader.Close()
  1642. Catch ex As Exception
  1643. End Try
  1644. End Function
  1645. Private Sub GetMoreFileBytesIfAvailable()
  1646. Dim bytesRead As Integer
  1647. If SendingFile And Not SystemBytesToBeSentAvailable Then
  1648. Try
  1649. If SystemBytesToBeSent.Length <> blockSize Then ReDim SystemBytesToBeSent(blockSize - 1)
  1650. bytesRead = fileReader.Read(SystemBytesToBeSent, 0, blockSize)
  1651. If bytesRead <> blockSize Then ReDim Preserve SystemBytesToBeSent(bytesRead - 1)
  1652. If bytesRead > 0 Then
  1653. SystemOutputChannel = 252 ' File transfer from client to server
  1654. SystemBytesToBeSentAvailable = True
  1655. filebytesSent += bytesRead
  1656. Else
  1657. ReDim SystemBytesToBeSent(blockSize - 1)
  1658. SendExternalSystemMessage("<-Done") ' Send the server a completion notice.
  1659. SystemMessage("<-Done")
  1660. SendingFile = False
  1661. ' Clean up
  1662. fileReader.Close()
  1663. fileReader = Nothing
  1664. GC.GetTotalMemory(True)
  1665. End If
  1666. Catch ex As Exception
  1667. SendExternalSystemMessage("ERR: " & ex.Message)
  1668. ' We're finished.
  1669. ReDim SystemBytesToBeSent(blockSize - 1)
  1670. SendingFile = False
  1671. fileReader.Close()
  1672. End Try
  1673. End If
  1674. End Sub
  1675. Private Function GetFilenameFromPath(ByVal filePath As String) As String
  1676. Dim filePathParts() As String
  1677. If filePath.Trim = "" Then Return ""
  1678. filePathParts = Split(filePath, "\")
  1679. GetFilenameFromPath = filePathParts(filePathParts.Length - 1)
  1680. End Function
  1681. Private Sub HandleIncomingSystemMessages(ByVal bytes() As Byte, ByVal channel As Byte)
  1682. If channel = 254 Then ' Text commands / messages passed between server and client
  1683. Dim message As String = BytesToString(bytes)
  1684. Dim tmp As String = ""
  1685. Dim filePath As String
  1686. ' Get File Request: The server wants us to send them a file.
  1687. If message.Length > 4 Then tmp = message.Substring(0, 4)
  1688. If tmp = "GFR:" Then ' Get File Request
  1689. ' Get file path...
  1690. filePath = message.Substring(4, message.Length - 4)
  1691. ' Does it exist?
  1692. If File.Exists(message.Substring(4, message.Length - 4)) Then
  1693. ' Are we already busy sending them a file?
  1694. If Not SendingFile Then
  1695. Dim _theFilesInfo As New FileInfo(filePath)
  1696. outgoingFileName = GetFilenameFromPath(filePath)
  1697. outgoingFileSize = CULng(_theFilesInfo.Length)
  1698. If BeginFileSend(filePath, _theFilesInfo.Length) Then
  1699. ' Send only the file NAME. It will have a different path on the other side.
  1700. SendExternalSystemMessage("Sending:" & outgoingFileName & _
  1701. ":" & outgoingFileSize.ToString)
  1702. SystemMessage("Sending file:" & outgoingFileName)
  1703. Else
  1704. ' FilePath contains the error message.
  1705. SendExternalSystemMessage("ERR: " & filePath)
  1706. End If
  1707. Else
  1708. ' There's already a GFR in progress.
  1709. SendExternalSystemMessage("ERR: File: ''" & _
  1710. FileBeingSentPath & _
  1711. "'' is still in progress. Only one file " & _
  1712. "may be transfered (from client to server) at a time.")
  1713. End If
  1714. Else
  1715. ' File doesn't exist. Send an error.
  1716. SendExternalSystemMessage("ERR: The requested file can not be found by the server.")
  1717. End If
  1718. End If
  1719. If message.Length > 7 Then tmp = message.Substring(0, 8)
  1720. If tmp = "Sending:" Then
  1721. ' Strip away the headder...
  1722. Dim msgParts() As String = Split(message, ":")
  1723. IncomingFileSize = Convert.ToInt64(msgParts(2))
  1724. IncomingFileName = msgParts(1)
  1725. tmp = ReceivedFilesFolder & "\" & IncomingFileName
  1726. SystemMessage("Receiving file: " & IncomingFileName)
  1727. If Not BeginToReceiveAFile(tmp) Then
  1728. SystemMessage("ERR: " & tmp)
  1729. SendExternalSystemMessage("Abort<-")
  1730. End If
  1731. End If
  1732. If message.Length > 10 Then tmp = message.Substring(0, 10)
  1733. If tmp = "blocksize:" Then
  1734. Dim msgParts() As String = Split(message, ":")
  1735. blockSize = Convert.ToUInt16(msgParts(1))
  1736. End If
  1737. If message = "->Done" Then
  1738. FinishReceivingTheFile()
  1739. SystemMessage("->Done")
  1740. End If
  1741. ' We've been notified that no file data will be forthcoming.
  1742. If message = "Abort->" Then
  1743. FinishReceivingTheFile()
  1744. SystemMessage("->Aborted.")
  1745. Process.GetCurrentProcess().PriorityClass = ProcessPriorityClass.Normal
  1746. Try
  1747. File.Delete(ReceivedFilesFolder & "\" & IncomingFileName)
  1748. Catch ex As Exception
  1749. End Try
  1750. End If
  1751. ' Send File Request: The server wants to send us a file.
  1752. If message.Length > 4 Then tmp = message.Substring(0, 4)
  1753. If tmp = "SFR:" Then
  1754. If CheckSessionPermissions("SFR") Then
  1755. Dim parts() As String
  1756. parts = Split(message, "SFR:")
  1757. SendExternalSystemMessage("GFR:" & parts(1))
  1758. Else
  1759. ' This user doesn't have rights to this file. Send an error.
  1760. SendExternalSystemMessage("ERR: You do not have permission to send files. Access Denied.")
  1761. End If
  1762. End If
  1763. ' Notification that the server has complied with our
  1764. ' request to stop sending bytes for this
  1765. ' (server->client) file transfer.
  1766. If message = "->Aborted." Then
  1767. SystemMessage("->Aborted.")
  1768. WrapUpIncomingFile()
  1769. End If
  1770. ' Notification that the server has complied with our
  1771. ' request to stop recieving bytes for this
  1772. ' (client->server) file transfer.
  1773. If message = "<-Aborted." Then
  1774. SystemMessage("<-Aborted.")
  1775. End If
  1776. If message.Length > 4 Then tmp = message.Substring(0, 4)
  1777. If tmp = "ERR:" Then ' The server has sent us an error message.
  1778. ' Pass it on up to the user.
  1779. SystemMessage(message)
  1780. End If
  1781. ' New queue throttling code
  1782. If message = "pause" Then
  1783. 'sendBuffer.PauseSending()
  1784. End If
  1785. If message = "resume" Then
  1786. 'sendBuffer.ResumeSending()
  1787. End If
  1788. ' Preform gracefull shutdown.
  1789. If message = "close" Then
  1790. Throw New Exception("Server initiated gracefull shutdown.")
  1791. End If
  1792. ElseIf channel = 253 Then ' File transfer from server to client
  1793. Try
  1794. If ReceivingFile Then
  1795. HandleIncomingFileBytes(bytes)
  1796. fileBytesRecieved += bytes.LongLength
  1797. End If
  1798. Catch ex As Exception
  1799. End Try
  1800. ElseIf channel = 252 Then ' File transfer from client to server
  1801. ElseIf channel = 251 Then ' reserved.
  1802. End If
  1803. End Sub
  1804. Private Function HandleOutgoingInternalSystemMessage() As Boolean
  1805. Dim tmp(1) As Byte
  1806. HandleOutgoingInternalSystemMessage = False
  1807. Dim _size As Integer
  1808. GetMoreFileBytesIfAvailable()
  1809. ' Handle outgoing system stuff here
  1810. If SystemBytesToBeSentAvailable = True Then
  1811. HandleOutgoingInternalSystemMessage = True
  1812. If SystemBytesToBeSent.Length > blockSize Then
  1813. ' Send Channel
  1814. tmp(0) = SystemOutputChannel
  1815. Stream.Write(tmp, 0, 1)
  1816. bytesSentThisSecond += 1
  1817. ' Send packet size
  1818. _size = blockSize
  1819. tmp = BitConverter.GetBytes(_size)
  1820. Stream.Write(tmp, 0, 2)
  1821. bytesSentThisSecond += 2
  1822. ' Send packet
  1823. Stream.Write(GetSome(SystemBytesToBeSent, blockSize, SystemBytesToBeSentAvailable), 0, _size)
  1824. bytesSentThisSecond += _size
  1825. Else
  1826. ' Send Channel
  1827. tmp(0) = SystemOutputChannel
  1828. Stream.Write(tmp, 0, 1)
  1829. bytesSentThisSecond += 1
  1830. ' Send packet size
  1831. _size = SystemBytesToBeSent.Length
  1832. tmp = BitConverter.GetBytes(_size)
  1833. Stream.Write(tmp, 0, 2)
  1834. bytesSentThisSecond += 2
  1835. ' Send packet
  1836. Stream.Write(SystemBytesToBeSent, 0, _size)
  1837. bytesSentThisSecond += _size
  1838. SystemBytesToBeSentAvailable = False
  1839. End If
  1840. End If
  1841. End Function
  1842. Private Function HandleOutgoingUserData() As Boolean
  1843. Dim tmp(1) As Byte
  1844. Dim _size As UShort
  1845. Dim notify As Boolean = False
  1846. Static packet(0) As Byte
  1847. Dim msg As message = Nothing
  1848. Dim stopMessageSent As Boolean = False
  1849. If Not UserBytesToBeSentAvailable Then
  1850. If sendQueue.TryDequeue(msg) Then
  1851. UserBytesToBeSentAvailable = True
  1852. UserBytesToBeSent = New MemoryStream(msg.bytes)
  1853. UserOutputChannel = msg.dataChannel
  1854. End If
  1855. End If
  1856. If theClientIsStopping() Then
  1857. UserBytesToBeSentAvailable = True
  1858. UserBytesToBeSent = New MemoryStream(StrToByteArray("close"))
  1859. UserOutputChannel = 254
  1860. stopMessageSent = True
  1861. End If
  1862. If UserBytesToBeSentAvailable = True Then
  1863. Try
  1864. If (UserBytesToBeSent.Length - UserBytesToBeSent.Position) > blockSize Then
  1865. ' Send Channel
  1866. tmp(0) = UserOutputChannel
  1867. Stream.Write(tmp, 0, 1)
  1868. ' Send packet size
  1869. _size = blockSize
  1870. tmp = BitConverter.GetBytes(_size)
  1871. Stream.Write(tmp, 0, 2)
  1872. ' Send packet
  1873. If packet.Length <> _size Then ReDim packet(_size - 1)
  1874. UserBytesToBeSent.Read(packet, 0, _size)
  1875. 'Client.NoDelay = True
  1876. Stream.Write(packet, 0, _size)
  1877. bytesSentThisSecond += 3 + _size
  1878. ' Check to see if we've sent it all...
  1879. If UserBytesToBeSent.Length = UserBytesToBeSent.Position Then
  1880. UserBytesToBeSentAvailable = False
  1881. notify = True
  1882. End If
  1883. Else
  1884. ' Send Channel
  1885. tmp(0) = UserOutputChannel
  1886. Stream.Write(tmp, 0, 1)
  1887. ' Send packet size
  1888. _size = Convert.ToUInt16(UserBytesToBeSent.Length - UserBytesToBeSent.Position)
  1889. tmp = BitConverter.GetBytes(_size)
  1890. Stream.Write(tmp, 0, 2)
  1891. ' Send packet
  1892. If packet.Length <> _size Then ReDim packet(_size - 1)
  1893. UserBytesToBeSent.Read(packet, 0, _size)
  1894. 'Client.NoDelay = True
  1895. Stream.Write(packet, 0, _size)
  1896. bytesSentThisSecond += 3 + _size
  1897. UserBytesToBeSentAvailable = False
  1898. notify = True
  1899. End If
  1900. Catch ex As Exception
  1901. ' Report error attempting to send user data.
  1902. Debug.WriteLine("Unexpected error in TcpCommClient\HandleOutgoingUserData: " & ex.Message)
  1903. End Try
  1904. ' Notify the user that the packet has been sent.
  1905. If notify Then SystemMessage("UBS:" & UserOutputChannel)
  1906. If stopMessageSent Then Throw New Exception("Client closing gracefully.")
  1907. Return True
  1908. Else
  1909. Return False
  1910. End If
  1911. End Function
  1912. Private Function GetSome(ByRef bytes() As Byte, ByVal chunkToBreakOff As Integer, _
  1913. ByRef bytesToBeSentAvailable As Boolean, _
  1914. Optional ByVal theseAreUserBytes As Boolean = False) As Byte()
  1915. Dim tmp(chunkToBreakOff - 1) As Byte
  1916. Array.Copy(bytes, 0, tmp, 0, chunkToBreakOff)
  1917. GetSome = tmp
  1918. If bytes.Length = chunkToBreakOff Then
  1919. bytesToBeSentAvailable = False
  1920. If theseAreUserBytes Then SystemMessage("UBS")
  1921. Else
  1922. Dim tmp2(bytes.Length - chunkToBreakOff - 1) As Byte
  1923. Array.Copy(bytes, chunkToBreakOff, tmp2, 0, bytes.Length - chunkToBreakOff)
  1924. bytes = tmp2
  1925. End If
  1926. End Function
  1927. Private Sub SystemMessage(ByVal MsgText As String)
  1928. RcvBytes(StrToByteArray(MsgText), 255)
  1929. End Sub
  1930. ' Check to see if our app is closing (set in FormClosing event)
  1931. Private Function theClientIsStopping() As Boolean
  1932. If continue_running = False Then
  1933. theClientIsStopping = True
  1934. Else
  1935. theClientIsStopping = False
  1936. End If
  1937. End Function
  1938. Private Function CalculateMbps(Optional ByVal GetMbps As Boolean = False) As Decimal
  1939. Static averagesCounter As Integer = 0
  1940. Static tmr As Date = Now
  1941. Static lastread As Int32 = 0
  1942. Dim looper As Short = 0
  1943. Dim tmp As Int32 = 0
  1944. If mbpsOneSecondAverage Is Nothing Then ReDim mbpsOneSecondAverage(9)
  1945. If Now >= tmr.AddMilliseconds(250) Then
  1946. averagesCounter += 1
  1947. If averagesCounter < 0 Then averagesCounter = 0
  1948. Select Case averagesCounter
  1949. Case 0
  1950. SyncLock (mbpsSyncObject)
  1951. Try
  1952. mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond
  1953. bytesSentThisSecond = 0
  1954. bytesReceivedThisSecond = 0
  1955. Catch ex As Exception
  1956. averagesCounter = -1
  1957. End Try
  1958. End SyncLock
  1959. Case 1
  1960. SyncLock (mbpsSyncObject)
  1961. Try
  1962. mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond
  1963. bytesSentThisSecond = 0
  1964. bytesReceivedThisSecond = 0
  1965. Catch ex As Exception
  1966. averagesCounter = -1
  1967. End Try
  1968. End SyncLock
  1969. Case 2
  1970. SyncLock (mbpsSyncObject)
  1971. Try
  1972. mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond
  1973. bytesSentThisSecond = 0
  1974. bytesReceivedThisSecond = 0
  1975. Catch ex As Exception
  1976. averagesCounter = -1
  1977. End Try
  1978. End SyncLock
  1979. Case 3
  1980. SyncLock (mbpsSyncObject)
  1981. Try
  1982. mbpsOneSecondAverage(averagesCounter) = bytesSentThisSecond + bytesReceivedThisSecond
  1983. bytesSentThisSecond = 0
  1984. bytesReceivedThisSecond = 0
  1985. Catch ex As Exception
  1986. averagesCounter = -1
  1987. End Try
  1988. End SyncLock
  1989. End Select
  1990. If averagesCounter > 2 Then averagesCounter = -1
  1991. tmr = Now
  1992. End If
  1993. ' Did they ask us for the Mbps?
  1994. If GetMbps Then
  1995. For looper = 0 To 3
  1996. SyncLock (mbpsSyncObject)
  1997. tmp += mbpsOneSecondAverage(looper)
  1998. End SyncLock
  1999. Next
  2000. CalculateMbps = tmp
  2001. Else
  2002. CalculateMbps = 0
  2003. End If
  2004. End Function
  2005. Private Sub Run()
  2006. Dim puck(1) As Byte : puck(0) = 0
  2007. Dim theBuffer(blockSize - 1) As Byte
  2008. Dim tmp(1) As Byte
  2009. Dim dataChannel As Byte = 0
  2010. Dim packetSize As UShort = 0
  2011. Dim bytesread As Integer
  2012. Dim userOrSystemSwitcher As Integer = 0
  2013. Dim PercentUsage As Short = -1
  2014. Dim connectionLossTimer As Date
  2015. Dim CPUutil As New CpuMonitor
  2016. CPUutil.Start()
  2017. Try
  2018. Client = New TcpClient
  2019. Client.Connect(IP, Port)
  2020. ' Connection Accepted.
  2021. Stream = Client.GetStream()
  2022. ' Set the send and receive buffers to the maximum
  2023. ' size allowable in this application...
  2024. Client.Client.ReceiveBufferSize = 65535
  2025. Client.Client.SendBufferSize = 65535
  2026. ' no delay on partially filled packets...
  2027. ' Send it all as fast as possible.
  2028. Client.NoDelay = True
  2029. ' Pass a message up to the user about our status.
  2030. isRunning = True
  2031. SystemMessage("Connected.")
  2032. ' Start the communication loop
  2033. Do
  2034. ' Check to see if our app is shutting down.
  2035. 'If theClientIsStopping() Then Exit Do
  2036. ' Normal communications...
  2037. If weHaveThePuck Then
  2038. ' Send user data if there is any to be sent.
  2039. userOrSystemSwitcher += 1
  2040. Select Case userOrSystemSwitcher
  2041. Case 1
  2042. HandleOutgoingUserData()
  2043. Case 2
  2044. HandleOutgoingInternalSystemMessage()
  2045. End Select
  2046. If userOrSystemSwitcher > 1 Then userOrSystemSwitcher = 0
  2047. ' After sending our data, send the puck
  2048. Stream.Write(puck, 0, 1)
  2049. ' Uncomment this to see control bit traffic as part of your Mbps
  2050. 'bytesSentThisSecond += 1
  2051. weHaveThePuck = False
  2052. End If
  2053. If theBuffer.Length < 2 Then ReDim theBuffer(1)
  2054. ' Read in the control byte.
  2055. Stream.Read(theBuffer, 0, 1)
  2056. dataChannel = theBuffer(0)
  2057. ' Uncomment this to see control bit traffic as part of your Mbps
  2058. 'bytesReceivedThisSecond += 1
  2059. ' If it's just the puck (communictaion syncronization byte),
  2060. ' set weHaveThePuck true and that's all. dataChannel 0 is
  2061. ' reserved for the puck.
  2062. If dataChannel = 0 Then
  2063. weHaveThePuck = True
  2064. Else
  2065. ' It's not the puck: It's an incoming packet.
  2066. ' Get the packet size:
  2067. tmp(0) = Convert.ToByte(Stream.ReadByte)
  2068. tmp(1) = Convert.ToByte(Stream.ReadByte)
  2069. packetSize = BitConverter.ToUInt16(tmp, 0)
  2070. If theBuffer.Length <> packetSize Then ReDim theBuffer(packetSize - 1)
  2071. bytesReceivedThisSecond += 2
  2072. ' Get the packet:
  2073. connectionLossTimer = Now
  2074. Do
  2075. ' Read bytes in...
  2076. bytesread += Stream.Read(theBuffer, bytesread, (packetSize - bytesread))
  2077. ' If it takes longer then 3 seconds to get a packet, we've lost connection.
  2078. If connectionLossTimer.AddSeconds(3) < Now Then Exit Try
  2079. Loop While bytesread < packetSize
  2080. bytesread = 0
  2081. ' Record bytes read for throttling...
  2082. bytesReceivedThisSecond += packetSize
  2083. ' Handle the packet...
  2084. If dataChannel > 250 Then
  2085. ' this is an internal system packet
  2086. HandleIncomingSystemMessages(theBuffer, dataChannel)
  2087. Else
  2088. ' Hand data off to the calling thread.
  2089. RcvBytes(theBuffer, dataChannel)
  2090. End If
  2091. End If
  2092. CalculateMbps(False)
  2093. ' Measure and display the CPU usage of the client (this thread).
  2094. If PercentUsage <> CPUutil.ThreadUsage Then
  2095. PercentUsage = CPUutil.ThreadUsage
  2096. SystemMessage("" & PercentUsage & "% Thread Usage (" & CPUutil.CPUusage & "% across all CPUs)")
  2097. End If
  2098. Loop
  2099. Catch ex As Exception
  2100. ' An unexpected error.
  2101. errMsg = "Error in run thread: " & ex.Message
  2102. End Try
  2103. Try
  2104. fileWriter.Close()
  2105. Catch ex As Exception
  2106. End Try
  2107. Try
  2108. CPUutil.StopWatcher()
  2109. Client.Client.Close()
  2110. SystemMessage("Disconnected.")
  2111. Catch ex As Exception
  2112. ' An unexpected error.
  2113. Debug.WriteLine("Unexpected error in Client\theClientIsStopping: " & ex.Message)
  2114. End Try
  2115. WrapUpIncomingFile()
  2116. isRunning = False
  2117. messageIn.Close()
  2118. End Sub
  2119. End Class
  2120. Private Class CpuMonitor
  2121. Private Class Win32
  2122. <DllImport("kernel32.dll")> _
  2123. Public Shared Function GetCurrentThreadId() As Integer
  2124. End Function
  2125. End Class
  2126. Private NativeThreadID As Integer
  2127. Private WatcherRunning As Boolean = False
  2128. Private th1 As Thread
  2129. Private _CPUusage As Double
  2130. Private _ThreadUsage As Double
  2131. Public Sub New()
  2132. NativeThreadID = Win32.GetCurrentThreadId
  2133. End Sub
  2134. Public Sub New(ByVal _NativeThreadID As Int16)
  2135. NativeThreadID = _NativeThreadID
  2136. End Sub
  2137. Private Function GetCurrentNativeThreadID() As Integer
  2138. GetCurrentNativeThreadID = Win32.GetCurrentThreadId
  2139. End Function
  2140. ' Set the native ID of a process thread to be watched, or get your native thread id
  2141. Public Property GetNativeThreadID() As Integer
  2142. Get
  2143. Return GetCurrentNativeThreadID()
  2144. End Get
  2145. Set(ByVal value As Integer)
  2146. NativeThreadID = value
  2147. End Set
  2148. End Property
  2149. Public ReadOnly Property IsRunning() As Boolean
  2150. Get
  2151. Return WatcherRunning
  2152. End Get
  2153. End Property
  2154. Public ReadOnly Property ThreadUsage() As Short
  2155. Get
  2156. Return CShort(_ThreadUsage)
  2157. End Get
  2158. End Property
  2159. Public ReadOnly Property CPUusage() As Short
  2160. Get
  2161. Return CShort(_CPUusage)
  2162. End Get
  2163. End Property
  2164. Public Sub StopWatcher()
  2165. WatcherRunning = False
  2166. End Sub
  2167. Public Sub Start()
  2168. th1 = New System.Threading.Thread(AddressOf StartWatcher)
  2169. th1.Start()
  2170. End Sub
  2171. Private Sub StartWatcher()
  2172. 'Dim threadCollection As System.Diagnostics.ProcessThreadCollection
  2173. Dim threadCollection As System.Diagnostics.ProcessThreadCollection
  2174. Dim CPUs, t As Int16
  2175. Dim count, managedThreadID As Integer
  2176. Dim CPUtimeEnd, CPUtimeStart, CurrentTimeSpent, onePercent, average(4), tmp As Double
  2177. CPUs = Convert.ToInt16(Environment.GetEnvironmentVariable("NUMBER_OF_PROCESSORS"))
  2178. threadCollection = System.Diagnostics.Process.GetCurrentProcess().Threads
  2179. managedThreadID = 0
  2180. For count = 0 To threadCollection.Count - 1
  2181. If threadCollection.Item(count).Id = NativeThreadID Then
  2182. managedThreadID = count
  2183. End If
  2184. Next
  2185. If managedThreadID = 0 Then
  2186. ' An unexpected error.
  2187. Debug.WriteLine("Unexpected error in ThreadCPUusageWatcher\StartWatcher: Thread could not be found.")
  2188. Exit Sub
  2189. End If
  2190. WatcherRunning = True
  2191. count = 0
  2192. Try
  2193. onePercent = 2
  2194. Do While WatcherRunning = True
  2195. ' Check the cpu usage every 200 msecs...
  2196. CPUtimeStart = threadCollection.Item(managedThreadID).TotalProcessorTime.TotalMilliseconds
  2197. Thread.Sleep(200)
  2198. CPUtimeEnd = threadCollection.Item(managedThreadID).TotalProcessorTime.TotalMilliseconds
  2199. ' Average the thread's CPU usage out over 1 second...
  2200. CurrentTimeSpent = CPUtimeEnd - CPUtimeStart
  2201. average(count) = CurrentTimeSpent / onePercent
  2202. count += 1
  2203. tmp = 0
  2204. For t = 0 To 4
  2205. tmp += average(t)
  2206. Next
  2207. tmp = tmp / 5
  2208. _ThreadUsage = tmp
  2209. If _ThreadUsage > 100 Then _ThreadUsage = 100
  2210. _CPUusage = _ThreadUsage / CPUs
  2211. If count = 5 Then
  2212. count = 0
  2213. End If
  2214. Loop
  2215. Catch ex As Exception
  2216. ' An unexpected error.
  2217. Debug.WriteLine("Unexpected error in ThreadCPUusageWatcher\StartWatcher: " & ex.Message)
  2218. End Try
  2219. End Sub
  2220. End Class
  2221. Public Class ServerRequest
  2222. Private serverIp As String
  2223. Private port As Integer
  2224. Private un As String
  2225. Private pw As String
  2226. Private serverReply As String
  2227. Private replyComplete As Boolean
  2228. Private request As String
  2229. Private thisReplyList As List(Of String)
  2230. Public Sub New(ByVal _serverIpAddress As String, ByVal _serverPort As Integer)
  2231. serverIp = _serverIpAddress
  2232. port = _serverPort
  2233. serverReply = ""
  2234. replyComplete = False
  2235. End Sub
  2236. Public Sub ImportReplyString(ByVal replyString As String)
  2237. serverReply = replyString
  2238. End Sub
  2239. Public Sub AddRequestItem(ByVal key As String, ByVal value As String, Optional ByVal separator As String = vbCrLf)
  2240. If request = "" Then request = separator
  2241. If key <> "" And value <> "" Then
  2242. request += key & "=" & value & separator
  2243. End If
  2244. End Sub
  2245. Public Function Send(Optional ByVal timeoutSeconds As Integer = 5, Optional ByRef errMsg As String = "") As Boolean
  2246. If request.Length > 0 Then
  2247. If thisReplyList IsNot Nothing Then thisReplyList.Clear()
  2248. serverReply = ""
  2249. Dim reply As String = SendRequest(request, timeoutSeconds, errMsg)
  2250. If reply <> "N/C" And reply <> "N/R" Then
  2251. Return True
  2252. Else
  2253. If errMsg = "" Then errMsg = "Reply from " & serverIp.ToString & " was: " & reply
  2254. End If
  2255. Else
  2256. errMsg = "Request string can not be empty"
  2257. End If
  2258. Return False
  2259. End Function
  2260. Public Function GetReplyStringItems(Optional ByVal separator As String = vbCrLf) As List(Of String)
  2261. If thisReplyList Is Nothing Then thisReplyList = New List(Of String)
  2262. If thisReplyList.Count = 0 Then
  2263. Try
  2264. If serverReply.Length > 0 Then
  2265. Dim theseItems() As String = Split(serverReply, separator)
  2266. If theseItems.Length > 0 Then thisReplyList.AddRange(theseItems)
  2267. End If
  2268. Catch ex As Exception
  2269. End Try
  2270. End If
  2271. 'Dim tmp As String = ""
  2272. 'For Each item As String In thisReplyList
  2273. ' tmp += item & " / "
  2274. 'Next
  2275. 'log("Replystrings found:" & tmp, "Bric Video Service", EventLogEntryType.Information)
  2276. Return thisReplyList
  2277. End Function
  2278. Public Function GetReplyStringItem(ByVal key As String, Optional ByVal separator As String = vbCrLf) As String
  2279. Dim keyValueItems As List(Of String) = GetReplyStringItems(separator)
  2280. Dim keyValuePair() As String
  2281. If keyValueItems.Count > 0 Then
  2282. For Each item As String In keyValueItems
  2283. Try
  2284. keyValuePair = Split(item, "=")
  2285. If keyValuePair(0) = key Then
  2286. 'log("Asked for:" & key & ", returning:" & keyValuePair(1), "Bric Video Service", EventLogEntryType.Information)
  2287. Return keyValuePair(1)
  2288. End If
  2289. Catch ex As Exception
  2290. End Try
  2291. Next
  2292. End If
  2293. 'log("Asked for:" & key & ", returning ''", "Bric Video Service", EventLogEntryType.Information)
  2294. Return ""
  2295. End Function
  2296. Public Function GetReplyStringItemAsShort(ByVal key As String, Optional ByVal separator As String = vbCrLf) As Short
  2297. Dim value As String = GetReplyStringItem(key, separator)
  2298. Try
  2299. If value <> "" Then Return Convert.ToInt16(value)
  2300. Catch ex As Exception
  2301. End Try
  2302. Return Nothing
  2303. End Function
  2304. Public Function GetReplyStringItemAsDate(ByVal key As String, Optional ByVal separator As String = vbCrLf) As Date
  2305. Dim value As String = GetReplyStringItem(key, separator)
  2306. Try
  2307. If value <> "" Then Return Convert.ToDateTime(value)
  2308. Catch ex As Exception
  2309. End Try
  2310. Return Nothing
  2311. End Function
  2312. Public Function GetReplyString() As String
  2313. Return serverReply
  2314. End Function
  2315. ' Send "cmd=stuff here" & vbCrLf & "something else=more stuff" & vbCrLf...
  2316. Public Function SendRequest(ByVal requestString As String, Optional ByVal timeoutSeconds As Integer = 5, _
  2317. Optional ByRef errMsg As String = "") As String
  2318. ' Handle TCP communication here:
  2319. Dim client As New Tcp.Comm.Client(AddressOf ClientCallback)
  2320. ' Attempt to connect to the server. If not - return N/C (No Connection)
  2321. If Not client.Connect(serverIp, port, "", errMsg) Then Return "N/C"
  2322. ' Send our request, and wait for a reply...
  2323. client.SendBytes(StrToByteArray("<text>" & requestString & "</text>"), 10)
  2324. Dim timeOut As Date = Now
  2325. While Not replyComplete
  2326. If Now > timeOut.AddSeconds(timeoutSeconds) Then Exit While ' Bail after timeoutSeconds seconds.
  2327. Threading.Thread.Sleep(5)
  2328. End While
  2329. client.Close()
  2330. If serverReply.Length > 0 Then
  2331. ' If we got a good reply...
  2332. If replyComplete Then ' Remove the tags.
  2333. serverReply = serverReply.Replace("<text>", "")
  2334. serverReply = serverReply.Replace("</text>", "")
  2335. End If
  2336. Return serverReply
  2337. End If
  2338. Return "N/R"
  2339. End Function
  2340. Private Sub ClientCallback(ByVal bytes() As Byte, ByVal dataChannel As Integer)
  2341. If dataChannel = 10 Then
  2342. ' Our data arrived.
  2343. serverReply += BytesToString(bytes)
  2344. If serverReply.Contains("</text>") Then replyComplete = True
  2345. End If
  2346. End Sub
  2347. End Class
  2348. End Class