ModNet.vb 90 KB

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