2.10.7
This commit is contained in:
龙腾猫跃
@@ -1,4 +1,7 @@
|
||||
Imports System.Net.Http.Headers
|
||||
Imports System.Net.Sockets
|
||||
Imports System.Runtime.CompilerServices
|
||||
Imports System.Security.Policy
|
||||
Imports System.Threading.Tasks
|
||||
Imports CacheCow.Client
|
||||
|
||||
@@ -11,15 +14,28 @@ Public Module ModNet
|
||||
''' </summary>
|
||||
Public Function NetRequestByClient(Url As String, Optional Method As HttpMethod = Nothing,
|
||||
Optional Content As Object = Nothing, Optional ContentType As String = Nothing, Optional Accept As String = "*/*",
|
||||
Optional Timeout As Integer = 25000, Optional Headers As String(,) = Nothing,
|
||||
Optional Encoding As Encoding = Nothing, Optional UseBrowserUserAgent As Boolean = False, Optional MakeLog As Boolean = True) As String
|
||||
Optional Timeout As Integer = 25000, Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False,
|
||||
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False, Optional MakeLog As Boolean = True) As String
|
||||
If Method Is Nothing Then Method = HttpMethod.Get
|
||||
If MakeLog Then Log("[Net] 发起网络请求（" & Method.Method & "，" & Url & "），最大超时 " & Timeout)
|
||||
Try
|
||||
Dim HeaderDictionary = If(Headers, {}).ToDictionary
|
||||
If ContentType IsNot Nothing Then HeaderDictionary("Content-Type") = ContentType
|
||||
If Accept IsNot Nothing Then HeaderDictionary("Accept") = Accept
|
||||
Return If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, UseBrowserUserAgent:=UseBrowserUserAgent))
|
||||
Dim Result = If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, SimulateBrowserHeaders:=SimulateBrowserHeaders))
|
||||
'检查结果是否为完整 JSON（在 #6683 中可能返回空，在被 GFW 截断时可能不完整）
|
||||
'在此处检查并报错，可以让 NetRequestByClientRetry 等方法进行重试
|
||||
If RequireJson Then
|
||||
Result = Result.Trim((vbCrLf & " ").ToCharArray) 'Authlib-Injector 的结果会在末尾附带一个空行
|
||||
If Not (Result.StartsWithF("{") AndAlso Result.EndsWithF("}")) AndAlso
|
||||
Not (Result.StartsWithF("[") AndAlso Result.EndsWithF("]")) Then
|
||||
Throw New FormatException("返回结果并非 JSON 格式：" &
|
||||
If(Result.Length > 2000, Result.Substring(0, 1000) & "..." & Result.Substring(Result.Length - 1000), Result))
|
||||
End If
|
||||
End If
|
||||
Return Result
|
||||
Catch ex As FormatException
|
||||
Throw
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw
|
||||
Catch ex As Exception
|
||||
@@ -34,8 +50,8 @@ Public Module ModNet
|
||||
''' <param name="BackupUrl">如果第一次尝试失败，换用的备用 URL。</param>
|
||||
Public Function NetRequestByClientRetry(Url As String, Optional Method As HttpMethod = Nothing, Optional BackupUrl As String = Nothing,
|
||||
Optional Content As Object = Nothing, Optional ContentType As String = Nothing, Optional Accept As String = "*/*",
|
||||
Optional Headers As String(,) = Nothing,
|
||||
Optional Encoding As Encoding = Nothing, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False,
|
||||
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Dim RetryCount As Integer = 0
|
||||
Dim RetryException As Exception = Nothing
|
||||
Dim StartTime As Long = GetTimeTick()
|
||||
@@ -43,15 +59,15 @@ Public Module ModNet
|
||||
Retry:
|
||||
Select Case RetryCount
|
||||
Case 0 '正常尝试
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 10000, Headers, Encoding, UseBrowserUserAgent)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 10000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Case 1 '慢速重试
|
||||
Thread.Sleep(500)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 30000, Headers, Encoding, UseBrowserUserAgent)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 30000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Case Else '快速重试
|
||||
If GetTimeTick() - StartTime > 5500 Then
|
||||
'若前两次加载耗费 5 秒以上，才进行重试
|
||||
Thread.Sleep(500)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 4000, Headers, Encoding, UseBrowserUserAgent)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 4000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Else
|
||||
Throw RetryException
|
||||
End If
|
||||
@@ -78,8 +94,8 @@ Retry:
|
||||
''' </summary>
|
||||
Public Function NetRequestByClientMultiple(Url As String, Optional Method As HttpMethod = Nothing, Optional ThreadCount As Integer = 3,
|
||||
Optional Content As Object = Nothing, Optional ContentType As String = Nothing, Optional Accept As String = "*/*",
|
||||
Optional Headers As String(,) = Nothing, Optional Timeout As Integer = 25000,
|
||||
Optional Encoding As Encoding = Nothing, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False, Optional Timeout As Integer = 25000,
|
||||
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Dim Threads As New List(Of Thread)
|
||||
Dim RequestResult = Nothing
|
||||
Dim RequestEx As Exception = Nothing
|
||||
@@ -88,7 +104,7 @@ Retry:
|
||||
Dim th As New Thread(
|
||||
Sub()
|
||||
Try
|
||||
RequestResult = NetRequestByClient(Url, Method, Content, ContentType, Accept, Timeout, Headers, Encoding, UseBrowserUserAgent)
|
||||
RequestResult = NetRequestByClient(Url, Method, Content, ContentType, Accept, Timeout, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Catch ex As Exception
|
||||
FailCount += 1
|
||||
RequestEx = ex
|
||||
@@ -127,16 +143,16 @@ RequestFinished:
|
||||
''' 以多线程下载网页文件的方式获取内容。
|
||||
''' 不支持缓存协商；若需缓存协商，需要换用 NetRequestByClient。
|
||||
''' </summary>
|
||||
Public Function NetRequestByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Return NetRequestByLoader({Url}, Timeout, IsJson, UseBrowserUserAgent)
|
||||
Public Function NetRequestByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Return NetRequestByLoader({Url}, Timeout, IsJson, SimulateBrowserHeaders)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 以多线程下载网页文件的方式获取内容。
|
||||
''' 不支持缓存协商；若需缓存协商，需要换用 NetRequestByClient。
|
||||
''' </summary>
|
||||
Public Function NetRequestByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Public Function NetRequestByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Dim Temp As String = RequestTaskTempFolder() & "download.txt"
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, SimulateBrowserHeaders)})
|
||||
Try
|
||||
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）")
|
||||
NetRequestByLoader = ReadFile(Temp)
|
||||
@@ -154,7 +170,7 @@ RequestFinished:
|
||||
''' 通过网络请求直接下载小文件，若文件已存在将被覆盖。
|
||||
''' 不建议用于下载大文件。
|
||||
''' </summary>
|
||||
Public Sub NetDownloadByClient(Url As String, LocalPath As String)
|
||||
Public Sub NetDownloadByClient(Url As String, LocalPath As String, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
Log($"[Net] 通过网络请求直接下载小文件：{Url} → {LocalPath}")
|
||||
'初始化文件路径
|
||||
Try
|
||||
@@ -165,7 +181,7 @@ RequestFinished:
|
||||
End Try
|
||||
'下载
|
||||
Try
|
||||
File.WriteAllBytes(LocalPath, SendRequest(Url, HttpMethod.Get))
|
||||
File.WriteAllBytes(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
|
||||
Catch ex As Exception
|
||||
File.Delete(LocalPath)
|
||||
Throw New WebException($"通过网络请求直接下载小文件失败（{LocalPath}）", ex)
|
||||
@@ -175,16 +191,16 @@ RequestFinished:
|
||||
''' <summary>
|
||||
''' 通过多线程下载引擎下载文件。
|
||||
''' </summary>
|
||||
Public Sub NetDownloadByLoader(Url As String, LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
NetDownloadByLoader({Url}, LocalPath, LoaderToSyncProgress, Check, UseBrowserUserAgent)
|
||||
Public Sub NetDownloadByLoader(Url As String, LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
NetDownloadByLoader({Url}, LocalPath, LoaderToSyncProgress, Check, SimulateBrowserHeaders)
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 通过多线程下载引擎下载文件。
|
||||
''' </summary>
|
||||
''' <param name="Urls">文件的 Url 列表。</param>
|
||||
''' <param name="LocalPath">下载的本地地址。</param>
|
||||
Public Sub NetDownloadByLoader(Urls As IEnumerable(Of String), LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Dim NewTask As New LoaderDownload($"文件下载 {GetUuid()}#", New List(Of NetFile) From {New NetFile(Urls, LocalPath, Check, UseBrowserUserAgent)})
|
||||
Public Sub NetDownloadByLoader(Urls As IEnumerable(Of String), LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
Dim NewTask As New LoaderDownload($"文件下载 {GetUuid()}#", New List(Of NetFile) From {New NetFile(Urls, LocalPath, Check, SimulateBrowserHeaders)})
|
||||
Try
|
||||
NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
|
||||
Catch ex As Exception
|
||||
@@ -201,36 +217,37 @@ RequestFinished:
|
||||
'基础请求函数
|
||||
Private Function SendRequest(Url As String, Method As HttpMethod,
|
||||
Optional Content As Object = Nothing, Optional Headers As Dictionary(Of String, String) = Nothing,
|
||||
Optional UseBrowserUserAgent As Boolean = False, Optional Timeout As Integer = 25000, Optional Encoding As Encoding = Nothing) As Byte()
|
||||
Optional SimulateBrowserHeaders As Boolean = False, Optional Timeout As Integer = 25000, Optional Encoding As Encoding = Nothing) As Byte()
|
||||
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
|
||||
Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing, Response As HttpResponseMessage = Nothing
|
||||
Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing,
|
||||
Response As HttpResponseMessage = Nothing, HostIp As String = Nothing
|
||||
Try
|
||||
Static Client As HttpClient = ClientExtensions.CreateClient(New FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None,
|
||||
.UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies
|
||||
})
|
||||
Url = SecretCdnSign(Url)
|
||||
Request = New HttpRequestMessage(Method, Url)
|
||||
'写入 Content
|
||||
If Content IsNot Nothing AndAlso Request.Method <> HttpMethod.Get AndAlso Request.Method <> HttpMethod.Head Then
|
||||
Dim Bytes As Byte() = If(TypeOf Content Is Byte(), Content, If(Encoding, Encoding.UTF8).GetBytes(Content.ToString))
|
||||
Request.Content = New ByteArrayContent(Bytes)
|
||||
Request.Content.Headers.ContentLength = Bytes.Length
|
||||
If TypeOf Content Is HttpContent Then
|
||||
Request.Content = DirectCast(Content, HttpContent)
|
||||
ElseIf TypeOf Content Is Byte() Then
|
||||
Request.Content = New ByteArrayContent(DirectCast(Content, Byte()))
|
||||
ElseIf Content IsNot Nothing Then
|
||||
Request.Content = New ByteArrayContent(If(Encoding, Encoding.UTF8).GetBytes(Content.ToString()))
|
||||
End If
|
||||
End If
|
||||
'写入 Headers
|
||||
If Headers IsNot Nothing Then
|
||||
For Each Header In Headers
|
||||
If Header.Key.ToLower = "content-type" Then
|
||||
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
Else
|
||||
Request.Headers.Add(Header.Key, Header.Value)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
SecretHeadersSign(Url, Request, UseBrowserUserAgent)
|
||||
'发送请求
|
||||
For Each Header In If(Headers, New Dictionary(Of String, String))
|
||||
If Header.Key.ToLower = "content-type" Then
|
||||
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
Else
|
||||
Request.Headers.Add(Header.Key, Header.Value)
|
||||
End If
|
||||
Next
|
||||
SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
|
||||
'DNS 解析
|
||||
CancelToken = New CancellationTokenSource(Timeout)
|
||||
Response = Client.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
HostIp = DnsLookup(Request, CancelToken)
|
||||
'发送请求
|
||||
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
Dim ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
||||
Dim ResponseBytes As Byte()
|
||||
Using Stream As New MemoryStream
|
||||
@@ -239,28 +256,111 @@ RequestFinished:
|
||||
End Using
|
||||
'输出
|
||||
If Response.IsSuccessStatusCode Then
|
||||
RecordIPReliability(HostIp, 0.5)
|
||||
Return ResponseBytes
|
||||
Else
|
||||
RecordIPReliability(HostIp, -0.7)
|
||||
Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes)
|
||||
Throw New ResponsedWebException(
|
||||
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}" &
|
||||
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" &
|
||||
If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), ResponseMessage)
|
||||
End If
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw
|
||||
Catch ex As ResponsedWebException
|
||||
Throw
|
||||
Catch ex As TaskCanceledException 'CancellationTokenSource 超时
|
||||
Throw New WebException($"连接服务器超时，请检查你的网络环境是否良好（{Method}, {Url}）", WebExceptionStatus.Timeout)
|
||||
Catch ex As DnsLookupException
|
||||
Throw
|
||||
Catch ex As Exception
|
||||
Throw New Exception($"网络请求出现意外异常（{Method}, {Url}）", ex)
|
||||
RecordIPReliability(HostIp, -1)
|
||||
If TypeOf ex Is OperationCanceledException Then 'CancellationToken 超时
|
||||
Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，{HostIp}）", WebExceptionStatus.Timeout)
|
||||
Else
|
||||
Throw New Exception($"网络请求出现意外异常（{Method}, {Url}，{HostIp}）", ex)
|
||||
End If
|
||||
Finally
|
||||
Request?.Dispose()
|
||||
CancelToken?.Dispose()
|
||||
Response?.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
Private RequestClient As HttpClient = ClientExtensions.CreateClient(New FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None,
|
||||
.UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies
|
||||
})
|
||||
|
||||
''' <summary>
|
||||
''' 进行 DNS 解析。它仅在选择的 IP 与系统默认的不一致时才对 URL 中的 Host 进行替换。
|
||||
''' 返回请求时应使用的 IP；若为 IPv6，则加上了方括号。
|
||||
''' </summary>
|
||||
''' <exception cref="DnsLookupException"></exception>
|
||||
Private Function DnsLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String
|
||||
Dim GetIPReliability = Function(Key) IPReliability.GetOrDefault(Key.ToString, 0)
|
||||
'初步 DNS 解析
|
||||
Dim Host = Request.RequestUri.Host
|
||||
Dim DnsTask As Task(Of IPAddress()) = Nothing
|
||||
Try
|
||||
DnsTask = Dns.GetHostAddressesAsync(Host)
|
||||
DnsTask.Wait(CancelToken.Token)
|
||||
Catch ex As Exception
|
||||
Throw New DnsLookupException($"DNS 解析失败，请检查你的网络连接（{Host}）", ex)
|
||||
End Try
|
||||
Dim Candidates As IPAddress() = DnsTask.Result.ToArray
|
||||
If Not Candidates.Any Then Throw New DnsLookupException($"DNS 解析无结果，请检查你的网络连接（{Host}）")
|
||||
'若同时存在 IPv4 和 IPv6 地址，仅选择其中一类（因为 GFW 可能只屏蔽了 IPv4 或 IPv6）
|
||||
Dim IPv4Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetwork).ToArray
|
||||
Dim IPv6Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetworkV6).ToArray
|
||||
If IPv4Targets.Any AndAlso IPv6Targets.Any Then
|
||||
Dim IPv4Reliability = IPv4Targets.Average(Function(i) GetIPReliability(i))
|
||||
Dim IPv6Reliability = IPv6Targets.Average(Function(i) GetIPReliability(i))
|
||||
If Host = "api.modrinth.com" Then IPv6Reliability -= 0.1 '让 Modrinth 优先使用 IPv4 地址（#6887）
|
||||
Candidates = If(IPv4Reliability >= IPv6Reliability, IPv4Targets, IPv6Targets)
|
||||
End If
|
||||
'选择可靠度最高的 IP
|
||||
Dim MaxReliability As Double = Candidates.Max(Function(i) GetIPReliability(i))
|
||||
Dim Target As IPAddress = Candidates.First(Function(i) GetIPReliability(i) = MaxReliability)
|
||||
Dim TargetIp As String = If(Target.AddressFamily = AddressFamily.InterNetworkV6, $"[{Target}]", Target.ToString)
|
||||
If Target IsNot Candidates.First Then
|
||||
'优选结果与系统默认 IP 不一致，替换域名并设置 Host 头
|
||||
If ModeDebug Then Log($"[Net] DNS 结果：{Host} → {Target}，所有可能的 IP 与可靠度：{DnsTask.Result.Select(Function(i) $"{i} → {GetIPReliability(i):0.000}").Join("；")}")
|
||||
Request.Headers.Host = Host
|
||||
Dim Builder As New UriBuilder(Request.RequestUri)
|
||||
Builder.Host = TargetIp
|
||||
Request.RequestUri = Builder.Uri
|
||||
End If
|
||||
If Not IPReliability.ContainsKey(TargetIp) Then IPReliability(TargetIp) = -0.01 '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
|
||||
Return TargetIp
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 记录每个 IP 地址的请求可靠度。
|
||||
''' 通常取值 -1 ~ +0.5，越高越好。未尝试过的 IP 应视为 0。
|
||||
''' </summary>
|
||||
Private IPReliability As New Dictionary(Of String, Double)
|
||||
''' <summary>
|
||||
''' 根据请求结果，记录 IP 地址的可靠度。
|
||||
''' </summary>
|
||||
Private Sub RecordIPReliability(IP As String, Result As Double)
|
||||
If IP Is Nothing Then Return
|
||||
If Not IPReliability.ContainsKey(IP) Then IPReliability(IP) = 0
|
||||
IPReliability(IP) = (IPReliability(IP) + Result) / 2
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' DNS 解析失败引发的异常。
|
||||
''' </summary>
|
||||
Private Class DnsLookupException
|
||||
Inherits Exception
|
||||
Public Sub New(Message As String, Optional InnerException As Exception = Nothing)
|
||||
MyBase.New(Message, InnerException)
|
||||
End Sub
|
||||
Public Sub New(Message As String)
|
||||
MyBase.New(Message)
|
||||
End Sub
|
||||
End Class
|
||||
''' <summary>
|
||||
''' 当网络请求失败时引发的异常。
|
||||
''' 附带 Response 属性，可用于获取远程服务器给予的回复。
|
||||
''' </summary>
|
||||
Public Class ResponsedWebException
|
||||
Inherits WebException
|
||||
''' <summary>
|
||||
@@ -277,6 +377,10 @@ RequestFinished:
|
||||
|
||||
#Region "多线程下载引擎"
|
||||
|
||||
Private ThreadClient As New HttpClient(New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None
|
||||
})
|
||||
|
||||
''' <summary>
|
||||
''' 最大线程数。
|
||||
''' </summary>
|
||||
@@ -581,12 +685,12 @@ RequestFinished:
|
||||
End SyncLock
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 是否已经没有可用源了。
|
||||
''' 是否存在可用源。
|
||||
''' </summary>
|
||||
Public Function HasAvailableSource(Optional AllowOnceSource As Boolean = True) As Boolean
|
||||
SyncLock LockSource
|
||||
If AllowOnceSource AndAlso SourcesOnce.Any Then Return True
|
||||
If Sources.Any(Function(s) Not s.IsFailed) Then Return True
|
||||
If Sources.Any(Function(s) Not s.IsFailed) Then Return True '存在多线程可用源
|
||||
If AllowOnceSource AndAlso SourcesOnce.Any Then Return True '存在单线程可用源
|
||||
End SyncLock
|
||||
Return False
|
||||
End Function
|
||||
@@ -648,7 +752,7 @@ RequestFinished:
|
||||
''' <summary>
|
||||
''' 下载时是否添加浏览器 UA。
|
||||
''' </summary>
|
||||
Public UseBrowserUserAgent As Boolean
|
||||
Public SimulateBrowserHeaders As Boolean
|
||||
|
||||
''' <summary>
|
||||
''' 上次记速时的时间。
|
||||
@@ -746,7 +850,7 @@ RequestFinished:
|
||||
''' 新建一个需要下载的文件。
|
||||
''' </summary>
|
||||
''' <param name="LocalPath">包含文件名的本地地址。</param>
|
||||
Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Check As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
Dim Sources As New List(Of NetSource)
|
||||
Dim Count As Integer = 0
|
||||
Urls = Urls.Distinct.ToArray
|
||||
@@ -757,7 +861,7 @@ RequestFinished:
|
||||
Me.Sources = Sources
|
||||
Me.LocalPath = LocalPath
|
||||
Me.Check = Check
|
||||
Me.UseBrowserUserAgent = UseBrowserUserAgent
|
||||
Me.SimulateBrowserHeaders = SimulateBrowserHeaders
|
||||
Me.LocalName = GetFileNameFromPath(LocalPath)
|
||||
End Sub
|
||||
|
||||
@@ -768,17 +872,17 @@ RequestFinished:
|
||||
Public Function TryBeginThread() As NetThread
|
||||
Try
|
||||
|
||||
'条件检测
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
|
||||
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
|
||||
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
|
||||
SyncLock LockState
|
||||
If State < NetState.Connect Then State = NetState.Connect
|
||||
End SyncLock
|
||||
'初始化参数
|
||||
Dim StartPosition As Long, StartSource As NetSource = Nothing
|
||||
Dim Th As Thread, ThreadInfo As NetThread
|
||||
SyncLock LockChain
|
||||
'条件检测
|
||||
SyncLock LockSource
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
|
||||
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
|
||||
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
|
||||
SyncLock LockState
|
||||
If State < NetState.Connect Then State = NetState.Connect
|
||||
End SyncLock
|
||||
'初始化参数
|
||||
'获取线程起点与下载源
|
||||
'不分割
|
||||
If IsNoSplit Then GoTo StartSingleThreadDownload
|
||||
@@ -789,6 +893,8 @@ StartSingleThreadDownload:
|
||||
Reset()
|
||||
State = NetState.Get
|
||||
End If
|
||||
End SyncLock
|
||||
SyncLock LockChain
|
||||
'首个开始点
|
||||
If Threads Is Nothing Then
|
||||
StartPosition = 0
|
||||
@@ -805,7 +911,9 @@ StartSingleThreadDownload:
|
||||
End If
|
||||
Next
|
||||
'是否禁用多线程，以及规定碎片大小
|
||||
Dim TargetUrl As String = GetSource().Url
|
||||
Dim Source As NetSource = GetSource()
|
||||
If Source Is Nothing Then Return Nothing
|
||||
Dim TargetUrl As String = Source.Url
|
||||
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse
|
||||
TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") OrElse TargetUrl.Contains("momot.rs") Then Return Nothing
|
||||
'寻找最大碎片
|
||||
@@ -850,7 +958,7 @@ StartThread:
|
||||
Return ThreadInfo
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "尝试开始下载线程失败（" & If(LocalName, "Nothing") & "）", LogLevel.Hint)
|
||||
Fail(New Exception($"尝试开始下载线程失败（{LocalName}）", ex))
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
@@ -859,7 +967,9 @@ StartThread:
|
||||
''' </summary>
|
||||
Private Sub Thread(Th As NetThread)
|
||||
If ModeDebug OrElse Th.DownloadStart = 0 Then Log($"[Download] {LocalName}：开始，起始点 {Th.DownloadStart}，{Th.Source.Url}")
|
||||
Dim ResultStream As Stream = Nothing
|
||||
Dim ResultStream As Stream = Nothing, HttpRequest As HttpRequestMessage = Nothing,
|
||||
Response As HttpResponseMessage = Nothing, ResponseStream As Stream = Nothing,
|
||||
CancelToken As CancellationTokenSource = Nothing, HostIp As String = ""
|
||||
'部分下载源真的特别慢，并且只需要一个请求，例如 Ping 为 20s，如果增长太慢，就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟
|
||||
'延迟过长会导致某些特别慢的链接迟迟不被掐死
|
||||
Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Th.Source.FailCount), 30000)
|
||||
@@ -867,145 +977,140 @@ StartThread:
|
||||
Try
|
||||
Dim HttpDataCount As Integer = 0
|
||||
If SourcesOnce.Contains(Th.Source) AndAlso Th <> Th.Source.SingleThread Then GoTo SourceBreak
|
||||
Dim HttpRequest As New HttpRequestMessage(HttpMethod.Get, Th.Source.Url)
|
||||
SecretHeadersSign(Th.Source.Url, HttpRequest, UseBrowserUserAgent)
|
||||
HttpRequest = New HttpRequestMessage(HttpMethod.Get, Th.Source.Url)
|
||||
SecretHeadersSign(Th.Source.Url, HttpRequest, SimulateBrowserHeaders)
|
||||
CancelToken = New CancellationTokenSource(Timeout)
|
||||
HostIp = DnsLookup(HttpRequest, CancelToken) 'DNS 预解析
|
||||
If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Th.DownloadStart, Nothing)
|
||||
Dim ContentLength As Long = 0
|
||||
Using CancelToken As New CancellationTokenSource(Timeout)
|
||||
Static Client As New HttpClient(New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None
|
||||
})
|
||||
Using Response As HttpResponseMessage = Client.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}") '状态码检查
|
||||
If State = NetState.Error Then GoTo SourceBreak '快速中断
|
||||
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
|
||||
'文件大小校验
|
||||
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
|
||||
If ContentLength = -1 Then
|
||||
If FileSize > 1 Then
|
||||
If Th.DownloadStart = 0 Then
|
||||
Log($"[Download] {LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
|
||||
Else
|
||||
Log($"[Download] {LocalName}：ContentLength 返回了 -1，无法确定是否支持分段下载，视作不支持")
|
||||
GoTo NotSupportRange
|
||||
End If
|
||||
Else
|
||||
FileSize = -1 : IsUnknownSize = True
|
||||
Log($"[Download] {LocalName}：文件大小未知")
|
||||
End If
|
||||
ElseIf ContentLength < 0 Then
|
||||
Throw New Exception("获取片大小失败，结果为 " & ContentLength & "。")
|
||||
ElseIf Th.IsFirstThread Then
|
||||
If Check IsNot Nothing Then
|
||||
If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
|
||||
Throw New Exception($"文件大小不足，获取结果为 {ContentLength}，要求至少为 {Check.MinSize}。")
|
||||
End If
|
||||
If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
|
||||
Throw New Exception($"文件大小不一致，获取结果为 {ContentLength}，要求必须为 {Check.ActualSize}。")
|
||||
End If
|
||||
End If
|
||||
FileSize = ContentLength : IsUnknownSize = False
|
||||
Log($"[Download] {LocalName}：文件大小 {ContentLength}（{GetString(ContentLength)}）")
|
||||
'若文件大小大于 50 M，进行剩余磁盘空间校验
|
||||
If ContentLength > 50 * 1024 * 1024 Then
|
||||
For Each Drive As DriveInfo In DriveInfo.GetDrives
|
||||
Dim DriveName As String = Drive.Name.First.ToString
|
||||
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
|
||||
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
|
||||
If Drive.TotalFreeSpace < RequiredSpace Then
|
||||
Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间，但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
|
||||
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", ""))
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
ElseIf FileSize < 0 Then
|
||||
Throw New Exception("非首线程运行时，尚未获取文件大小")
|
||||
ElseIf Th.DownloadStart > 0 AndAlso ContentLength = FileSize Then
|
||||
NotSupportRange:
|
||||
SyncLock LockSource
|
||||
If SourcesOnce.Contains(Th.Source) Then
|
||||
GoTo SourceBreak
|
||||
Else
|
||||
SourcesOnce.Add(Th.Source)
|
||||
End If
|
||||
End SyncLock
|
||||
Throw New WebException($"该下载源不支持分段下载：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
|
||||
ElseIf Not FileSize - Th.DownloadStart = ContentLength Then
|
||||
Throw New WebException($"获取到的分段大小不一致：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
|
||||
End If
|
||||
'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
|
||||
Th.State = NetState.Get
|
||||
SyncLock LockState
|
||||
If State < NetState.Get Then State = NetState.Get
|
||||
End SyncLock
|
||||
'创建缓存文件
|
||||
If IsNoSplit Then
|
||||
Th.Temp = Nothing
|
||||
Cache = New MemoryStream
|
||||
ResultStream = Cache
|
||||
Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}") '状态码检查
|
||||
If State = NetState.Error Then GoTo SourceBreak '快速中断
|
||||
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
|
||||
'文件大小校验
|
||||
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
|
||||
If ContentLength = -1 Then
|
||||
If FileSize > 1 Then
|
||||
If Th.DownloadStart = 0 Then
|
||||
Log($"[Download] {LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
|
||||
Else
|
||||
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
|
||||
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
|
||||
Log($"[Download] {LocalName}：ContentLength 返回了 -1，无法确定是否支持分段下载，视作不支持")
|
||||
GoTo NotSupportRange
|
||||
End If
|
||||
'开始下载
|
||||
Using ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
||||
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
|
||||
Dim ResponseBytes As Byte() = New Byte(16384) {}
|
||||
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetAwaiter().GetResult()
|
||||
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
|
||||
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
|
||||
'限速
|
||||
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
|
||||
Threading.Thread.Sleep(16)
|
||||
End While
|
||||
Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Th.DownloadUndone))
|
||||
SyncLock NetTaskSpeedLimitLeftLock
|
||||
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
|
||||
End SyncLock
|
||||
Dim DeltaTime = GetTimeTick() - Th.LastReceiveTime
|
||||
If DeltaTime > 1000000 Then DeltaTime = 1 '时间刻反转导致出现极大值
|
||||
If RealDataCount > 0 Then
|
||||
'有数据
|
||||
If Th.DownloadDone = 0 Then
|
||||
'第一次接受到数据
|
||||
Th.State = NetState.Download
|
||||
SyncLock LockState
|
||||
If State < NetState.Download Then State = NetState.Download
|
||||
End SyncLock
|
||||
SyncLock LockCount
|
||||
ConnectCount += 1
|
||||
ConnectTime += GetTimeTick() - Th.InitTime
|
||||
End SyncLock
|
||||
End If
|
||||
SyncLock LockCount
|
||||
Th.Source.FailCount = 0
|
||||
For Each Task In Tasks
|
||||
Task.FailCount = 0
|
||||
Next
|
||||
End SyncLock
|
||||
NetManager.DownloadDone += RealDataCount
|
||||
SyncLock LockDone
|
||||
DownloadDone += RealDataCount
|
||||
End SyncLock
|
||||
Th.DownloadDone += RealDataCount
|
||||
ResultStream.Write(ResponseBytes, 0, RealDataCount)
|
||||
'检查速度是否过慢
|
||||
If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount AndAlso '数据包间隔大于 1.5s，且速度小于 1.5K/s
|
||||
Th.Source.SingleThread Is Nothing Then '并非单线程下载
|
||||
Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。")
|
||||
End If
|
||||
Th.LastReceiveTime = GetTimeTick()
|
||||
'已完成
|
||||
If Th.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
|
||||
ElseIf Th.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
|
||||
'无数据，且已超时
|
||||
Throw New TimeoutException("操作超时，无数据。")
|
||||
End If
|
||||
HttpDataCount = ResponseStream.Read(ResponseBytes, 0, 16384)
|
||||
End While
|
||||
End Using
|
||||
End Using
|
||||
End Using
|
||||
Else
|
||||
FileSize = -1 : IsUnknownSize = True
|
||||
Log($"[Download] {LocalName}：文件大小未知")
|
||||
End If
|
||||
ElseIf ContentLength < 0 Then
|
||||
Throw New Exception("获取片大小失败，结果为 " & ContentLength & "。")
|
||||
ElseIf Th.IsFirstThread Then
|
||||
If Check IsNot Nothing Then
|
||||
If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
|
||||
Throw New Exception($"文件大小不足，获取结果为 {ContentLength}，要求至少为 {Check.MinSize}。")
|
||||
End If
|
||||
If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
|
||||
Throw New Exception($"文件大小不一致，获取结果为 {ContentLength}，要求必须为 {Check.ActualSize}。")
|
||||
End If
|
||||
End If
|
||||
FileSize = ContentLength : IsUnknownSize = False
|
||||
Log($"[Download] {LocalName}：文件大小 {ContentLength}（{GetString(ContentLength)}）")
|
||||
'若文件大小大于 50 M，进行剩余磁盘空间校验
|
||||
If ContentLength > 50 * 1024 * 1024 Then
|
||||
For Each Drive As DriveInfo In DriveInfo.GetDrives
|
||||
Dim DriveName As String = Drive.Name.First.ToString
|
||||
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
|
||||
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
|
||||
If Drive.TotalFreeSpace < RequiredSpace Then
|
||||
Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间，但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
|
||||
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", ""))
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
ElseIf FileSize < 0 Then
|
||||
Throw New Exception("非首线程运行时，尚未获取文件大小")
|
||||
ElseIf Th.DownloadStart > 0 AndAlso ContentLength = FileSize Then
|
||||
NotSupportRange:
|
||||
SyncLock LockSource
|
||||
If SourcesOnce.Contains(Th.Source) Then
|
||||
GoTo SourceBreak
|
||||
Else
|
||||
SourcesOnce.Add(Th.Source)
|
||||
End If
|
||||
End SyncLock
|
||||
Throw New WebException($"该下载源不支持分段下载：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
|
||||
ElseIf Not FileSize - Th.DownloadStart = ContentLength Then
|
||||
Throw New WebException($"获取到的分段大小不一致：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
|
||||
End If
|
||||
'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
|
||||
Th.State = NetState.Get
|
||||
SyncLock LockState
|
||||
If State < NetState.Get Then State = NetState.Get
|
||||
End SyncLock
|
||||
'创建缓存文件
|
||||
If IsNoSplit Then
|
||||
Th.Temp = Nothing
|
||||
Cache = New MemoryStream
|
||||
ResultStream = Cache
|
||||
Else
|
||||
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
|
||||
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
|
||||
End If
|
||||
'开始下载
|
||||
ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
||||
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
|
||||
Dim ResponseBytes As Byte() = New Byte(16384) {}
|
||||
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetAwaiter().GetResult()
|
||||
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
|
||||
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
|
||||
'限速
|
||||
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
|
||||
Threading.Thread.Sleep(16)
|
||||
End While
|
||||
Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Th.DownloadUndone))
|
||||
SyncLock NetTaskSpeedLimitLeftLock
|
||||
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
|
||||
End SyncLock
|
||||
Dim DeltaTime = GetTimeTick() - Th.LastReceiveTime
|
||||
If DeltaTime > 1000000 Then DeltaTime = 1 '避免时间刻反转导致出现极大值
|
||||
If RealDataCount > 0 Then
|
||||
'有数据
|
||||
If Th.DownloadDone = 0 Then
|
||||
'第一次接受到数据
|
||||
Th.State = NetState.Download
|
||||
SyncLock LockState
|
||||
If State < NetState.Download Then State = NetState.Download
|
||||
End SyncLock
|
||||
SyncLock LockCount
|
||||
ConnectCount += 1
|
||||
ConnectTime += GetTimeTick() - Th.InitTime
|
||||
End SyncLock
|
||||
End If
|
||||
SyncLock LockCount
|
||||
Th.Source.FailCount = 0
|
||||
For Each Task In Tasks
|
||||
Task.FailCount = 0
|
||||
Next
|
||||
End SyncLock
|
||||
NetManager.DownloadDone += RealDataCount
|
||||
SyncLock LockDone
|
||||
DownloadDone += RealDataCount
|
||||
End SyncLock
|
||||
Th.DownloadDone += RealDataCount
|
||||
ResultStream.Write(ResponseBytes, 0, RealDataCount)
|
||||
'已完成
|
||||
If Th.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
|
||||
'检查速度是否过慢
|
||||
If DeltaTime > 5000 AndAlso DeltaTime > RealDataCount AndAlso '数据包间隔大于 5s，且速度小于 1K/s
|
||||
Th.Source.SingleThread Is Nothing Then '且并非单线程下载
|
||||
Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。")
|
||||
End If
|
||||
Th.LastReceiveTime = GetTimeTick()
|
||||
ElseIf Th.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
|
||||
'无数据，且已超时
|
||||
Throw New TimeoutException("操作超时，无数据。")
|
||||
End If
|
||||
HttpDataCount = ResponseStream.Read(ResponseBytes, 0, 16384)
|
||||
End While
|
||||
SourceBreak:
|
||||
If State = NetState.Error OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
|
||||
'被外部中断
|
||||
@@ -1018,16 +1123,24 @@ SourceBreak:
|
||||
'本线程完成
|
||||
Th.State = NetState.Finish
|
||||
If ModeDebug Then Log($"[Download] {LocalName}：完成，已下载 {Th.DownloadDone}（{Th.DownloadStart}~{Th.DownloadEnd}）")
|
||||
RecordIPReliability(HostIp, 0.5)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is TaskCanceledException, $"已超时（{Timeout}ms）", GetExceptionDetail(ex))}")
|
||||
Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException, $"已超时（{Timeout}ms）", ex.GetDetail())}，{HostIp}")
|
||||
RecordIPReliability(HostIp, -0.7)
|
||||
SourceFail(Th, ex, False)
|
||||
Finally
|
||||
'释放资源
|
||||
HttpRequest?.Dispose()
|
||||
Response?.Dispose()
|
||||
ResponseStream?.Dispose()
|
||||
CancelToken?.Dispose()
|
||||
If Not IsNoSplit Then ResultStream?.Dispose()
|
||||
'改变计数
|
||||
SyncLock NetTaskThreadCountLock
|
||||
NetTaskThreadCount -= 1
|
||||
End SyncLock
|
||||
'合并
|
||||
If Not IsNoSplit Then ResultStream?.Dispose()
|
||||
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso
|
||||
State < NetState.Merge AndAlso Th.State <> NetState.Error Then Merge(Th)
|
||||
End Try
|
||||
@@ -1046,7 +1159,7 @@ SourceBreak:
|
||||
If IsMergeFailure OrElse
|
||||
ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
|
||||
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
|
||||
(ex.Message.Contains("(403)") AndAlso Not Th.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源
|
||||
((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Th.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403/429，所以不应因此禁用下载源
|
||||
(Th.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then
|
||||
'当一个下载源有多个线程在下载时，只选择其中一个线程进行后续处理
|
||||
Dim IsThisFail As Boolean = False
|
||||
@@ -1140,10 +1253,10 @@ SourceBreak:
|
||||
Dim RetryCount As Integer = 0
|
||||
Try
|
||||
Retry:
|
||||
'创建文件夹
|
||||
If File.Exists(LocalPath) Then File.Delete(LocalPath)
|
||||
Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
|
||||
SyncLock LockChain
|
||||
'创建文件夹
|
||||
If File.Exists(LocalPath) Then File.Delete(LocalPath)
|
||||
Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
|
||||
'合并文件
|
||||
If IsNoSplit Then
|
||||
'仅有一个线程，从缓存中输出
|
||||
@@ -1386,13 +1499,13 @@ NextElement:
|
||||
If File Is Nothing Then Throw New ArgumentException("存在空文件请求！")
|
||||
For Each Source As NetSource In File.Sources
|
||||
If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then
|
||||
Source.Ex = New ArgumentException("输入的下载链接不正确！")
|
||||
Source.Ex = New ArgumentException("输入的下载链接不正确：" & Source.Url)
|
||||
Source.IsFailed = True
|
||||
End If
|
||||
Next
|
||||
If Not File.HasAvailableSource() Then Throw New ArgumentException("输入的下载链接不正确！")
|
||||
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确！")
|
||||
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径！")
|
||||
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确：" & File.LocalPath)
|
||||
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径：" & File.LocalPath)
|
||||
'文件夹检测
|
||||
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
|
||||
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
|
||||
@@ -1522,12 +1635,12 @@ Retry:
|
||||
If State > LoadState.Loading Then Return
|
||||
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
|
||||
'寻找有效的错误信息
|
||||
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot TaskCanceledException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
|
||||
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
|
||||
[Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
|
||||
'获取实际失败的文件
|
||||
For Each File In Files
|
||||
If File.State <> NetState.Error Then Continue For
|
||||
Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex?.Message, "无错误信息。"）}（{s.Url}）"), vbCrLf)
|
||||
Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}（{s.Url}）"), vbCrLf)
|
||||
[Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf &
|
||||
"各下载源的错误如下：" & vbCrLf & Detail,
|
||||
[Error])
|
||||
@@ -1547,7 +1660,7 @@ Retry:
|
||||
'在退出同步锁后再进行日志输出
|
||||
Dim ErrOutput As New List(Of String)
|
||||
For Each Ex As Exception In ExList
|
||||
ErrOutput.Add(GetExceptionDetail(Ex))
|
||||
ErrOutput.Add(Ex.GetDetail())
|
||||
Next
|
||||
Log("[Download] " & Join(ErrOutput.Distinct.ToArray, vbCrLf))
|
||||
End Sub
|
||||
@@ -1697,7 +1810,7 @@ Retry:
|
||||
For Each File As NetFile In WaitingFiles
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
|
||||
Dim NewThread = File.TryBeginThread()
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率（目前每分钟限制 4000 次）
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率（目前每分钟限制 4000 次）
|
||||
Next
|
||||
'为进行中的文件追加线程
|
||||
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增
|
||||
@@ -1717,7 +1830,7 @@ Retry:
|
||||
'新增线程
|
||||
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程，不再新增
|
||||
Dim NewThread = File.TryBeginThread()
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率（目前每分钟限制 4000 次）
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率（目前每分钟限制 4000 次）
|
||||
Next
|
||||
End While
|
||||
Catch ex As Exception
|
||||
@@ -1842,4 +1955,15 @@ Retry:
|
||||
End If
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 判断某个 Exception 是否为网络问题所导致。
|
||||
''' </summary>
|
||||
<Extension> Public Function IsNetworkRelated(Ex As Exception) As Boolean
|
||||
If TypeOf Ex Is DnsLookupException Then Return True
|
||||
Dim Detail = Ex.GetDetail()
|
||||
If Detail.Contains("(403)") Then Return False
|
||||
Return {"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝"}.
|
||||
Any(Function(k) Detail.ContainsF(k, True))
|
||||
End Function
|
||||
|
||||
End Module
|
||||
|
||||
Reference in New Issue
Block a user