ModNet.vb 98 KB

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