ModNet.vb 93 KB

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