ModNet.vb 99 KB

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