ModNet.vb 92 KB

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