ModNet.vb 97 KB

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