ModNet.vb 97 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054
  1. Imports System.Net
  2. Public Module ModNet
  3. Public Const NetDownloadEnd As String = ".PCLDownloading"
  4. ''' <summary>
  5. ''' 以 WebClient 获取网页源代码。会进行至多 45 秒 3 次的尝试,允许最长 30s 的超时。
  6. ''' </summary>
  7. ''' <param name="Url">网页的 Url。</param>
  8. ''' <param name="Encoding">网页的编码,通常为 UTF-8。</param>
  9. Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Optional Accept As String = "application/json, text/javascript, */*; q=0.01") As String
  10. Dim RetryCount As Integer = 0
  11. Dim RetryException As Exception = Nothing
  12. Dim StartTime As Long = GetTimeTick()
  13. Try
  14. Retry:
  15. Select Case RetryCount
  16. Case 0 '正常尝试
  17. Return NetGetCodeByClient(Url, Encoding, 10000, Accept)
  18. Case 1 '慢速重试
  19. Thread.Sleep(500)
  20. Return NetGetCodeByClient(Url, Encoding, 30000, Accept)
  21. Case Else '快速重试
  22. If GetTimeTick() - StartTime > 5500 Then
  23. '若前两次加载耗费 5 秒以上,才进行重试
  24. Thread.Sleep(500)
  25. Return NetGetCodeByClient(Url, Encoding, 4000, Accept)
  26. Else
  27. Throw RetryException
  28. End If
  29. End Select
  30. Catch ex As Exception
  31. Select Case RetryCount
  32. Case 0
  33. RetryException = ex
  34. RetryCount += 1
  35. GoTo Retry
  36. Case 1
  37. RetryCount += 1
  38. GoTo Retry
  39. Case Else
  40. Throw
  41. End Select
  42. End Try
  43. End Function
  44. Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String) As String
  45. Url = SecretCdnSign(Url)
  46. Log("[Net] 获取客户端网络结果:" & Url & ",最大超时 " & Timeout)
  47. Dim Request As CookieWebClient
  48. Dim res As HttpWebResponse = Nothing
  49. Dim HttpStream As Stream = Nothing
  50. Try
  51. Request = New CookieWebClient With {
  52. .Encoding = Encoding,
  53. .Timeout = Timeout
  54. }
  55. Request.Headers("Accept") = Accept
  56. Request.Headers("Accept-Language") = "en-US,en;q=0.5"
  57. Request.Headers("X-Requested-With") = "XMLHttpRequest"
  58. SecretHeadersSign(Url, Request)
  59. Return Request.DownloadString(Url)
  60. Catch ex As Exception
  61. If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
  62. Throw New TimeoutException("连接服务器超时(" & Url & ")", ex)
  63. Else
  64. Throw New WebException("获取结果失败," & ex.Message & "(" & Url & ")", ex)
  65. End If
  66. Finally
  67. If Not IsNothing(HttpStream) Then HttpStream.Dispose()
  68. If Not IsNothing(res) Then res.Dispose()
  69. End Try
  70. End Function
  71. ''' <summary>
  72. ''' 以 WebRequest 获取网页源代码或 Json。会进行至多 45 秒 3 次的尝试,允许最长 30s 的超时。
  73. ''' </summary>
  74. ''' <param name="Url">网页的 Url。</param>
  75. ''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
  76. Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
  77. Dim RetryCount As Integer = 0
  78. Dim RetryException As Exception = Nothing
  79. Dim StartTime As Long = GetTimeTick()
  80. Try
  81. Retry:
  82. Select Case RetryCount
  83. Case 0 '正常尝试
  84. Return NetGetCodeRequest(Url, Encode, 10000, IsJson, Accept)
  85. Case 1 '慢速重试
  86. Thread.Sleep(500)
  87. Return NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept)
  88. Case Else '快速重试
  89. If GetTimeTick() - StartTime > 5500 Then
  90. '若前两次加载耗费 5 秒以上,才进行重试
  91. Thread.Sleep(500)
  92. Return NetGetCodeRequest(Url, Encode, 4000, IsJson, Accept)
  93. Else
  94. Throw RetryException
  95. End If
  96. End Select
  97. Catch ex As ThreadInterruptedException
  98. Throw
  99. Catch ex As Exception
  100. Select Case RetryCount
  101. Case 0
  102. RetryException = ex
  103. RetryCount += 1
  104. GoTo Retry
  105. Case 1
  106. RetryCount += 1
  107. GoTo Retry
  108. Case Else
  109. Throw
  110. End Select
  111. End Try
  112. End Function
  113. ''' <summary>
  114. ''' 以 WebRequest 获取网页源代码或 Json。会逐渐生成 4 个尝试线程,并在 60s 后超时。
  115. ''' </summary>
  116. ''' <param name="Url">网页的 Url。</param>
  117. ''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
  118. Public Function NetGetCodeByRequestMuity(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
  119. Dim Threads As New List(Of Thread)
  120. Dim RequestResult = Nothing
  121. Dim RequestEx As Exception = Nothing
  122. Dim FailCount As Integer = 0
  123. For i = 1 To 4
  124. Dim th As New Thread(Sub()
  125. Try
  126. RequestResult = NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept)
  127. Catch ex As Exception
  128. FailCount += 1
  129. RequestEx = ex
  130. End Try
  131. End Sub)
  132. th.Start()
  133. Threads.Add(th)
  134. Thread.Sleep(i * 250)
  135. If RequestResult IsNot Nothing Then GoTo RequestFinished
  136. Next
  137. Do While True
  138. If RequestResult IsNot Nothing Then
  139. RequestFinished:
  140. Try
  141. For Each th In Threads
  142. If th.IsAlive Then th.Interrupt()
  143. Next
  144. Catch
  145. End Try
  146. Return RequestResult
  147. ElseIf FailCount = 4 Then
  148. Try
  149. For Each th In Threads
  150. If th.IsAlive Then th.Interrupt()
  151. Next
  152. Catch
  153. End Try
  154. Throw RequestEx
  155. End If
  156. Thread.Sleep(20)
  157. Loop
  158. Throw New Exception("未知错误")
  159. End Function
  160. Private Function NetGetCodeRequest(Url As String, Encode As Encoding, Timeout As Integer, IsJson As Boolean, Accept As String)
  161. If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
  162. Url = SecretCdnSign(Url)
  163. Log("[Net] 获取网络结果:" & Url & ",最大超时 " & Timeout)
  164. Dim Request As HttpWebRequest = WebRequest.Create(Url)
  165. Dim Result As New List(Of Byte)
  166. Try
  167. If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11
  168. Request.Timeout = Timeout
  169. Request.Accept = Accept
  170. Request.KeepAlive = False
  171. SecretHeadersSign(Url, Request)
  172. Using res As HttpWebResponse = Request.GetResponse()
  173. Using HttpStream As Stream = res.GetResponseStream()
  174. HttpStream.ReadTimeout = Timeout
  175. Dim HttpData As Byte() = New Byte(16384) {}
  176. Using Reader As New StreamReader(HttpStream, If(Encode, Encoding.UTF8))
  177. Dim ResultString As String = Reader.ReadToEnd
  178. Return If(IsJson, GetJson(ResultString), ResultString)
  179. End Using
  180. End Using
  181. End Using
  182. Catch ex As ThreadInterruptedException
  183. Throw
  184. Catch ex As Exception
  185. If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
  186. Throw New TimeoutException("连接服务器超时,已接收 " & Result.Count & " B(" & Url & ")")
  187. Else
  188. Throw New WebException("获取结果失败," & ex.Message & "(" & Url & ")", ex)
  189. End If
  190. Finally
  191. Request.Abort()
  192. End Try
  193. End Function
  194. ''' <summary>
  195. ''' 以多线程下载网页文件的方式获取网页源代码。
  196. ''' </summary>
  197. ''' <param name="Url">网页的 Url。</param>
  198. Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
  199. Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid()
  200. Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson})})
  201. Try
  202. NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(" & Url & ")")
  203. NetGetCodeByDownload = ReadFile(Temp)
  204. File.Delete(Temp)
  205. Finally
  206. NewTask.Abort()
  207. End Try
  208. End Function
  209. ''' <summary>
  210. ''' 以多线程下载网页文件的方式获取网页源代码。
  211. ''' </summary>
  212. ''' <param name="Urls">网页的 Url 列表。</param>
  213. Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
  214. Dim Temp As String = PathTemp & "Cache\Code\" & Urls(0).GetHashCode() & "_" & GetUuid()
  215. Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson})})
  216. Try
  217. NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls(0) & ")")
  218. NetGetCodeByDownload = ReadFile(Temp)
  219. File.Delete(Temp)
  220. Finally
  221. NewTask.Abort()
  222. End Try
  223. End Function
  224. ''' <summary>
  225. ''' 从网络中直接下载文件。这不能下载 CDN 中的文件。
  226. ''' </summary>
  227. ''' <param name="Url">网络 Url。</param>
  228. ''' <param name="LocalFile">下载的本地地址。</param>
  229. Public Sub NetDownload(Url As String, LocalFile As String)
  230. Log("[Net] 直接下载文件:" & Url)
  231. '初始化
  232. Try
  233. '建立目录
  234. Directory.CreateDirectory(GetPathFromFullPath(LocalFile))
  235. '尝试删除原文件
  236. File.Delete(LocalFile)
  237. Catch ex As Exception
  238. Throw New WebException("预处理下载文件路径失败(" & LocalFile & ")。", ex)
  239. End Try
  240. '下载
  241. Using Client As New WebClient
  242. Try
  243. Client.DownloadFile(Url, LocalFile)
  244. Catch ex As Exception
  245. Throw New WebException("直接下载文件失败(" & Url & ")。", ex)
  246. End Try
  247. End Using
  248. End Sub
  249. ''' <summary>
  250. ''' 发送一个网络请求并获取返回内容,会重试三次并在最长 45s 后超时。
  251. ''' </summary>
  252. ''' <param name="Url">请求的服务器地址。</param>
  253. ''' <param name="Method">请求方式(POST 或 GET)。</param>
  254. ''' <param name="Data">请求的内容。</param>
  255. ''' <param name="ContentType">请求的套接字类型。</param>
  256. ''' <param name="DontRetryOnRefused">当返回 40x 时不重试。</param>
  257. Public Function NetRequestRetry(Url As String, Method As String, Data As Object, ContentType As String, Optional DontRetryOnRefused As Boolean = True, Optional Headers As Dictionary(Of String, String) = Nothing) As String
  258. Dim RetryCount As Integer = 0
  259. Dim RetryException As Exception = Nothing
  260. Dim StartTime As Long = GetTimeTick()
  261. Try
  262. Retry:
  263. Select Case RetryCount
  264. Case 0 '正常尝试
  265. Return NetRequestOnce(Url, Method, Data, ContentType, 15000, Headers)
  266. Case 1 '慢速重试
  267. Thread.Sleep(500)
  268. Return NetRequestOnce(Url, Method, Data, ContentType, 25000, Headers)
  269. Case Else '快速重试
  270. If GetTimeTick() - StartTime > 5500 Then
  271. '若前两次加载耗费 5 秒以上,才进行重试
  272. Thread.Sleep(500)
  273. Return NetRequestOnce(Url, Method, Data, ContentType, 4000, Headers)
  274. Else
  275. Throw RetryException
  276. End If
  277. End Select
  278. Catch ex As ThreadInterruptedException
  279. Throw
  280. Catch ex As Exception
  281. If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then RetryCount = 999
  282. Select Case RetryCount
  283. Case 0
  284. If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败(" & Url & ")")
  285. RetryException = ex
  286. RetryCount += 1
  287. GoTo Retry
  288. Case 1
  289. If ModeDebug Then Log(ex, "[Net] 网络请求第二次失败(" & Url & ")")
  290. RetryCount += 1
  291. GoTo Retry
  292. Case Else
  293. Throw
  294. End Select
  295. End Try
  296. End Function
  297. ''' <summary>
  298. ''' 同时发送多个网络请求并要求返回内容。
  299. ''' </summary>
  300. Public Function NetRequestMuity(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing)
  301. Dim Threads As New List(Of Thread)
  302. Dim RequestResult = Nothing
  303. Dim RequestEx As Exception = Nothing
  304. Dim FailCount As Integer = 0
  305. For i = 1 To RequestCount
  306. Dim th As New Thread(Sub()
  307. Try
  308. RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
  309. Catch ex As Exception
  310. FailCount += 1
  311. RequestEx = ex
  312. End Try
  313. End Sub)
  314. th.Start()
  315. Threads.Add(th)
  316. Thread.Sleep(i * 250)
  317. If RequestResult IsNot Nothing Then GoTo RequestFinished
  318. Next
  319. Do While True
  320. If RequestResult IsNot Nothing Then
  321. RequestFinished:
  322. For Each th In Threads
  323. If th.IsAlive Then th.Interrupt()
  324. Next
  325. Return RequestResult
  326. ElseIf FailCount = RequestCount Then
  327. For Each th In Threads
  328. If th.IsAlive Then th.Interrupt()
  329. Next
  330. Throw RequestEx
  331. End If
  332. Thread.Sleep(20)
  333. Loop
  334. Throw New Exception("未知错误")
  335. End Function
  336. ''' <summary>
  337. ''' 发送一次网络请求并获取返回内容。
  338. ''' </summary>
  339. Public Function NetRequestOnce(Url As String, Method As String, Data As Object, ContentType As String, Optional Timeout As Integer = 25000, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True) As String
  340. If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
  341. Url = SecretCdnSign(Url)
  342. If MakeLog Then Log("[Net] 发起网络请求(" & Method & "," & Url & "),最大超时 " & Timeout)
  343. Dim DataStream As Stream = Nothing
  344. Dim Resp As WebResponse = Nothing
  345. Dim Req As HttpWebRequest
  346. Try
  347. Req = WebRequest.Create(New Uri(Url))
  348. Req.Method = Method
  349. Dim SendData As Byte()
  350. If TypeOf Data Is Byte() Then
  351. SendData = Data
  352. Else
  353. SendData = New UTF8Encoding(False).GetBytes(Data.ToString)
  354. End If
  355. If Headers IsNot Nothing Then
  356. For Each Pair In Headers
  357. Req.Headers.Add(Pair.Key, Pair.Value)
  358. Next
  359. End If
  360. Req.ContentType = ContentType
  361. Req.Timeout = Timeout
  362. Req.KeepAlive = False
  363. SecretHeadersSign(Url, Req)
  364. If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11
  365. If Method = "POST" OrElse Method = "PUT" Then
  366. Req.ContentLength = SendData.Length
  367. DataStream = Req.GetRequestStream()
  368. DataStream.WriteTimeout = Timeout
  369. DataStream.ReadTimeout = Timeout
  370. DataStream.Write(SendData, 0, SendData.Length)
  371. DataStream.Close()
  372. End If
  373. Resp = Req.GetResponse()
  374. DataStream = Resp.GetResponseStream()
  375. DataStream.WriteTimeout = Timeout
  376. DataStream.ReadTimeout = Timeout
  377. Using Reader As New StreamReader(DataStream)
  378. Return Reader.ReadToEnd()
  379. End Using
  380. Catch ex As ThreadInterruptedException
  381. Throw
  382. Catch ex As WebException
  383. If ex.Status = WebExceptionStatus.Timeout Then
  384. Throw New TimeoutException("连接服务器超时,请检查你的网络环境是否良好(" & Url & ")", ex)
  385. Else
  386. '获取请求失败的返回
  387. Dim Res As String = ""
  388. Try
  389. If ex.Response Is Nothing Then Exit Try
  390. DataStream = ex.Response.GetResponseStream()
  391. DataStream.WriteTimeout = Timeout
  392. DataStream.ReadTimeout = Timeout
  393. Using Reader As New StreamReader(DataStream)
  394. Res = Reader.ReadToEnd()
  395. End Using
  396. Catch
  397. End Try
  398. Throw New WebException("网络请求失败(" & Url & "," & ex.Message & ")" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex)
  399. End If
  400. Catch ex As Exception
  401. Throw New WebException("网络请求失败(" & Url & ")", ex)
  402. Finally
  403. If DataStream IsNot Nothing Then DataStream.Dispose()
  404. If Resp IsNot Nothing Then Resp.Dispose()
  405. End Try
  406. End Function
  407. ''' <summary>
  408. ''' 最大线程数。
  409. ''' </summary>
  410. Public NetTaskThreadLimit As Integer
  411. ''' <summary>
  412. ''' 速度下限。
  413. ''' </summary>
  414. Public NetTaskSpeedLimitLow As Long = 1024 * 1024L
  415. ''' <summary>
  416. ''' 速度上限。若无限制则为 -1。
  417. ''' </summary>
  418. Public NetTaskSpeedLimitHigh As Long = -1
  419. ''' <summary>
  420. ''' 基于限速,当前可以下载的剩余量。
  421. ''' </summary>
  422. Public NetTaskSpeedLimitLeft As Long = -1
  423. Private ReadOnly NetTaskSpeedLimitLeftLock As New Object
  424. Private NetTaskSpeedLimitLeftLast As Long
  425. ''' <summary>
  426. ''' 正在运行中的线程数。
  427. ''' </summary>
  428. Public NetTaskThreadCount As Integer = 0
  429. Private ReadOnly NetTaskThreadCountLock As New Object
  430. ''' <summary>
  431. ''' 下载源。
  432. ''' </summary>
  433. Public Class NetSource
  434. Public Id As Integer
  435. Public Url As String
  436. Public FailCount As Integer
  437. Public Ex As Exception
  438. Public Thread As NetThread
  439. Public IsFailed As Boolean
  440. Public Overrides Function ToString() As String
  441. Return Url
  442. End Function
  443. End Class
  444. ''' <summary>
  445. ''' 下载进度标示。
  446. ''' </summary>
  447. Public Enum NetState
  448. ''' <summary>
  449. ''' 尚未进行已存在检查。
  450. ''' </summary>
  451. WaitForCheck = -1
  452. ''' <summary>
  453. ''' 尚未开始。
  454. ''' </summary>
  455. WaitForDownload = 0
  456. ''' <summary>
  457. ''' 正在连接,尚未获取文件大小。
  458. ''' </summary>
  459. Connect = 1
  460. ''' <summary>
  461. ''' 已获取文件大小,尚未有有效下载。
  462. ''' </summary>
  463. [Get] = 2
  464. ''' <summary>
  465. ''' 正在下载。
  466. ''' </summary>
  467. Download = 3
  468. ''' <summary>
  469. ''' 正在合并文件。
  470. ''' </summary>
  471. Merge = 4
  472. ''' <summary>
  473. ''' 不进行下载,因为已发现现存的文件。
  474. ''' </summary>
  475. WaitForCopy = 5
  476. ''' <summary>
  477. ''' 已完成。
  478. ''' </summary>
  479. Finish = 6
  480. ''' <summary>
  481. ''' 已失败。
  482. ''' </summary>
  483. [Error] = 7
  484. End Enum
  485. ''' <summary>
  486. ''' 预下载检查行为。
  487. ''' </summary>
  488. Public Enum NetPreDownloadBehaviour
  489. ''' <summary>
  490. ''' 当文件已存在时,显示提示以提醒用户是否继续下载。
  491. ''' </summary>
  492. HintWhileExists
  493. ''' <summary>
  494. ''' 当文件已存在或正在下载时,直接退出下载函数执行,不对用户进行提示。
  495. ''' </summary>
  496. ExitWhileExistsOrDownloading
  497. ''' <summary>
  498. ''' 不进行已存在检查。
  499. ''' </summary>
  500. IgnoreCheck
  501. End Enum
  502. ''' <summary>
  503. ''' 下载线程。
  504. ''' </summary>
  505. Public Class NetThread
  506. Implements IEnumerable(Of NetThread)
  507. ''' <summary>
  508. ''' 对应的下载任务。
  509. ''' </summary>
  510. Public Task As NetFile
  511. ''' <summary>
  512. ''' 对应的线程。
  513. ''' </summary>
  514. Public Thread As Thread
  515. ''' <summary>
  516. ''' 链表中的下一个线程。
  517. ''' </summary>
  518. Public NextThread As NetThread
  519. Private ReadOnly Iterator Property [Next]() As IEnumerable(Of NetThread)
  520. Get
  521. Dim CurrentChain As NetThread = Me
  522. While CurrentChain IsNot Nothing
  523. Yield CurrentChain
  524. CurrentChain = CurrentChain.NextThread
  525. End While
  526. End Get
  527. End Property
  528. Public Function GetEnumerator() As IEnumerator(Of NetThread) Implements IEnumerable(Of NetThread).GetEnumerator
  529. Return [Next].GetEnumerator()
  530. End Function
  531. Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
  532. Return [Next].GetEnumerator()
  533. End Function
  534. ''' <summary>
  535. ''' 分配给任务中每个线程(无论其是否失败)的编号。
  536. ''' </summary>
  537. Public Uuid As Integer
  538. ''' <summary>
  539. ''' 是否为第一个线程。
  540. ''' </summary>
  541. Public ReadOnly Property IsFirstThread As Boolean
  542. Get
  543. Return DownloadStart = 0 AndAlso Task.FileSize = -2
  544. End Get
  545. End Property
  546. ''' <summary>
  547. ''' 该线程的缓存文件。
  548. ''' </summary>
  549. Public Temp As String
  550. ''' <summary>
  551. ''' 线程下载起始位置。
  552. ''' </summary>
  553. Public DownloadStart As Long
  554. ''' <summary>
  555. ''' 线程下载结束位置。
  556. ''' </summary>
  557. Public ReadOnly Property DownloadEnd As Long
  558. Get
  559. SyncLock Task.LockChain
  560. If NextThread Is Nothing Then
  561. If Task.IsUnknownSize Then
  562. Return 1024 * 1024 * 1024 '1G
  563. Else
  564. Return Task.FileSize - 1
  565. End If
  566. Else
  567. Return NextThread.DownloadStart - 1
  568. End If
  569. End SyncLock
  570. End Get
  571. End Property
  572. ''' <summary>
  573. ''' 线程未下载的文件大小。
  574. ''' </summary>
  575. Public ReadOnly Property DownloadUndone As Long
  576. Get
  577. Return DownloadEnd + 1 - (DownloadStart + DownloadDone)
  578. End Get
  579. End Property
  580. ''' <summary>
  581. ''' 线程已下载的文件大小。
  582. ''' </summary>
  583. Public DownloadDone As Long = 0
  584. ''' <summary>
  585. ''' 上次记速时的时间。
  586. ''' </summary>
  587. Private SpeedLastTime As Long = GetTimeTick()
  588. ''' <summary>
  589. ''' 上次记速时的已下载大小。
  590. ''' </summary>
  591. Private SpeedLastDone As Long = 0
  592. ''' <summary>
  593. ''' 当前的下载速度,单位为 Byte / 秒。
  594. ''' </summary>
  595. Public ReadOnly Property Speed As Long
  596. Get
  597. If GetTimeTick() - SpeedLastTime > 200 Then
  598. Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime
  599. _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
  600. SpeedLastDone = DownloadDone
  601. SpeedLastTime += DeltaTime
  602. End If
  603. Return _Speed
  604. End Get
  605. End Property
  606. Private _Speed As Long = 0
  607. ''' <summary>
  608. ''' 线程初始化时的时间。
  609. ''' </summary>
  610. Public InitTime As Long = GetTimeTick()
  611. ''' <summary>
  612. ''' 上次接受到有效数据的时间,-1 表示尚未有有效数据。
  613. ''' </summary>
  614. Public LastReceiveTime As Long = -1
  615. ''' <summary>
  616. ''' 当前线程的状态。
  617. ''' </summary>
  618. Public State As NetState = NetState.WaitForDownload
  619. ''' <summary>
  620. ''' 是否已经结束。
  621. ''' </summary>
  622. Public ReadOnly Property IsEnded As Boolean
  623. Get
  624. Return State = NetState.Finish OrElse State = NetState.Error
  625. End Get
  626. End Property
  627. ''' <summary>
  628. ''' 当前选取的是哪一个 Url。
  629. ''' </summary>
  630. Public Source As NetSource
  631. End Class
  632. ''' <summary>
  633. ''' 下载单个文件。
  634. ''' </summary>
  635. Public Class NetFile
  636. #Region "属性"
  637. ''' <summary>
  638. ''' 所属的文件列表任务。
  639. ''' </summary>
  640. Public Tasks As New List(Of LoaderDownload)
  641. ''' <summary>
  642. ''' 所有下载源。
  643. ''' </summary>
  644. Public Sources As NetSource()
  645. ''' <summary>
  646. ''' 用于在第一个线程出错时切换下载源。
  647. ''' </summary>
  648. Private FirstThreadSource As Integer = 0
  649. ''' <summary>
  650. ''' 所有已经被标记为失败的,但未完整尝试过的,不允许断点续传的下载源。
  651. ''' </summary>
  652. Public SourcesOnce As New List(Of NetSource)
  653. ''' <summary>
  654. ''' 获取从某个源开始,第一个可用的源。
  655. ''' </summary>
  656. Private Function GetSource(Optional Id As Integer = 0) As NetSource
  657. If Id >= Sources.Count OrElse Id < 0 Then Id = 0
  658. SyncLock LockSource
  659. If Not IsSourceFailed(False) Then
  660. '存在多线程可用源
  661. Dim CurrentSource As NetSource = Sources(Id)
  662. While CurrentSource.IsFailed
  663. Id += 1
  664. If Id >= Sources.Count Then Id = 0
  665. CurrentSource = Sources(Id)
  666. End While
  667. Return CurrentSource
  668. ElseIf SourcesOnce.Count > 0 Then
  669. '仅存在单线程可用源
  670. Return SourcesOnce(0)
  671. Else
  672. '没有可用源
  673. Return Nothing
  674. End If
  675. End SyncLock
  676. End Function
  677. ''' <summary>
  678. ''' 是否已经没有可用源了。
  679. ''' </summary>
  680. Public Function IsSourceFailed(Optional AllowOnceSource As Boolean = True) As Boolean
  681. If AllowOnceSource AndAlso SourcesOnce.Count > 0 Then Return False
  682. SyncLock LockSource
  683. For Each Source As NetSource In Sources
  684. If Not Source.IsFailed Then Return False
  685. Next
  686. End SyncLock
  687. Return True
  688. End Function
  689. ''' <summary>
  690. ''' 存储在本地的带文件名的地址。
  691. ''' </summary>
  692. Public LocalPath As String = Nothing
  693. ''' <summary>
  694. ''' 存储在本地的文件名。
  695. ''' </summary>
  696. Public LocalName As String = Nothing
  697. ''' <summary>
  698. ''' 当前的下载状态。
  699. ''' </summary>
  700. Public State As NetState = NetState.WaitForCheck
  701. ''' <summary>
  702. ''' 导致下载失败的原因。
  703. ''' </summary>
  704. Public Ex As New List(Of Exception)
  705. '''' <summary>
  706. '''' 文件进行整体重试的计数。
  707. '''' </summary>
  708. 'Private RetryCount As Integer = 0
  709. ''' <summary>
  710. ''' 作为文件组成部分的线程链表。
  711. ''' </summary>
  712. Private Threads As NetThread
  713. ''' <summary>
  714. ''' 文件的总大小。若为 -2 则为未获取,若为 -1 则为无法获取准确大小。
  715. ''' </summary>
  716. Public FileSize As Long = -2
  717. ''' <summary>
  718. ''' 该文件是否无法获取准确大小。
  719. ''' </summary>
  720. Public IsUnknownSize As Boolean = False
  721. ''' <summary>
  722. ''' 该文件是否不需要分割。
  723. ''' </summary>
  724. Public ReadOnly Property IsNoSplit As Boolean
  725. Get
  726. Return IsUnknownSize OrElse FileSize < FilePieceLimit
  727. End Get
  728. End Property
  729. ''' <summary>
  730. ''' 为不需要分割的小文件进行临时存储。
  731. ''' </summary>
  732. Private SmailFileCache As List(Of Byte)
  733. ''' <summary>
  734. ''' 文件的已下载大小。
  735. ''' </summary>
  736. Public DownloadDone As Long = 0
  737. Private ReadOnly LockDone As New Object
  738. ''' <summary>
  739. ''' 文件的校验规则。
  740. ''' </summary>
  741. Public Check As FileChecker
  742. ''' <summary>
  743. ''' 上次记速时的时间。
  744. ''' </summary>
  745. Private SpeedLastTime As Long = GetTimeTick()
  746. ''' <summary>
  747. ''' 上次记速时的已下载大小。
  748. ''' </summary>
  749. Private SpeedLastDone As Long = 0
  750. ''' <summary>
  751. ''' 当前的下载速度,单位为 Byte / 秒。
  752. ''' </summary>
  753. Public ReadOnly Property Speed As Long
  754. Get
  755. If GetTimeTick() - SpeedLastTime > 200 Then
  756. Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime
  757. _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
  758. SpeedLastDone = DownloadDone
  759. SpeedLastTime += DeltaTime
  760. End If
  761. Return _Speed
  762. End Get
  763. End Property
  764. Private _Speed As Long = 0
  765. ''' <summary>
  766. ''' 该文件是否由本地文件直接拷贝完成。
  767. ''' </summary>
  768. Public IsCopy As Boolean = False
  769. ''' <summary>
  770. ''' 本文件的显示进度。
  771. ''' </summary>
  772. Public ReadOnly Property Progress As Double
  773. Get
  774. Select Case State
  775. Case NetState.WaitForCheck
  776. Return 0
  777. Case NetState.WaitForCopy
  778. Return 0.2
  779. Case NetState.WaitForDownload
  780. Return 0.01
  781. Case NetState.Connect
  782. Return 0.02
  783. Case NetState.Get
  784. Return 0.04
  785. Case NetState.Download
  786. '正在下载中,对应 5% ~ 99%
  787. Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1))
  788. OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9
  789. Return OriginalProgress * 0.94 + 0.05
  790. Case NetState.Merge
  791. Return 0.99
  792. Case NetState.Finish, NetState.Error
  793. Return 1
  794. Case Else
  795. Throw New ArgumentOutOfRangeException("文件状态未知:" & State)
  796. End Select
  797. End Get
  798. End Property
  799. ''' <summary>
  800. ''' 各个线程建立连接成功的总次数。
  801. ''' </summary>
  802. Private ConnectCount As Integer = 0
  803. ''' <summary>
  804. ''' 各个线程建立连接成功的总时间。
  805. ''' </summary>
  806. Private ConnectTime As Long = 0
  807. ''' <summary>
  808. ''' 各个线程建立连接成功的平均时间,单位为毫秒,-1 代表尚未有成功连接。
  809. ''' </summary>
  810. Private ReadOnly Property ConnectAverage As Integer
  811. Get
  812. SyncLock LockCount
  813. Return If(ConnectCount = 0, -1, ConnectTime / ConnectCount)
  814. End SyncLock
  815. End Get
  816. End Property
  817. Private Const FilePieceLimit As Long = 256 * 1024
  818. Public ReadOnly RandomCode As Integer = RandomInteger(0, 999999)
  819. Public ReadOnly LockCount As New Object
  820. Public ReadOnly LockState As New Object
  821. Public ReadOnly LockChain As New Object
  822. Public ReadOnly LockSource As New Object
  823. Public ReadOnly LockTasks As New Object
  824. Private ReadOnly Uuid As Integer = GetUuid()
  825. Public Overrides Function Equals(obj As Object) As Boolean
  826. Dim file = TryCast(obj, NetFile)
  827. Return file IsNot Nothing AndAlso Uuid = file.Uuid
  828. End Function
  829. #End Region
  830. ''' <summary>
  831. ''' 新建一个需要下载的文件。
  832. ''' </summary>
  833. ''' <param name="LocalPath">包含文件名的本地地址。</param>
  834. Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing)
  835. Dim Sources As New List(Of NetSource)
  836. Dim Count As Integer = 0
  837. Urls = ArrayNoDouble(Urls)
  838. For Each Source As String In Urls
  839. Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing})
  840. Count += 1
  841. Next
  842. Me.Sources = Sources.ToArray
  843. Me.LocalPath = LocalPath
  844. Me.Check = Check
  845. Me.LocalName = GetFileNameFromPath(LocalPath)
  846. End Sub
  847. ''' <summary>
  848. ''' 尝试开始一个新的下载线程。
  849. ''' </summary>
  850. Public Function TryBeginThread() As Boolean
  851. Try
  852. '条件检测
  853. If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse
  854. (IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return False
  855. If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return False
  856. SyncLock LockState
  857. If State < NetState.Connect Then State = NetState.Connect
  858. End SyncLock
  859. '初始化参数
  860. Dim StartPosition As Long, StartSource As NetSource = Nothing
  861. Dim Th As Thread, ThreadInfo As NetThread
  862. SyncLock LockChain
  863. '获取线程起点与下载源
  864. '不分割
  865. If IsNoSplit Then GoTo Capture
  866. '单线程
  867. If IsSourceFailed(False) Then
  868. '确认没有其他线程正使用此点
  869. If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return False
  870. '占用此点
  871. Capture:
  872. SmailFileCache = Nothing
  873. Threads = Nothing
  874. NetManager.DownloadDone -= DownloadDone
  875. SyncLock LockDone
  876. DownloadDone = 0
  877. End SyncLock
  878. SpeedLastDone = 0
  879. State = NetState.Get
  880. End If
  881. '首个开始点
  882. If Threads Is Nothing Then
  883. StartPosition = 0
  884. StartSource = GetSource(FirstThreadSource)
  885. If StartSource Is Nothing Then
  886. '没有可用源了
  887. Throw New Exception("无可用源,请反馈此问题。")
  888. Else
  889. '有可用源
  890. FirstThreadSource = StartSource.Id + 1
  891. GoTo StartThread
  892. End If
  893. End If
  894. '寻找失败点
  895. For Each Thread As NetThread In Threads
  896. If Thread.State = NetState.Error AndAlso Thread.DownloadUndone > 0 Then
  897. StartPosition = Thread.DownloadStart + Thread.DownloadDone
  898. StartSource = GetSource(Thread.Source.Id + 1)
  899. GoTo StartThread
  900. End If
  901. Next
  902. '是否禁用多线程,以及规定碎片大小
  903. Dim TargetUrl As String = GetSource().Url
  904. If TargetUrl.Contains("pcl2-server") Then Return False
  905. Dim RealFilePieceLimit = If(TargetUrl.Contains("download.mcbbs.net"), FilePieceLimit * 5, FilePieceLimit)
  906. '寻找最大碎片
  907. Dim FilePieceMax As NetThread = Threads
  908. For Each Thread As NetThread In Threads
  909. If Thread.DownloadUndone > FilePieceMax.DownloadUndone Then FilePieceMax = Thread
  910. Next
  911. If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < RealFilePieceLimit Then Return False
  912. StartPosition = FilePieceMax.DownloadEnd - FilePieceMax.DownloadUndone * 0.4
  913. StartSource = GetSource()
  914. '开始线程
  915. StartThread:
  916. If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return False
  917. '构建线程
  918. Dim ThreadUuid As Integer = GetUuid()
  919. SyncLock LockTasks
  920. If Tasks.Count = 0 Then Return False '由于中断,已没有可用任务
  921. Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal}
  922. End SyncLock
  923. ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
  924. '链表处理
  925. If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then
  926. Threads = ThreadInfo
  927. Else
  928. Dim CurrentChain As NetThread = Threads
  929. While CurrentChain.DownloadEnd <= StartPosition
  930. CurrentChain = CurrentChain.NextThread
  931. End While
  932. ThreadInfo.NextThread = CurrentChain.NextThread
  933. CurrentChain.NextThread = ThreadInfo
  934. End If
  935. End SyncLock
  936. '开始线程
  937. SyncLock NetTaskThreadCountLock
  938. NetTaskThreadCount += 1
  939. End SyncLock
  940. SyncLock LockSource
  941. If IsSourceFailed(False) Then SourcesOnce(0).Thread = ThreadInfo
  942. End SyncLock
  943. Th.Start(ThreadInfo)
  944. Return True
  945. Catch ex As Exception
  946. Log(ex, "尝试开始下载线程失败(" & If(LocalName, "Nothing") & ")", LogLevel.Hint)
  947. Return False
  948. End Try
  949. End Function
  950. ''' <summary>
  951. ''' 每个下载线程执行的代码。
  952. ''' </summary>
  953. Private Sub Thread(Info As NetThread)
  954. If ModeDebug OrElse Info.DownloadStart = 0 Then Log("[Download] " & LocalName & " " & Info.Uuid & "#:开始,起始点 " & Info.DownloadStart & "," & Info.Source.Url)
  955. Dim HttpRequest As HttpWebRequest
  956. Dim ResultStream As Stream = Nothing
  957. '部分下载源真的特别慢,并且只需要一个请求,例如 Ping 为 20s,如果增长太慢,就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟
  958. '延迟过长会导致某些特别慢的链接迟迟不被掐死,即使 MCBBS 源在 10s 下也会出现类似情况
  959. Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Info.Source.FailCount), 30000)
  960. Info.State = NetState.Connect
  961. Try
  962. Dim HttpDataCount As Integer = 0
  963. If SourcesOnce.Contains(Info.Source) AndAlso Not Info.Equals(Info.Source.Thread) Then GoTo SourceBreak
  964. '请求头
  965. HttpRequest = WebRequest.Create(Info.Source.Url)
  966. If Info.Source.Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then HttpRequest.ProtocolVersion = HttpVersion.Version11
  967. 'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
  968. HttpRequest.Timeout = Timeout
  969. HttpRequest.AddRange(Info.DownloadStart)
  970. SecretHeadersSign(Info.Source.Url, HttpRequest)
  971. Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
  972. '文件大小校验
  973. Dim ThreadFileSize = HttpResponse.ContentLength
  974. If ThreadFileSize = -1 Then
  975. If FileSize > 1 Then
  976. Log("[Download] " & LocalName & " " & Info.Uuid & "#:文件大小未知,但已从其他下载源获取,不作处理")
  977. Else
  978. FileSize = -1 : IsUnknownSize = True
  979. Log("[Download] " & LocalName & " " & Info.Uuid & "#:文件大小未知")
  980. End If
  981. ElseIf ThreadFileSize < 0 Then
  982. Throw New Exception("获取片大小失败,结果为 " & ThreadFileSize & "。")
  983. ElseIf Info.IsFirstThread Then
  984. If Check IsNot Nothing Then
  985. If ThreadFileSize < Check.MinSize AndAlso Check.MinSize > 0 Then
  986. Throw New Exception("文件大小不足,获取结果为 " & ThreadFileSize & ",要求至少为 " & Check.MinSize & "。")
  987. End If
  988. If ThreadFileSize <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
  989. Throw New Exception("文件大小不一致,获取结果为 " & ThreadFileSize & ",要求必须为 " & Check.ActualSize & "。")
  990. End If
  991. End If
  992. FileSize = ThreadFileSize : IsUnknownSize = False
  993. Log("[Download] " & LocalName & ":文件大小 " & ThreadFileSize & " B" & "(" & GetString(ThreadFileSize) & ")")
  994. '若文件大小大于 50 M,进行剩余磁盘空间校验
  995. If ThreadFileSize > 50 * 1024 * 1024 Then
  996. For Each Drive As DriveInfo In DriveInfo.GetDrives
  997. Dim DriveName As String = Drive.Name.First.ToString
  998. Dim RequiredSpace = If(PathTemp.StartsWith(DriveName), ThreadFileSize * 1.1, 0) +
  999. If(LocalPath.StartsWith(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0)
  1000. If Drive.TotalFreeSpace < RequiredSpace Then
  1001. Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
  1002. If(PathTemp.StartsWith(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
  1003. End If
  1004. Next
  1005. End If
  1006. ElseIf FileSize < 0 Then
  1007. Throw New Exception("非首线程运行时,尚未获取文件大小。")
  1008. ElseIf Info.DownloadStart > 0 AndAlso ThreadFileSize = FileSize Then
  1009. SyncLock LockSource
  1010. If SourcesOnce.Contains(Info.Source) Then
  1011. GoTo SourceBreak
  1012. Else
  1013. SourcesOnce.Add(Info.Source)
  1014. End If
  1015. End SyncLock
  1016. Throw New WebException("该下载源不支持断点续传。")
  1017. ElseIf Not FileSize - Info.DownloadStart = ThreadFileSize Then
  1018. Throw New WebException("获取到的片大小不一致:线程结果为 " & ThreadFileSize & " B,任务结果为 " & FileSize & "B,起点为 " & Info.DownloadStart & "B。")
  1019. End If
  1020. Info.State = NetState.Get
  1021. SyncLock LockState
  1022. If State < NetState.Get Then State = NetState.Get
  1023. End SyncLock
  1024. '创建缓存文件
  1025. If IsNoSplit Then
  1026. Info.Temp = Nothing
  1027. SmailFileCache = New List(Of Byte)
  1028. Else
  1029. Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp"
  1030. ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
  1031. End If
  1032. '开始下载
  1033. Using HttpStream = HttpResponse.GetResponseStream()
  1034. HttpStream.ReadTimeout = Timeout
  1035. If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
  1036. Dim HttpData As Byte() = New Byte(16384) {}
  1037. HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
  1038. While (IsUnknownSize OrElse Info.DownloadUndone > 0) AndAlso '判断是否下载完成
  1039. HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread))
  1040. '限速
  1041. While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
  1042. Threading.Thread.Sleep(16)
  1043. End While
  1044. Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Info.DownloadUndone))
  1045. SyncLock NetTaskSpeedLimitLeftLock
  1046. If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
  1047. End SyncLock
  1048. Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime
  1049. If DeltaTime > 1000000 Then DeltaTime = 0 '时间刻反转导致出现极大值
  1050. If RealDataCount > 0 Then
  1051. '有数据
  1052. If Info.DownloadDone = 0 Then
  1053. '第一次接受到数据
  1054. Info.State = NetState.Download
  1055. SyncLock LockState
  1056. If State < NetState.Download Then State = NetState.Download
  1057. End SyncLock
  1058. SyncLock LockCount
  1059. ConnectCount += 1
  1060. ConnectTime += GetTimeTick() - Info.InitTime
  1061. End SyncLock
  1062. End If
  1063. SyncLock LockCount
  1064. Info.Source.FailCount = 0
  1065. SyncLock LockTasks
  1066. For Each Task In Tasks
  1067. Task.FailCount = 0
  1068. Next
  1069. End SyncLock
  1070. End SyncLock
  1071. NetManager.DownloadDone += RealDataCount
  1072. SyncLock LockDone
  1073. DownloadDone += RealDataCount
  1074. End SyncLock
  1075. Info.DownloadDone += RealDataCount
  1076. If IsNoSplit Then
  1077. If HttpData.Count = RealDataCount Then
  1078. SmailFileCache.AddRange(HttpData)
  1079. Else
  1080. SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount))
  1081. End If
  1082. Else
  1083. ResultStream.Write(HttpData, 0, RealDataCount)
  1084. End If
  1085. '检查速度是否过慢
  1086. If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s,且速度小于 1K/s
  1087. Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。")
  1088. End If
  1089. Info.LastReceiveTime = GetTimeTick()
  1090. '已完成
  1091. If Info.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
  1092. ElseIf Info.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
  1093. '无数据,且已超时
  1094. Throw New TimeoutException("操作超时,无数据。")
  1095. End If
  1096. HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
  1097. End While
  1098. End Using
  1099. End Using
  1100. SourceBreak:
  1101. If HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
  1102. '服务器无返回数据
  1103. Throw New Exception("服务器无返回数据,但下载尚未完成")
  1104. ElseIf State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
  1105. '被外部中断
  1106. Info.State = NetState.Error
  1107. Log("[Download] " & LocalName & " " & Info.Uuid & "#:中断")
  1108. Else
  1109. '本线程完成
  1110. Info.State = NetState.Finish
  1111. If ModeDebug Then Log("[Download] " & LocalName & " " & Info.Uuid & "#:完成,已下载 " & GetString(Info.DownloadDone))
  1112. End If
  1113. Catch ex As Exception
  1114. '状态变更
  1115. SyncLock LockCount
  1116. Info.Source.FailCount += 1
  1117. SyncLock LockTasks
  1118. For Each Task In Tasks
  1119. Task.FailCount += 1
  1120. Next
  1121. End SyncLock
  1122. End SyncLock
  1123. Dim IsTimeoutString As String = GetString(ex, False).ToLower.Replace(" ", "")
  1124. Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
  1125. IsTimeoutString.Contains("超时") OrElse IsTimeoutString.Contains("timeout") OrElse IsTimeoutString.Contains("timedout")
  1126. Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#:超时(" & (Timeout * 0.001) & "s)", "#:出错," & GetString(ex, False)))
  1127. Info.State = NetState.Error
  1128. ''使用该下载源的线程是否没有速度
  1129. ''下载超时也会导致没有速度,容易误判下载失败,所以已弃用此方法
  1130. 'Dim IsNoSpeed As Boolean = True
  1131. 'SyncLock LockChain
  1132. ' If Threads IsNot Nothing Then
  1133. ' For Each Thread As NetThread In Threads
  1134. ' If Thread.Source.Id = Info.Source.Id AndAlso Thread.Speed > 0 Then
  1135. ' IsNoSpeed = False
  1136. ' Exit For
  1137. ' End If
  1138. ' Next
  1139. ' End If
  1140. 'End SyncLock
  1141. Info.Source.Ex = ex
  1142. '根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
  1143. If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(403)") OrElse ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
  1144. (Info.Source.FailCount >= MathRange(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
  1145. Info.Source.FailCount > NetTaskThreadLimit Then
  1146. Dim IsThisFail As Boolean = False
  1147. SyncLock LockSource
  1148. If Info.Source.Thread IsNot Nothing AndAlso Info.Source.Thread.Equals(Info) Then
  1149. '单线程下,本线程出错
  1150. SourcesOnce.RemoveAt(0)
  1151. GoTo Wrong
  1152. ElseIf Not Info.Source.IsFailed Then
  1153. '多线程下,本线程出错
  1154. Wrong:
  1155. Info.Source.IsFailed = True
  1156. IsThisFail = True
  1157. End If
  1158. End SyncLock
  1159. '本线程引发下载源被禁用
  1160. If IsThisFail Then
  1161. Log("[Download] " & LocalName & " " & Uuid & "#:下载源被禁用(" & Info.Source.Id & "):" & Info.Source.Url)
  1162. Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持断点续传") OrElse ex.Message.Contains("404") OrElse ex.Message.Contains("416"), LogLevel.Developer, LogLevel.Debug))
  1163. If IsSourceFailed() Then
  1164. '没有可用源
  1165. Log("[Download] 文件 " & LocalName & " 已无可用下载源")
  1166. Dim ExampleEx As Exception = Nothing
  1167. SyncLock LockSource
  1168. For Each Source As NetSource In Sources
  1169. Log("[Download] 已禁用的下载源:" & Source.Url)
  1170. If Source.Ex IsNot Nothing Then
  1171. ExampleEx = Source.Ex
  1172. Log(Source.Ex, "下载源禁用原因", LogLevel.Developer)
  1173. End If
  1174. Next
  1175. End SyncLock
  1176. Fail(ExampleEx)
  1177. ElseIf ex.Message.Contains("空间不足") Then
  1178. '没有空间
  1179. Fail(ex)
  1180. End If
  1181. End If
  1182. End If
  1183. '首线程错误
  1184. If FileSize = -2 Then
  1185. SyncLock LockChain
  1186. Threads = Nothing
  1187. End SyncLock
  1188. End If
  1189. Finally
  1190. If ResultStream IsNot Nothing Then ResultStream.Dispose()
  1191. SyncLock NetTaskThreadCountLock
  1192. NetTaskThreadCount -= 1
  1193. End SyncLock
  1194. If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
  1195. End Try
  1196. End Sub
  1197. '下载文件的最终收束事件
  1198. ''' <summary>
  1199. ''' 下载完成。合并文件。
  1200. ''' </summary>
  1201. Private Sub Merge()
  1202. '状态判断
  1203. SyncLock LockState
  1204. If State < NetState.Merge Then
  1205. State = NetState.Merge
  1206. Else
  1207. Exit Sub
  1208. End If
  1209. End SyncLock
  1210. Dim RetryCount As Integer = 0
  1211. Dim MergeFile As Stream = Nothing, AddWriter As BinaryWriter = Nothing
  1212. Try
  1213. Retry:
  1214. SyncLock LockChain
  1215. ''大小检测
  1216. 'If DownloadDone <> FileSize AndAlso Not IsUnknownSize Then
  1217. ' For Each Th As NetThread In Threads
  1218. ' Log("[Download] " & "File size detail: ")
  1219. ' Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone)
  1220. ' Next
  1221. ' Throw New Exception("文件大小应为 " & FileSize & " B,实际下载为 " & DownloadDone & " B。")
  1222. 'End If
  1223. If ModeDebug Then Log("[Download] " & LocalName & ":正在合并文件")
  1224. '创建文件夹
  1225. If File.Exists(LocalPath) Then File.Delete(LocalPath)
  1226. Dim Info As New FileInfo(LocalPath)
  1227. Info.Directory.Create()
  1228. '合并文件
  1229. If IsNoSplit Then
  1230. '仅有一个线程,从缓存中输出
  1231. MergeFile = New FileStream(LocalPath, FileMode.Create)
  1232. AddWriter = New BinaryWriter(MergeFile)
  1233. AddWriter.Write(SmailFileCache.ToArray)
  1234. AddWriter.Dispose() : AddWriter = Nothing
  1235. MergeFile.Dispose() : MergeFile = Nothing
  1236. ElseIf Threads.DownloadDone = DownloadDone Then
  1237. '仅有一个文件,直接复制
  1238. File.Copy(Threads.Temp, LocalPath, True)
  1239. Else
  1240. '有多个线程,合并
  1241. MergeFile = New FileStream(LocalPath, FileMode.Create)
  1242. AddWriter = New BinaryWriter(MergeFile)
  1243. For Each Thread As NetThread In Threads
  1244. If Thread.DownloadDone = 0 Then Continue For
  1245. Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read)
  1246. Dim TempReader As New BinaryReader(fs)
  1247. AddWriter.Write(TempReader.ReadBytes(fs.Length))
  1248. TempReader.Close()
  1249. End Using
  1250. Next
  1251. AddWriter.Dispose() : AddWriter = Nothing
  1252. MergeFile.Dispose() : MergeFile = Nothing
  1253. End If
  1254. '写入大小要求
  1255. If Not IsUnknownSize AndAlso Check IsNot Nothing Then
  1256. If Check.ActualSize = -1 Then
  1257. Check.ActualSize = FileSize
  1258. ElseIf Check.ActualSize <> FileSize Then
  1259. Throw New Exception("文件大小不一致:任务要求为 " & Check.ActualSize & " B,网络获取结果为 " & FileSize & "B")
  1260. End If
  1261. End If
  1262. '检查文件
  1263. Dim CheckResult As String = Check?.Check(LocalPath)
  1264. If CheckResult IsNot Nothing Then
  1265. Log("[Download] " & "File size detail of " & Uuid & "# :")
  1266. For Each Th As NetThread In Threads
  1267. Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone)
  1268. Next
  1269. Throw New Exception(CheckResult)
  1270. End If
  1271. '后处理
  1272. If IsNoSplit Then
  1273. SmailFileCache = Nothing
  1274. Else
  1275. For Each Thread As NetThread In Threads
  1276. If Thread.Temp IsNot Nothing Then File.Delete(Thread.Temp)
  1277. Next
  1278. End If
  1279. Finish()
  1280. End SyncLock
  1281. Catch ex As Exception
  1282. Log(ex, "合并文件出错(" & LocalName & ")")
  1283. If MergeFile IsNot Nothing Then
  1284. MergeFile.Dispose() : MergeFile = Nothing
  1285. End If
  1286. If AddWriter IsNot Nothing Then
  1287. AddWriter.Dispose() : AddWriter = Nothing
  1288. End If
  1289. '重试
  1290. If RetryCount <= 3 Then
  1291. Threading.Thread.Sleep(RandomInteger(500, 1000))
  1292. RetryCount += 1
  1293. GoTo Retry
  1294. End If
  1295. Fail(ex)
  1296. End Try
  1297. End Sub
  1298. ''' <summary>
  1299. ''' 下载失败。
  1300. ''' </summary>
  1301. Private Sub Fail(Optional RaiseEx As Exception = Nothing)
  1302. SyncLock LockState
  1303. If State >= NetState.Finish Then Exit Sub
  1304. If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
  1305. '凉凉
  1306. State = NetState.Error
  1307. End SyncLock
  1308. Try
  1309. If File.Exists(LocalPath) Then File.Delete(LocalPath)
  1310. Catch
  1311. End Try
  1312. SyncLock NetManager.LockRemain
  1313. NetManager.FileRemain -= 1
  1314. Log("[Download] " & LocalName & ":已失败,剩余文件 " & NetManager.FileRemain)
  1315. 'If NetManage.FileRemainList.Contains(LocalPath) Then
  1316. ' NetManage.FileRemainList.Remove(LocalPath)
  1317. 'Else
  1318. ' Log("ERROR " & LocalPath)
  1319. 'End If
  1320. End SyncLock
  1321. For Each Task In Tasks
  1322. Task.OnFileFail(Me)
  1323. Next
  1324. End Sub
  1325. ''' <summary>
  1326. ''' 下载中断。
  1327. ''' </summary>
  1328. Public Sub Abort(CausedByTask As LoaderDownload)
  1329. '确认任务移除
  1330. SyncLock LockTasks
  1331. Tasks.Remove(CausedByTask)
  1332. If Tasks.Count > 0 Then Exit Sub
  1333. End SyncLock
  1334. '确认中断
  1335. SyncLock LockState
  1336. If State >= NetState.Finish Then Exit Sub
  1337. State = NetState.Error
  1338. End SyncLock
  1339. SyncLock NetManager.LockRemain
  1340. NetManager.FileRemain -= 1
  1341. If ModeDebug Then Log("[Download] " & LocalName & ":已取消,剩余文件 " & NetManager.FileRemain)
  1342. 'If NetManage.FileRemainList.Contains(LocalPath) Then
  1343. ' NetManage.FileRemainList.Remove(LocalPath)
  1344. 'Else
  1345. ' Log("ERROR " & LocalPath)
  1346. 'End If
  1347. End SyncLock
  1348. End Sub
  1349. '状态改变接口
  1350. ''' <summary>
  1351. ''' 将该文件设置为已下载完成。
  1352. ''' </summary>
  1353. Public Sub Finish(Optional PrintLog As Boolean = True)
  1354. SyncLock LockState
  1355. If State >= NetState.Finish Then Exit Sub
  1356. State = NetState.Finish
  1357. End SyncLock
  1358. SyncLock NetManager.LockRemain
  1359. NetManager.FileRemain -= 1
  1360. If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
  1361. 'If NetManage.FileRemainList.Contains(LocalPath) Then
  1362. ' NetManage.FileRemainList.Remove(LocalPath)
  1363. 'Else
  1364. ' Log("ERROR " & LocalPath)
  1365. 'End If
  1366. End SyncLock
  1367. SyncLock LockTasks
  1368. For Each Task In Tasks
  1369. Task.OnFileFinish(Me)
  1370. Next
  1371. End SyncLock
  1372. End Sub
  1373. End Class
  1374. ''' <summary>
  1375. ''' 下载一系列文件的加载器。
  1376. ''' </summary>
  1377. Public Class LoaderDownload
  1378. Inherits LoaderBase
  1379. #Region "属性"
  1380. ''' <summary>
  1381. ''' 需要下载的文件。
  1382. ''' </summary>
  1383. Public Files As List(Of NetFile)
  1384. Private ReadOnly FilesLock As New Object
  1385. ''' <summary>
  1386. ''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用)
  1387. ''' </summary>
  1388. Private FileRemain As Integer
  1389. Private ReadOnly FileRemainLock As New Object
  1390. ''' <summary>
  1391. ''' 用于显示的百分比进度。
  1392. ''' </summary>
  1393. Public Overrides Property Progress As Double
  1394. Get
  1395. If State >= LoadState.Finished Then Return 1
  1396. If Files.Count = 0 Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
  1397. Return _Progress
  1398. End Get
  1399. Set(value As Double)
  1400. Throw New Exception("文件下载不允许指定进度")
  1401. End Set
  1402. End Property
  1403. Private _Progress As Double = 0
  1404. ''' <summary>
  1405. ''' 任务中的文件的连续失败计数。
  1406. ''' </summary>
  1407. Public Property FailCount As Integer
  1408. Get
  1409. Return _FailCount
  1410. End Get
  1411. Set(value As Integer)
  1412. _FailCount = value
  1413. If State = LoadState.Loading AndAlso value >= Math.Min(2000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then
  1414. Log("[Download] 由于同加载器中失败次数过多引发强制失败:连续失败了 " & value & " 次", LogLevel.Debug)
  1415. On Error Resume Next
  1416. Dim ExList As New List(Of Exception)
  1417. SyncLock FilesLock
  1418. For Each File In Files
  1419. For Each Source In File.Sources
  1420. If Source.Ex IsNot Nothing Then
  1421. ExList.Add(Source.Ex)
  1422. If ExList.Count > 10 Then GoTo FinishExCatch
  1423. End If
  1424. Next
  1425. Next
  1426. End SyncLock
  1427. FinishExCatch:
  1428. OnFail(ExList)
  1429. End If
  1430. End Set
  1431. End Property
  1432. Private _FailCount As Integer = 0
  1433. #End Region
  1434. ''' <summary>
  1435. ''' 刷新公开属性。由 NetManager 每 0.2 秒调用一次。
  1436. ''' </summary>
  1437. Public Sub RefreshStat()
  1438. '计算进度
  1439. Dim NewProgress As Double = 0
  1440. Dim TotalProgress As Double = 0
  1441. SyncLock FilesLock
  1442. For Each File In Files
  1443. If File.IsCopy Then
  1444. NewProgress += File.Progress * 0.2
  1445. TotalProgress += 0.2
  1446. Else
  1447. NewProgress += File.Progress '* If(File.Progress < 1, 0.9, 1)
  1448. TotalProgress += 1
  1449. End If
  1450. Next
  1451. End SyncLock
  1452. If TotalProgress > 0 Then NewProgress /= TotalProgress
  1453. '刷新进度
  1454. If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 1 - (1 - NewProgress) ^ 0.9 'MathBezier(NewProgress, 0, 0.05, 1, 0.8, 0.0001)
  1455. _Progress = NewProgress * 0.99 + 0.01
  1456. End Sub
  1457. Public Sub New(Name As String, FileTasks As List(Of NetFile))
  1458. Me.Name = Name
  1459. Files = FileTasks
  1460. End Sub
  1461. Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
  1462. SyncLock FilesLock
  1463. If Input IsNot Nothing Then Files = Input
  1464. '去重
  1465. Dim ResultArray As New List(Of NetFile)
  1466. For i = 0 To Files.Count - 1
  1467. For ii = i + 1 To Files.Count - 1
  1468. If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
  1469. Next
  1470. ResultArray.Add(Files(i))
  1471. NextElement:
  1472. Next i
  1473. Files = ResultArray
  1474. '设置剩余文件数
  1475. SyncLock FileRemainLock
  1476. For Each File In Files
  1477. If File.State <> NetState.Finish Then FileRemain += 1
  1478. Next
  1479. End SyncLock
  1480. End SyncLock
  1481. State = LoadState.Loading
  1482. '开始执行
  1483. RunInNewThread(Sub()
  1484. Try
  1485. '输入检测
  1486. If Files.Count = 0 Then
  1487. OnFinish()
  1488. Exit Sub
  1489. End If
  1490. For Each File As NetFile In Files
  1491. If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
  1492. For Each Source As NetSource In File.Sources
  1493. If Not (Source.Url.ToLower.StartsWith("https://") OrElse Source.Url.ToLower.StartsWith("http://")) Then
  1494. Source.Ex = New ArgumentException("输入的下载链接不正确!")
  1495. Source.IsFailed = True
  1496. End If
  1497. Next
  1498. If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!")
  1499. If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确!")
  1500. If File.LocalPath.EndsWith("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
  1501. '文件夹检测
  1502. Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
  1503. If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
  1504. Next
  1505. '接入下载管理器
  1506. NetManager.Start(Me)
  1507. '将文件分配给多个线程以进行已存在查找
  1508. Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
  1509. Dim FoldersFinal As New List(Of String) '最终用于查找的列表
  1510. If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
  1511. Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹,因为 HMCL 会把所有文件存在这里
  1512. For Each Folder In McFolderList
  1513. Folders.Add(Folder.Path)
  1514. Next
  1515. Folders = ArrayNoDouble(Folders)
  1516. For Each Folder In Folders
  1517. If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
  1518. Next
  1519. End If
  1520. '最多 5 个线程,最少每个线程分配 10 个文件
  1521. SyncLock FilesLock
  1522. Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
  1523. Dim FilesInThread As New List(Of NetFile)
  1524. For Each File In Files
  1525. FilesInThread.Add(File)
  1526. If FilesInThread.Count = FilesPerThread Then
  1527. Dim FilesToRun As New List(Of NetFile)
  1528. FilesToRun.AddRange(FilesInThread)
  1529. RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
  1530. FilesInThread.Clear()
  1531. End If
  1532. Next
  1533. If FilesInThread.Count > 0 Then
  1534. Dim FilesToRun As New List(Of NetFile)
  1535. FilesToRun.AddRange(FilesInThread)
  1536. RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
  1537. FilesInThread.Clear()
  1538. End If
  1539. End SyncLock
  1540. Catch ex As Exception
  1541. OnFail(New List(Of Exception) From {ex})
  1542. End Try
  1543. End Sub, "NetTask " & Uuid & " Main")
  1544. End Sub
  1545. Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String))
  1546. Try
  1547. If ModeDebug Then Log("[Download] 检查线程分配文件数:" & Files.Count)
  1548. '试图从已存在的 Minecraft 文件夹中寻找目标文件
  1549. Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
  1550. For Each File As NetFile In Files
  1551. Dim ExistFilePath As String = Nothing
  1552. '判断是否有已存在的文件
  1553. If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWith(PathMcFolder) Then
  1554. Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
  1555. For Each Folder In FolderList
  1556. Dim Target = Folder & Relative
  1557. If File.Check.Check(Target) Is Nothing Then
  1558. ExistFilePath = Target
  1559. Exit For
  1560. End If
  1561. Next
  1562. End If
  1563. '若存在,则改变状态
  1564. SyncLock LockState
  1565. If ExistFilePath IsNot Nothing Then
  1566. File.State = NetState.WaitForCopy
  1567. File.IsCopy = True
  1568. ExistFiles.Add(New KeyValuePair(Of NetFile, String)(File, ExistFilePath))
  1569. Else
  1570. File.State = NetState.WaitForDownload
  1571. File.IsCopy = False
  1572. End If
  1573. End SyncLock
  1574. Next
  1575. '复制已存在的文件
  1576. For Each FileToken In ExistFiles
  1577. Dim File As NetFile = FileToken.Key
  1578. Dim LocalPath As String = FileToken.Value
  1579. Dim RetryCount As Integer = 0
  1580. Retry:
  1581. Try
  1582. Log("[Download] 复制已存在的文件(" & LocalPath & ")")
  1583. FileIO.FileSystem.CopyFile(LocalPath, File.LocalPath, True)
  1584. File.Finish(False)
  1585. Catch ex As Exception
  1586. RetryCount += 1
  1587. Log(ex, String.Format("复制已存在的文件失败,重试第 {2} 次({0} -> {1})", LocalPath, File.LocalPath, RetryCount))
  1588. If RetryCount < 3 Then
  1589. Thread.Sleep(200)
  1590. GoTo Retry
  1591. End If
  1592. File.State = NetState.WaitForDownload
  1593. File.IsCopy = False
  1594. End Try
  1595. Next
  1596. Catch ex As Exception
  1597. Log(ex, "下载已存在文件查找失败", LogLevel.Feedback)
  1598. End Try
  1599. End Sub
  1600. Public Sub OnFileFinish(File As NetFile)
  1601. '要求全部文件完成
  1602. SyncLock FileRemainLock
  1603. FileRemain -= 1
  1604. If FileRemain > 0 Then Exit Sub
  1605. End SyncLock
  1606. OnFinish()
  1607. End Sub
  1608. Public Sub OnFinish()
  1609. RaisePreviewFinish()
  1610. SyncLock LockState
  1611. If State > LoadState.Loading Then Exit Sub
  1612. State = LoadState.Finished
  1613. End SyncLock
  1614. End Sub
  1615. Public Sub OnFileFail(File As NetFile)
  1616. '将下载源的错误加入主错误列表
  1617. For Each Source In File.Sources
  1618. If Not IsNothing(Source.Ex) Then File.Ex.Add(Source.Ex)
  1619. Next
  1620. OnFail(File.Ex)
  1621. End Sub
  1622. Public Sub OnFail(ExList As List(Of Exception))
  1623. SyncLock LockState
  1624. If State > LoadState.Loading Then Exit Sub
  1625. If ExList Is Nothing OrElse ExList.Count = 0 Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
  1626. [Error] = ExList(0)
  1627. '获取实际失败的文件
  1628. SyncLock FilesLock
  1629. For Each File In Files
  1630. If File.State = NetState.Error Then
  1631. [Error] = New Exception("文件下载失败:" & File.LocalPath & "(第一下载源:" & File.Sources(0).Url & ")", ExList(0))
  1632. Exit For
  1633. End If
  1634. Next
  1635. End SyncLock
  1636. '在设置 Error 对象后再更改为失败,避免 WaitForExit 无法捕获错误
  1637. State = LoadState.Failed
  1638. End SyncLock
  1639. '中断所有文件
  1640. SyncLock FilesLock
  1641. For Each TaskFile In Files
  1642. If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error
  1643. Next
  1644. End SyncLock
  1645. '在退出同步锁后再进行日志输出
  1646. Dim ErrOutput As New List(Of String)
  1647. For Each Ex As Exception In ExList
  1648. ErrOutput.Add(GetString(Ex, False))
  1649. Next
  1650. Log("[Download] " & Join(ArrayNoDouble(ErrOutput.ToArray), vbCrLf))
  1651. End Sub
  1652. Public Overrides Sub Abort()
  1653. SyncLock LockState
  1654. If State >= LoadState.Finished Then Exit Sub
  1655. State = LoadState.Aborted
  1656. End SyncLock
  1657. Log("[Download] " & Name & " 已取消!")
  1658. '中断所有文件
  1659. SyncLock FilesLock
  1660. For Each TaskFile In Files
  1661. TaskFile.Abort(Me)
  1662. Next
  1663. End SyncLock
  1664. End Sub
  1665. End Class
  1666. Public NetManager As New NetManagerClass
  1667. ''' <summary>
  1668. ''' 下载文件管理。
  1669. ''' </summary>
  1670. Public Class NetManagerClass
  1671. #Region "属性"
  1672. ''' <summary>
  1673. ''' 需要下载的文件。为“本地地址 - 文件对象”键值对。
  1674. ''' </summary>
  1675. Public Files As New Dictionary(Of String, NetFile)
  1676. Public ReadOnly LockFiles As New Object
  1677. ''' <summary>
  1678. ''' 当前的所有下载任务。
  1679. ''' </summary>
  1680. Public Tasks As New List(Of LoaderDownload)
  1681. Private ReadOnly LockTasks As New Object
  1682. ''' <summary>
  1683. ''' 已下载完成的大小。
  1684. ''' </summary>
  1685. Public Property DownloadDone As Long
  1686. Get
  1687. Return _DownloadDone
  1688. End Get
  1689. Set(value As Long)
  1690. SyncLock LockDone
  1691. _DownloadDone = value
  1692. End SyncLock
  1693. End Set
  1694. End Property
  1695. Private _DownloadDone As Long = 0
  1696. Private ReadOnly LockDone As New Object
  1697. ''' <summary>
  1698. ''' 尚未完成下载的文件数。
  1699. ''' </summary>
  1700. Public FileRemain As Integer = 0
  1701. Public ReadOnly LockRemain As New Object
  1702. ''' <summary>
  1703. ''' 上次记速时的已下载大小。
  1704. ''' </summary>
  1705. Private SpeedLastDone As Long = 0
  1706. ''' <summary>
  1707. ''' 最近 10 次下载速度的记录,较新的在后面。间隔为 0.2 秒,故记录了 2 秒的速度。
  1708. ''' </summary>
  1709. Public SpeedLast As New List(Of Long) From {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
  1710. '这些属性由 RefreshStat 刷新
  1711. ''' <summary>
  1712. ''' 当前的全局下载速度,单位为 Byte / 秒。
  1713. ''' </summary>
  1714. Public Speed As Long = 0
  1715. Public ReadOnly Uuid As Integer = GetUuid()
  1716. #End Region
  1717. ''' <summary>
  1718. ''' 进度与下载速度由下载管理线程每隔约 0.2 秒刷新一次。
  1719. ''' </summary>
  1720. Private Sub RefreshStat()
  1721. Try
  1722. Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
  1723. RefreshStatLast += DeltaTime
  1724. #Region "刷新整体速度"
  1725. '计算即时速度
  1726. Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000))
  1727. SpeedLast.Add(ActualSpeed)
  1728. SpeedLast.RemoveAt(0)
  1729. SpeedLastDone = DownloadDone
  1730. '计算用于显示的速度
  1731. 'If SpeedLast(9) = 0 Then
  1732. ' Speed = 0
  1733. 'Else
  1734. Speed = (SpeedLast(9) + SpeedLast(8) * 0.9 + SpeedLast(7) * 0.8 + SpeedLast(6) * 0.7 + SpeedLast(5) * 0.6 + SpeedLast(4) * 0.5 + SpeedLast(3) * 0.4 + SpeedLast(2) * 0.3 + SpeedLast(1) * 0.2 + SpeedLast(0) * 0.1) / 5.5
  1735. 'End If
  1736. '计算新的速度下限
  1737. SpeedLast.Add(ActualSpeed)
  1738. SpeedLast.RemoveAt(0)
  1739. Dim Limit As Long = Math.Min(Math.Min(Math.Min(Math.Min(SpeedLast(5), SpeedLast(6)), SpeedLast(7)), SpeedLast(8)), SpeedLast(9)) * 0.9
  1740. If Limit > NetTaskSpeedLimitLow Then
  1741. NetTaskSpeedLimitLow = Limit
  1742. Log("[Download] " & "速度下限已提升到 " & GetString(Limit))
  1743. End If
  1744. #End Region
  1745. #Region "刷新下载任务属性"
  1746. SyncLock LockTasks
  1747. For Each Task In Tasks
  1748. Task.RefreshStat()
  1749. Next
  1750. End SyncLock
  1751. #End Region
  1752. Catch ex As Exception
  1753. Log(ex, "刷新下载公开属性失败")
  1754. End Try
  1755. End Sub
  1756. Private RefreshStatLast As Long
  1757. ''' <summary>
  1758. ''' 启动监控线程,用于新增下载线程。
  1759. ''' </summary>
  1760. Private Sub StartManager()
  1761. If IsManagerStarted Then Exit Sub
  1762. IsManagerStarted = True
  1763. RunInNewThread(Sub()
  1764. Try
  1765. Dim LastLoopTime As Long
  1766. While True
  1767. LastLoopTime = GetTimeTick()
  1768. '若已完成,则清空
  1769. If FileRemain = 0 AndAlso Files.Count > 0 Then
  1770. SyncLock LockFiles
  1771. Files.Clear()
  1772. End SyncLock
  1773. End If
  1774. '开启新线程
  1775. If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
  1776. '速度小于下限或剩余文件还贼多,尝试开启线程
  1777. Dim IsSuccess As Boolean = False
  1778. Dim NewThreadCount As Integer
  1779. '确定最大线程追加数
  1780. NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
  1781. NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
  1782. NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
  1783. '循环追加
  1784. Do
  1785. IsSuccess = False
  1786. '启动 Wait 的文件后立即会变成 Connect,导致第二次循环再次调用,所以需要先暂时存储进去……
  1787. '此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
  1788. Dim FilesWaiting As New List(Of NetFile)
  1789. Dim FilesLoading As New List(Of NetFile)
  1790. SyncLock LockFiles
  1791. For Each File As NetFile In Files.Values
  1792. If File.RandomCode Mod 2 = 0 Then Continue For
  1793. If File.State = NetState.WaitForDownload Then
  1794. FilesWaiting.Add(File)
  1795. ElseIf File.State < NetState.Merge Then
  1796. FilesLoading.Add(File)
  1797. End If
  1798. Next
  1799. End SyncLock
  1800. '为文件列表中的文件开始线程
  1801. For Each File As NetFile In FilesWaiting
  1802. If NewThreadCount = 0 Then Exit For
  1803. If File.TryBeginThread() Then
  1804. IsSuccess = True
  1805. NewThreadCount -= 1
  1806. End If
  1807. Next
  1808. For Each File As NetFile In FilesLoading
  1809. If NewThreadCount = 0 Then Exit For
  1810. If File.TryBeginThread() Then
  1811. IsSuccess = True
  1812. NewThreadCount -= 1
  1813. End If
  1814. Next
  1815. Loop While NewThreadCount > 0 AndAlso IsSuccess
  1816. End If
  1817. '等待直至 120 ms
  1818. Do While GetTimeTick() - LastLoopTime < 120
  1819. Thread.Sleep(10)
  1820. Loop
  1821. End While
  1822. Catch ex As Exception
  1823. Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert)
  1824. End Try
  1825. End Sub, "NetManager ThreadStarter Single")
  1826. RunInNewThread(Sub()
  1827. Try
  1828. Dim LastLoopTime As Long
  1829. While True
  1830. LastLoopTime = GetTimeTick()
  1831. '开启新线程
  1832. If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
  1833. '速度小于下限或剩余文件还贼多,尝试开启线程
  1834. Dim IsSuccess As Boolean = False
  1835. Dim NewThreadCount As Integer
  1836. '确定最大线程追加数
  1837. NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
  1838. NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
  1839. NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
  1840. '循环追加
  1841. Do
  1842. IsSuccess = False
  1843. '启动 Wait 的文件后立即会变成 Connect,导致第二次循环再次调用,所以需要先暂时存储进去……
  1844. '此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
  1845. Dim FilesWaiting As New List(Of NetFile)
  1846. Dim FilesLoading As New List(Of NetFile)
  1847. SyncLock LockFiles
  1848. For Each File As NetFile In Files.Values
  1849. If File.RandomCode Mod 2 = 1 Then Continue For
  1850. If File.State = NetState.WaitForDownload Then
  1851. FilesWaiting.Add(File)
  1852. ElseIf File.State < NetState.Merge Then
  1853. FilesLoading.Add(File)
  1854. End If
  1855. Next
  1856. End SyncLock
  1857. '为文件列表中的文件开始线程
  1858. For Each File As NetFile In FilesWaiting
  1859. If NewThreadCount = 0 Then Exit For
  1860. If File.TryBeginThread() Then
  1861. IsSuccess = True
  1862. NewThreadCount -= 1
  1863. End If
  1864. Next
  1865. For Each File As NetFile In FilesLoading
  1866. If NewThreadCount = 0 Then Exit For
  1867. If File.TryBeginThread() Then
  1868. IsSuccess = True
  1869. NewThreadCount -= 1
  1870. End If
  1871. Next
  1872. Loop While NewThreadCount > 0 AndAlso IsSuccess
  1873. End If
  1874. '等待直至 120 ms
  1875. Do While GetTimeTick() - LastLoopTime < 120
  1876. Thread.Sleep(10)
  1877. Loop
  1878. End While
  1879. Catch ex As Exception
  1880. Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
  1881. End Try
  1882. End Sub, "NetManager ThreadStarter Odd")
  1883. RunInNewThread(Sub()
  1884. Try
  1885. Dim LastLoopTime As Long
  1886. NetTaskSpeedLimitLeftLast = GetTimeTick()
  1887. While True
  1888. Dim TimeNow = GetTimeTick()
  1889. LastLoopTime = TimeNow
  1890. '增加限速余量
  1891. If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
  1892. NetTaskSpeedLimitLeftLast = TimeNow
  1893. '刷新公开属性
  1894. RefreshStat()
  1895. '等待直至 170 ms
  1896. Do While GetTimeTick() - LastLoopTime < 170
  1897. Thread.Sleep(10)
  1898. Loop
  1899. End While
  1900. Catch ex As Exception
  1901. Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
  1902. End Try
  1903. End Sub, "NetManager StatRefresher")
  1904. End Sub
  1905. Private IsManagerStarted As Boolean = False
  1906. 'Public FileRemainList As New List(Of String)
  1907. Private IsDownloadCacheCleared As Boolean = False
  1908. ''' <summary>
  1909. ''' 开始一个下载任务。
  1910. ''' </summary>
  1911. Public Sub Start(Task As LoaderDownload)
  1912. StartManager()
  1913. '清理缓存
  1914. If Not IsDownloadCacheCleared Then
  1915. Try
  1916. DeleteDirectory(PathTemp & "Download")
  1917. Catch ex As Exception
  1918. Log(ex, "清理下载缓存失败")
  1919. End Try
  1920. IsDownloadCacheCleared = True
  1921. End If
  1922. Directory.CreateDirectory(PathTemp & "Download")
  1923. '文件处理
  1924. SyncLock LockFiles
  1925. '添加每个文件
  1926. For i = 0 To Task.Files.Count - 1
  1927. Dim File = Task.Files(i)
  1928. If Files.ContainsKey(File.LocalPath) Then
  1929. '已有该文件
  1930. If Files(File.LocalPath).State >= NetState.Finish Then
  1931. '该文件已经下载过一次,且下载完成
  1932. '将已下载的文件替换成当前文件,重新下载
  1933. SyncLock File.LockTasks
  1934. File.Tasks.Add(Task)
  1935. End SyncLock
  1936. Files(File.LocalPath) = File
  1937. SyncLock LockRemain
  1938. FileRemain += 1
  1939. If ModeDebug Then Log("[Download] " & File.LocalName & ":已替换列表,剩余文件 " & FileRemain)
  1940. 'FileRemainList.Add(File.LocalPath)
  1941. End SyncLock
  1942. Else
  1943. '该文件正在下载中
  1944. '将当前文件替换成下载中的文件,即两个任务指向同一个文件
  1945. File = Files(File.LocalPath)
  1946. SyncLock File.LockTasks
  1947. File.Tasks.Add(Task)
  1948. End SyncLock
  1949. End If
  1950. Else
  1951. '没有该文件
  1952. SyncLock File.LockTasks
  1953. File.Tasks.Add(Task)
  1954. End SyncLock
  1955. Files.Add(File.LocalPath, File)
  1956. SyncLock LockRemain
  1957. FileRemain += 1
  1958. If ModeDebug Then Log("[Download] " & File.LocalName & ":已加入列表,剩余文件 " & FileRemain)
  1959. 'FileRemainList.Add(File.LocalPath)
  1960. End SyncLock
  1961. End If
  1962. Task.Files(i) = File '回设
  1963. Next
  1964. End SyncLock
  1965. SyncLock LockTasks
  1966. Tasks.Add(Task)
  1967. End SyncLock
  1968. End Sub
  1969. End Class
  1970. ''' <summary>
  1971. ''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
  1972. ''' </summary>
  1973. Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
  1974. SyncLock LoaderTaskbarLock
  1975. For Each Task In LoaderTaskbar
  1976. If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
  1977. (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
  1978. Return True
  1979. End If
  1980. Next
  1981. End SyncLock
  1982. Return False
  1983. End Function
  1984. End Module