ModNet.vb 95 KB

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