ModNet.vb 93 KB

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