ModNet.vb 94 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022
  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 Queue(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 Queue(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. For Each B In HttpData
  1115. SmailFileCache.Enqueue(B)
  1116. Next
  1117. Else
  1118. 'SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount))
  1119. For i = 0 To RealDataCount - 1
  1120. SmailFileCache.Enqueue(HttpData(i))
  1121. Next
  1122. End If
  1123. Else
  1124. ResultStream.Write(HttpData, 0, RealDataCount)
  1125. End If
  1126. '检查速度是否过慢
  1127. If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s,且速度小于 1K/s
  1128. Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。")
  1129. End If
  1130. Info.LastReceiveTime = GetTimeTick()
  1131. '已完成
  1132. If Info.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
  1133. ElseIf Info.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
  1134. '无数据,且已超时
  1135. Throw New TimeoutException("操作超时,无数据。")
  1136. End If
  1137. HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
  1138. End While
  1139. End Using
  1140. End Using
  1141. SourceBreak:
  1142. If State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
  1143. '被外部中断
  1144. Info.State = NetState.Error
  1145. Log($"[Download] {LocalName} {Info.Uuid}#:中断")
  1146. ElseIf HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
  1147. '服务器无返回数据
  1148. Throw New Exception($"返回的 ContentLength 过多:ContentLength 为 {ContentLength},但获取到的总数据量仅为 {Info.DownloadDone}(全文件总数据量 {DownloadDone})")
  1149. Else
  1150. '本线程完成
  1151. Info.State = NetState.Finish
  1152. If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#:完成,已下载 {Info.DownloadDone}")
  1153. End If
  1154. Catch ex As Exception
  1155. '状态变更
  1156. SyncLock LockCount
  1157. Info.Source.FailCount += 1
  1158. SyncLock LockTasks
  1159. For Each Task In Tasks
  1160. Task.FailCount += 1
  1161. Next
  1162. End SyncLock
  1163. End SyncLock
  1164. Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
  1165. Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
  1166. IsTimeoutString.Contains("超时") OrElse IsTimeoutString.Contains("timeout") OrElse IsTimeoutString.Contains("timedout")
  1167. Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#:超时(" & (Timeout * 0.001) & "s)", "#:出错," & GetExceptionDetail(ex)))
  1168. Info.State = NetState.Error
  1169. ''使用该下载源的线程是否没有速度
  1170. ''下载超时也会导致没有速度,容易误判下载失败,所以已弃用此方法
  1171. 'Dim IsNoSpeed As Boolean = True
  1172. 'SyncLock LockChain
  1173. ' If Threads IsNot Nothing Then
  1174. ' For Each Thread As NetThread In Threads
  1175. ' If Thread.Source.Id = Info.Source.Id AndAlso Thread.Speed > 0 Then
  1176. ' IsNoSpeed = False
  1177. ' Exit For
  1178. ' End If
  1179. ' Next
  1180. ' End If
  1181. 'End SyncLock
  1182. Info.Source.Ex = ex
  1183. '根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
  1184. If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
  1185. ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
  1186. (ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403,所以不应因此禁用下载源
  1187. (Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
  1188. Info.Source.FailCount > NetTaskThreadLimit + 2 Then
  1189. Dim IsThisFail As Boolean = False
  1190. SyncLock LockSource
  1191. If Info.Source.Thread IsNot Nothing AndAlso Info.Source.Thread.Equals(Info) Then
  1192. '单线程下,本线程出错
  1193. SourcesOnce.RemoveAt(0)
  1194. GoTo Wrong
  1195. ElseIf Not Info.Source.IsFailed Then
  1196. '多线程下,本线程出错
  1197. Wrong:
  1198. Info.Source.IsFailed = True
  1199. IsThisFail = True
  1200. End If
  1201. End SyncLock
  1202. '本线程引发下载源被禁用
  1203. If IsThisFail Then
  1204. Log($"[Download] {LocalName} {Info.Uuid}#:下载源被禁用({Info.Source.Id}):{Info.Source.Url}")
  1205. Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持分段下载") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
  1206. If IsSourceFailed() Then
  1207. '没有可用源
  1208. Log("[Download] 文件 " & LocalName & " 已无可用下载源")
  1209. Dim ExampleEx As Exception = Nothing
  1210. SyncLock LockSource
  1211. For Each Source As NetSource In Sources
  1212. Log("[Download] 已禁用的下载源:" & Source.Url)
  1213. If Source.Ex IsNot Nothing Then
  1214. ExampleEx = Source.Ex
  1215. Log(Source.Ex, "下载源禁用原因", LogLevel.Developer)
  1216. End If
  1217. Next
  1218. End SyncLock
  1219. Fail(ExampleEx)
  1220. ElseIf ex.Message.Contains("空间不足") Then
  1221. '没有空间
  1222. Fail(ex)
  1223. End If
  1224. End If
  1225. End If
  1226. '首线程错误
  1227. If FileSize = -2 Then
  1228. SyncLock LockChain
  1229. Threads = Nothing
  1230. End SyncLock
  1231. End If
  1232. Finally
  1233. If ResultStream IsNot Nothing Then ResultStream.Dispose()
  1234. SyncLock NetTaskThreadCountLock
  1235. NetTaskThreadCount -= 1
  1236. End SyncLock
  1237. '可能在没有下载完的时候开始合并文件了,这造成了大多数合并失败
  1238. If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
  1239. End Try
  1240. End Sub
  1241. '下载文件的最终收束事件
  1242. ''' <summary>
  1243. ''' 下载完成。合并文件。
  1244. ''' </summary>
  1245. Private Sub Merge()
  1246. '状态判断
  1247. SyncLock LockState
  1248. If State < NetState.Merge Then
  1249. State = NetState.Merge
  1250. Else
  1251. Exit Sub
  1252. End If
  1253. End SyncLock
  1254. Dim RetryCount As Integer = 0
  1255. Dim MergeFile As Stream = Nothing, AddWriter As BinaryWriter = Nothing
  1256. Try
  1257. Retry:
  1258. SyncLock LockChain
  1259. '创建文件夹
  1260. If File.Exists(LocalPath) Then File.Delete(LocalPath)
  1261. Dim Info As New FileInfo(LocalPath)
  1262. Info.Directory.Create()
  1263. '合并文件
  1264. If IsNoSplit Then
  1265. '仅有一个线程,从缓存中输出
  1266. If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件")
  1267. MergeFile = New FileStream(LocalPath, FileMode.Create)
  1268. AddWriter = New BinaryWriter(MergeFile)
  1269. AddWriter.Write(SmailFileCache.ToArray)
  1270. AddWriter.Dispose() : AddWriter = Nothing
  1271. MergeFile.Dispose() : MergeFile = Nothing
  1272. ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
  1273. '仅有一个文件,直接复制
  1274. If ModeDebug Then Log($"[Download] {LocalName}:下载结束,仅有一个文件,无需合并")
  1275. CopyFile(Threads.Temp, LocalPath)
  1276. Else
  1277. '有多个线程,合并
  1278. If ModeDebug Then Log($"[Download] {LocalName}:下载结束,开始合并文件")
  1279. MergeFile = New FileStream(LocalPath, FileMode.Create)
  1280. AddWriter = New BinaryWriter(MergeFile)
  1281. For Each Thread As NetThread In Threads
  1282. If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For
  1283. Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read)
  1284. Using TempReader As New BinaryReader(fs)
  1285. AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone))
  1286. End Using
  1287. End Using
  1288. Next
  1289. AddWriter.Dispose() : AddWriter = Nothing
  1290. MergeFile.Dispose() : MergeFile = Nothing
  1291. End If
  1292. '写入大小要求
  1293. If Not IsUnknownSize AndAlso Check IsNot Nothing Then
  1294. If Check.ActualSize = -1 Then
  1295. Check.ActualSize = FileSize
  1296. ElseIf Check.ActualSize <> FileSize Then
  1297. Throw New Exception("文件大小不一致:任务要求为 " & Check.ActualSize & " B,网络获取结果为 " & FileSize & "B")
  1298. End If
  1299. End If
  1300. '检查文件
  1301. Dim CheckResult As String = Check?.Check(LocalPath)
  1302. If CheckResult IsNot Nothing Then
  1303. Log($"[Download] {LocalName} 合并文件失败,下载线程细节:")
  1304. For Each Th As NetThread In Threads
  1305. Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}")
  1306. Next
  1307. Throw New Exception(CheckResult)
  1308. End If
  1309. '后处理
  1310. If IsNoSplit Then
  1311. SmailFileCache = Nothing
  1312. Else
  1313. For Each Thread As NetThread In Threads
  1314. If Thread.Temp IsNot Nothing Then File.Delete(Thread.Temp)
  1315. Next
  1316. End If
  1317. Finish()
  1318. End SyncLock
  1319. Catch ex As Exception
  1320. Log(ex, "合并文件出错(" & LocalName & ")")
  1321. If MergeFile IsNot Nothing Then
  1322. MergeFile.Dispose() : MergeFile = Nothing
  1323. End If
  1324. If AddWriter IsNot Nothing Then
  1325. AddWriter.Dispose() : AddWriter = Nothing
  1326. End If
  1327. '重试
  1328. If RetryCount <= 3 Then
  1329. Threading.Thread.Sleep(RandomInteger(500, 1000))
  1330. RetryCount += 1
  1331. GoTo Retry
  1332. End If
  1333. Fail(ex)
  1334. End Try
  1335. End Sub
  1336. ''' <summary>
  1337. ''' 下载失败。
  1338. ''' </summary>
  1339. Private Sub Fail(Optional RaiseEx As Exception = Nothing)
  1340. SyncLock LockState
  1341. If State >= NetState.Finish Then Exit Sub
  1342. If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
  1343. '凉凉
  1344. State = NetState.Error
  1345. End SyncLock
  1346. InterruptAndDelete()
  1347. For Each Task In Tasks
  1348. Task.OnFileFail(Me)
  1349. Next
  1350. End Sub
  1351. ''' <summary>
  1352. ''' 下载中断。
  1353. ''' </summary>
  1354. Public Sub Abort(CausedByTask As LoaderDownload)
  1355. '从特定任务中移除,如果它还属于其他任务,则继续下载
  1356. SyncLock LockTasks
  1357. Tasks.Remove(CausedByTask)
  1358. If Tasks.Any Then Exit Sub
  1359. End SyncLock
  1360. '确认中断
  1361. SyncLock LockState
  1362. If State >= NetState.Finish Then Exit Sub
  1363. State = NetState.Error
  1364. End SyncLock
  1365. InterruptAndDelete()
  1366. End Sub
  1367. Private Sub InterruptAndDelete()
  1368. On Error Resume Next
  1369. If File.Exists(LocalPath) Then File.Delete(LocalPath)
  1370. SyncLock NetManager.LockRemain
  1371. NetManager.FileRemain -= 1
  1372. Log($"[Download] {LocalName}:状态 {State},剩余文件 {NetManager.FileRemain}")
  1373. End SyncLock
  1374. End Sub
  1375. '状态改变接口
  1376. ''' <summary>
  1377. ''' 将该文件设置为已下载完成。
  1378. ''' </summary>
  1379. Public Sub Finish(Optional PrintLog As Boolean = True)
  1380. SyncLock LockState
  1381. If State >= NetState.Finish Then Exit Sub
  1382. State = NetState.Finish
  1383. End SyncLock
  1384. SyncLock NetManager.LockRemain
  1385. NetManager.FileRemain -= 1
  1386. If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
  1387. End SyncLock
  1388. SyncLock LockTasks
  1389. For Each Task In Tasks
  1390. Task.OnFileFinish(Me)
  1391. Next
  1392. End SyncLock
  1393. End Sub
  1394. End Class
  1395. ''' <summary>
  1396. ''' 下载一系列文件的加载器。
  1397. ''' </summary>
  1398. Public Class LoaderDownload
  1399. Inherits LoaderBase
  1400. #Region "属性"
  1401. ''' <summary>
  1402. ''' 需要下载的文件。
  1403. ''' </summary>
  1404. Public Files As List(Of NetFile)
  1405. Private ReadOnly FilesLock As New Object
  1406. ''' <summary>
  1407. ''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用)
  1408. ''' </summary>
  1409. Private FileRemain As Integer
  1410. Private ReadOnly FileRemainLock As New Object
  1411. ''' <summary>
  1412. ''' 用于显示的百分比进度。
  1413. ''' </summary>
  1414. Public Overrides Property Progress As Double
  1415. Get
  1416. If State >= LoadState.Finished Then Return 1
  1417. SyncLock FilesLock
  1418. If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
  1419. End SyncLock
  1420. Return _Progress
  1421. End Get
  1422. Set(value As Double)
  1423. Throw New Exception("文件下载不允许指定进度")
  1424. End Set
  1425. End Property
  1426. Private _Progress As Double = 0
  1427. ''' <summary>
  1428. ''' 任务中的文件的连续失败计数。
  1429. ''' </summary>
  1430. Public Property FailCount As Integer
  1431. Get
  1432. Return _FailCount
  1433. End Get
  1434. Set(value As Integer)
  1435. _FailCount = value
  1436. If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then
  1437. Log("[Download] 由于同加载器中失败次数过多引发强制失败:连续失败了 " & value & " 次", LogLevel.Debug)
  1438. On Error Resume Next
  1439. Dim ExList As New List(Of Exception)
  1440. SyncLock FilesLock
  1441. For Each File In Files
  1442. For Each Source In File.Sources
  1443. If Source.Ex IsNot Nothing Then
  1444. ExList.Add(Source.Ex)
  1445. If ExList.Count > 10 Then GoTo FinishExCatch
  1446. End If
  1447. Next
  1448. Next
  1449. End SyncLock
  1450. FinishExCatch:
  1451. OnFail(ExList)
  1452. End If
  1453. End Set
  1454. End Property
  1455. Private _FailCount As Integer = 0
  1456. #End Region
  1457. ''' <summary>
  1458. ''' 刷新公开属性。由 NetManager 每 0.1 秒调用一次。
  1459. ''' </summary>
  1460. Public Sub RefreshStat()
  1461. '计算进度
  1462. Dim NewProgress As Double = 0
  1463. Dim TotalProgress As Double = 0
  1464. SyncLock FilesLock
  1465. For Each File In Files
  1466. If File.IsCopy Then
  1467. NewProgress += File.Progress * 0.2
  1468. TotalProgress += 0.2
  1469. Else
  1470. NewProgress += File.Progress
  1471. TotalProgress += 1
  1472. End If
  1473. Next
  1474. End SyncLock
  1475. If TotalProgress > 0 Then NewProgress /= TotalProgress
  1476. '刷新进度
  1477. If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x,模拟开头和结尾更慢的情况
  1478. _Progress = NewProgress
  1479. End Sub
  1480. Public Sub New(Name As String, FileTasks As List(Of NetFile))
  1481. Me.Name = Name
  1482. Files = FileTasks
  1483. End Sub
  1484. Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
  1485. SyncLock FilesLock
  1486. If Input IsNot Nothing Then Files = Input
  1487. '去重
  1488. Dim ResultArray As New List(Of NetFile)
  1489. For i = 0 To Files.Count - 1
  1490. For ii = i + 1 To Files.Count - 1
  1491. If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
  1492. Next
  1493. ResultArray.Add(Files(i))
  1494. NextElement:
  1495. Next i
  1496. Files = ResultArray
  1497. '设置剩余文件数
  1498. SyncLock FileRemainLock
  1499. For Each File In Files
  1500. If File.State <> NetState.Finish Then FileRemain += 1
  1501. Next
  1502. End SyncLock
  1503. End SyncLock
  1504. State = LoadState.Loading
  1505. '开始执行
  1506. RunInNewThread(
  1507. Sub()
  1508. Try
  1509. '输入检测
  1510. If Not Files.Any() Then
  1511. OnFinish()
  1512. Exit Sub
  1513. End If
  1514. For Each File As NetFile In Files
  1515. If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
  1516. For Each Source As NetSource In File.Sources
  1517. If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then
  1518. Source.Ex = New ArgumentException("输入的下载链接不正确!")
  1519. Source.IsFailed = True
  1520. End If
  1521. Next
  1522. If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!")
  1523. If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确!")
  1524. If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
  1525. '文件夹检测
  1526. Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
  1527. If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
  1528. Next
  1529. '接入下载管理器
  1530. NetManager.Start(Me)
  1531. '将文件分配给多个线程以进行已存在查找
  1532. Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
  1533. Dim FoldersFinal As New List(Of String) '最终用于查找的列表
  1534. If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
  1535. Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹,因为 HMCL 会把所有文件存在这里
  1536. For Each Folder In McFolderList
  1537. Folders.Add(Folder.Path)
  1538. Next
  1539. Folders = Folders.Distinct.ToList
  1540. For Each Folder In Folders
  1541. If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
  1542. Next
  1543. End If
  1544. '最多 5 个线程,最少每个线程分配 10 个文件
  1545. SyncLock FilesLock
  1546. Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
  1547. Dim FilesInThread As New List(Of NetFile)
  1548. For Each File In Files
  1549. FilesInThread.Add(File)
  1550. If FilesInThread.Count = FilesPerThread Then
  1551. Dim FilesToRun As New List(Of NetFile)
  1552. FilesToRun.AddRange(FilesInThread)
  1553. RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
  1554. FilesInThread.Clear()
  1555. End If
  1556. Next
  1557. If FilesInThread.Any Then
  1558. Dim FilesToRun As New List(Of NetFile)
  1559. FilesToRun.AddRange(FilesInThread)
  1560. RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
  1561. FilesInThread.Clear()
  1562. End If
  1563. End SyncLock
  1564. Catch ex As Exception
  1565. OnFail(New List(Of Exception) From {ex})
  1566. End Try
  1567. End Sub, "NetTask " & Uuid & " Main")
  1568. End Sub
  1569. Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String))
  1570. Try
  1571. If ModeDebug Then Log("[Download] 检查线程分配文件数:" & Files.Count & ",线程名:" & Thread.CurrentThread.Name)
  1572. '试图从已存在的 Minecraft 文件夹中寻找目标文件
  1573. Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
  1574. For Each File As NetFile In Files
  1575. Dim ExistFilePath As String = Nothing
  1576. '判断是否有已存在的文件
  1577. If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
  1578. Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
  1579. For Each Folder In FolderList
  1580. Dim Target = Folder & Relative
  1581. If File.Check.Check(Target) Is Nothing Then
  1582. ExistFilePath = Target
  1583. Exit For
  1584. End If
  1585. Next
  1586. End If
  1587. '若存在,则改变状态
  1588. SyncLock LockState
  1589. If ExistFilePath IsNot Nothing Then
  1590. File.State = NetState.WaitForCopy
  1591. File.IsCopy = True
  1592. ExistFiles.Add(New KeyValuePair(Of NetFile, String)(File, ExistFilePath))
  1593. Else
  1594. File.State = NetState.WaitForDownload
  1595. File.IsCopy = False
  1596. End If
  1597. End SyncLock
  1598. Next
  1599. '复制已存在的文件
  1600. For Each FileToken In ExistFiles
  1601. Dim File As NetFile = FileToken.Key
  1602. Dim LocalPath As String = FileToken.Value
  1603. Dim RetryCount As Integer = 0
  1604. Retry:
  1605. Try
  1606. Log("[Download] 复制已存在的文件(" & LocalPath & ")")
  1607. CopyFile(LocalPath, File.LocalPath)
  1608. File.Finish(False)
  1609. Catch ex As Exception
  1610. RetryCount += 1
  1611. Log(ex, String.Format("复制已存在的文件失败,重试第 {2} 次({0} -> {1})", LocalPath, File.LocalPath, RetryCount))
  1612. If RetryCount < 3 Then
  1613. Thread.Sleep(200)
  1614. GoTo Retry
  1615. End If
  1616. File.State = NetState.WaitForDownload
  1617. File.IsCopy = False
  1618. End Try
  1619. Next
  1620. Catch ex As Exception
  1621. Log(ex, "下载已存在文件查找失败", LogLevel.Feedback)
  1622. End Try
  1623. End Sub
  1624. Public Sub OnFileFinish(File As NetFile)
  1625. '要求全部文件完成
  1626. SyncLock FileRemainLock
  1627. FileRemain -= 1
  1628. If FileRemain > 0 Then Exit Sub
  1629. End SyncLock
  1630. OnFinish()
  1631. End Sub
  1632. Public Sub OnFinish()
  1633. RaisePreviewFinish()
  1634. SyncLock LockState
  1635. If State > LoadState.Loading Then Exit Sub
  1636. State = LoadState.Finished
  1637. End SyncLock
  1638. End Sub
  1639. Public Sub OnFileFail(File As NetFile)
  1640. '将下载源的错误加入主错误列表
  1641. For Each Source In File.Sources
  1642. If Not IsNothing(Source.Ex) Then File.Ex.Add(Source.Ex)
  1643. Next
  1644. OnFail(File.Ex)
  1645. End Sub
  1646. Public Sub OnFail(ExList As List(Of Exception))
  1647. SyncLock LockState
  1648. If State > LoadState.Loading Then Exit Sub
  1649. If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
  1650. '寻找第一个不是 404 的下载源
  1651. Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
  1652. [Error] = If(UsefulExs.Any, UsefulExs(0), ExList(0))
  1653. '获取实际失败的文件
  1654. SyncLock FilesLock
  1655. For Each File In Files
  1656. If File.State = NetState.Error Then
  1657. [Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf & Join(
  1658. File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "(" & s.Url & ")")), vbCrLf), [Error])
  1659. Exit For
  1660. End If
  1661. Next
  1662. End SyncLock
  1663. '在设置 Error 对象后再更改为失败,避免 WaitForExit 无法捕获错误
  1664. State = LoadState.Failed
  1665. End SyncLock
  1666. '中断所有文件
  1667. SyncLock FilesLock
  1668. For Each TaskFile In Files
  1669. If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error
  1670. Next
  1671. End SyncLock
  1672. '在退出同步锁后再进行日志输出
  1673. Dim ErrOutput As New List(Of String)
  1674. For Each Ex As Exception In ExList
  1675. ErrOutput.Add(GetExceptionDetail(Ex))
  1676. Next
  1677. Log("[Download] " & Join(ErrOutput.Distinct.ToArray, vbCrLf))
  1678. End Sub
  1679. Public Overrides Sub Abort()
  1680. SyncLock LockState
  1681. If State >= LoadState.Finished Then Exit Sub
  1682. State = LoadState.Aborted
  1683. End SyncLock
  1684. Log("[Download] " & Name & " 已取消!")
  1685. '中断所有文件
  1686. SyncLock FilesLock
  1687. For Each TaskFile In Files
  1688. TaskFile.Abort(Me)
  1689. Next
  1690. End SyncLock
  1691. End Sub
  1692. End Class
  1693. Public NetManager As New NetManagerClass
  1694. ''' <summary>
  1695. ''' 下载文件管理。
  1696. ''' </summary>
  1697. Public Class NetManagerClass
  1698. #Region "属性"
  1699. ''' <summary>
  1700. ''' 需要下载的文件。为“本地地址 - 文件对象”键值对。
  1701. ''' </summary>
  1702. Public Files As New Dictionary(Of String, NetFile)
  1703. Public ReadOnly LockFiles As New Object
  1704. ''' <summary>
  1705. ''' 当前的所有下载任务。
  1706. ''' </summary>
  1707. Public Tasks As New List(Of LoaderDownload)
  1708. Private ReadOnly LockTasks As New Object
  1709. ''' <summary>
  1710. ''' 已下载完成的大小。
  1711. ''' </summary>
  1712. Public Property DownloadDone As Long
  1713. Get
  1714. Return _DownloadDone
  1715. End Get
  1716. Set(value As Long)
  1717. SyncLock LockDone
  1718. _DownloadDone = value
  1719. End SyncLock
  1720. End Set
  1721. End Property
  1722. Private _DownloadDone As Long = 0
  1723. Private ReadOnly LockDone As New Object
  1724. ''' <summary>
  1725. ''' 尚未完成下载的文件数。
  1726. ''' </summary>
  1727. Public FileRemain As Integer = 0
  1728. Public ReadOnly LockRemain As New Object
  1729. ''' <summary>
  1730. ''' 上次记速时的已下载大小。
  1731. ''' </summary>
  1732. Private SpeedLastDone As Long = 0
  1733. ''' <summary>
  1734. ''' 至多最近 30 次下载速度的记录,较新的在前面。
  1735. ''' </summary>
  1736. Private SpeedLast As New List(Of Long)
  1737. '这些属性由 RefreshStat 刷新
  1738. ''' <summary>
  1739. ''' 当前的全局下载速度,单位为 Byte / 秒。
  1740. ''' </summary>
  1741. Public Speed As Long = 0
  1742. Public ReadOnly Uuid As Integer = GetUuid()
  1743. #End Region
  1744. ''' <summary>
  1745. ''' 进度与下载速度由下载管理线程每隔约 0.1 秒刷新一次。
  1746. ''' </summary>
  1747. Private Sub RefreshStat()
  1748. Try
  1749. Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
  1750. RefreshStatLast += DeltaTime
  1751. #Region "刷新整体速度"
  1752. '计算瞬时速度
  1753. Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000))
  1754. SpeedLast.Insert(0, ActualSpeed)
  1755. If SpeedLast.Count >= 31 Then SpeedLast.RemoveAt(30)
  1756. SpeedLastDone = DownloadDone
  1757. '计算用于显示的速度
  1758. Dim SpeedSum As Long = 0, SpeedDiv As Long = 0, Weight = SpeedLast.Count
  1759. For Each SpeedRecord In SpeedLast
  1760. SpeedSum += SpeedRecord * Weight
  1761. SpeedDiv += Weight
  1762. Weight -= 1
  1763. Next
  1764. Speed = If(SpeedDiv > 0, SpeedSum / SpeedDiv, 0)
  1765. '计算新的速度下限
  1766. Dim Limit As Long = 0
  1767. If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
  1768. If Limit > NetTaskSpeedLimitLow Then
  1769. NetTaskSpeedLimitLow = Limit
  1770. Log("[Download] " & "速度下限已提升到 " & GetString(Limit))
  1771. End If
  1772. #End Region
  1773. #Region "刷新下载任务属性"
  1774. SyncLock LockTasks
  1775. For Each Task In Tasks
  1776. Task.RefreshStat()
  1777. Next
  1778. End SyncLock
  1779. #End Region
  1780. Catch ex As Exception
  1781. Log(ex, "刷新下载公开属性失败")
  1782. End Try
  1783. End Sub
  1784. Private RefreshStatLast As Long
  1785. ''' <summary>
  1786. ''' 启动监控线程,用于新增下载线程。
  1787. ''' </summary>
  1788. Private Sub StartManager()
  1789. If IsManagerStarted Then Exit Sub
  1790. IsManagerStarted = True
  1791. Dim ThreadStarter =
  1792. Sub(Id As Integer) '0 或 1
  1793. Try
  1794. While True
  1795. Thread.Sleep(20)
  1796. '若已完成,则清空
  1797. If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then
  1798. SyncLock LockFiles
  1799. Files.Clear()
  1800. End SyncLock
  1801. End If
  1802. '获取文件列表
  1803. Dim AllFiles As List(Of NetFile)
  1804. SyncLock LockFiles
  1805. AllFiles = Files.Values.ToList()
  1806. End SyncLock
  1807. Dim WaitingFiles As New List(Of NetFile)
  1808. Dim OngoingFiles As New List(Of NetFile)
  1809. For Each File As NetFile In AllFiles
  1810. If File.Uuid Mod 2 = Id Then Continue For
  1811. If File.State = NetState.WaitForDownload Then
  1812. WaitingFiles.Add(File)
  1813. ElseIf File.State < NetState.Merge Then
  1814. OngoingFiles.Add(File)
  1815. End If
  1816. Next
  1817. '为等待中的文件开始线程
  1818. For Each File As NetFile In WaitingFiles
  1819. If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
  1820. Dim NewThread = File.TryBeginThread()
  1821. If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
  1822. Next
  1823. '为进行中的文件追加线程
  1824. If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
  1825. For Each File As NetFile In OngoingFiles
  1826. If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
  1827. '线程种类计数
  1828. Dim PreparingCount = 0, DownloadingCount = 0
  1829. If File.Threads IsNot Nothing Then
  1830. For Each Thread As NetThread In File.Threads.ToList
  1831. If Thread.State < NetState.Download Then
  1832. PreparingCount += 1
  1833. ElseIf Thread.State = NetState.Download Then
  1834. DownloadingCount += 1
  1835. End If
  1836. Next
  1837. End If
  1838. '新增线程
  1839. If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
  1840. Dim NewThread = File.TryBeginThread()
  1841. If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
  1842. Next
  1843. End While
  1844. Catch ex As Exception
  1845. Log(ex, $"下载管理启动线程 {Id} 出错", LogLevel.Assert)
  1846. End Try
  1847. End Sub
  1848. RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
  1849. RunInNewThread(Sub() ThreadStarter(1), "NetManager ThreadStarter 1")
  1850. RunInNewThread(
  1851. Sub()
  1852. Try
  1853. Dim LastLoopTime As Long
  1854. NetTaskSpeedLimitLeftLast = GetTimeTick()
  1855. While True
  1856. Dim TimeNow = GetTimeTick()
  1857. LastLoopTime = TimeNow
  1858. '增加限速余量
  1859. If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
  1860. NetTaskSpeedLimitLeftLast = TimeNow
  1861. '刷新公开属性
  1862. RefreshStat()
  1863. '等待直至 80 ms
  1864. Do While GetTimeTick() - LastLoopTime < 80
  1865. Thread.Sleep(10)
  1866. Loop
  1867. End While
  1868. Catch ex As Exception
  1869. Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
  1870. End Try
  1871. End Sub, "NetManager StatRefresher")
  1872. End Sub
  1873. Private IsManagerStarted As Boolean = False
  1874. 'Public FileRemainList As New List(Of String)
  1875. Private IsDownloadCacheCleared As Boolean = False
  1876. ''' <summary>
  1877. ''' 开始一个下载任务。
  1878. ''' </summary>
  1879. Public Sub Start(Task As LoaderDownload)
  1880. StartManager()
  1881. '清理缓存
  1882. If Not IsDownloadCacheCleared Then
  1883. Try
  1884. DeleteDirectory(PathTemp & "Download")
  1885. Catch ex As Exception
  1886. Log(ex, "清理下载缓存失败")
  1887. End Try
  1888. IsDownloadCacheCleared = True
  1889. End If
  1890. Directory.CreateDirectory(PathTemp & "Download")
  1891. '文件处理
  1892. SyncLock LockFiles
  1893. '添加每个文件
  1894. For i = 0 To Task.Files.Count - 1
  1895. Dim File = Task.Files(i)
  1896. If Files.ContainsKey(File.LocalPath) Then
  1897. '已有该文件
  1898. If Files(File.LocalPath).State >= NetState.Finish Then
  1899. '该文件已经下载过一次,且下载完成
  1900. '将已下载的文件替换成当前文件,重新下载
  1901. SyncLock File.LockTasks
  1902. File.Tasks.Add(Task)
  1903. End SyncLock
  1904. Files(File.LocalPath) = File
  1905. SyncLock LockRemain
  1906. FileRemain += 1
  1907. If ModeDebug Then Log("[Download] " & File.LocalName & ":已替换列表,剩余文件 " & FileRemain)
  1908. 'FileRemainList.Add(File.LocalPath)
  1909. End SyncLock
  1910. Else
  1911. '该文件正在下载中
  1912. '将当前文件替换成下载中的文件,即两个任务指向同一个文件
  1913. File = Files(File.LocalPath)
  1914. SyncLock File.LockTasks
  1915. File.Tasks.Add(Task)
  1916. End SyncLock
  1917. End If
  1918. Else
  1919. '没有该文件
  1920. SyncLock File.LockTasks
  1921. File.Tasks.Add(Task)
  1922. End SyncLock
  1923. Files.Add(File.LocalPath, File)
  1924. SyncLock LockRemain
  1925. FileRemain += 1
  1926. If ModeDebug Then Log("[Download] " & File.LocalName & ":已加入列表,剩余文件 " & FileRemain)
  1927. 'FileRemainList.Add(File.LocalPath)
  1928. End SyncLock
  1929. End If
  1930. Task.Files(i) = File '回设
  1931. Next
  1932. End SyncLock
  1933. SyncLock LockTasks
  1934. Tasks.Add(Task)
  1935. End SyncLock
  1936. End Sub
  1937. End Class
  1938. ''' <summary>
  1939. ''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
  1940. ''' </summary>
  1941. Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
  1942. SyncLock LoaderTaskbarLock
  1943. For Each Task In LoaderTaskbar
  1944. If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
  1945. (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
  1946. Return True
  1947. End If
  1948. Next
  1949. End SyncLock
  1950. Return False
  1951. End Function
  1952. End Module