ModNet.vb 93 KB

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