|
|
@@ -1,9 +1,217 @@
|
|
|
-Imports System.Net.Http
|
|
|
+Imports System.Drawing
|
|
|
+Imports System.Net.Http
|
|
|
+Imports System.Net.Http.Headers
|
|
|
+Imports System.Threading.Tasks
|
|
|
+Imports Newtonsoft.Json
|
|
|
|
|
|
Public Module ModNet
|
|
|
Public Const NetDownloadEnd As String = ".PCLDownloading"
|
|
|
- Public ReadOnly Client As New HttpClient()
|
|
|
- Public ReadOnly ClientHandler As New HttpClientHandler() With {.AllowAutoRedirect = False}
|
|
|
+ Public ReadOnly HttpProxy As New HttpWebProxyFactory()
|
|
|
+ Private ClientFactory As New HttpClientFactory()
|
|
|
+ Private Request As New HttpRequest()
|
|
|
+ Public Class HttpRequest
|
|
|
+ Public Sub New()
|
|
|
+ End Sub
|
|
|
+ Public Function GetRequestMessage(RequestUrl As String,
|
|
|
+ Optional Method As String = "GET",
|
|
|
+ Optional Headers As Dictionary(Of String, String) = Nothing,
|
|
|
+ Optional Data As Byte() = Nothing,
|
|
|
+ Optional UseBrowserUA As Boolean = False,
|
|
|
+ Optional RequireHeaderSign As Boolean = False,
|
|
|
+ Optional RequireCdnSign As Boolean = False) As HttpRequestMessage
|
|
|
+ Dim Watcher As New Stopwatch()
|
|
|
+ Watcher.Start()
|
|
|
+ Dim RequestMethod As HttpMethod = GetHttpMethod(Method)
|
|
|
+ If RequireCdnSign Then RequestUrl = SecretCdnSign(RequestUrl)
|
|
|
+
|
|
|
+ Dim RequestMessage As New HttpRequestMessage(RequestMethod, RequestUrl)
|
|
|
+ '基本参数验证
|
|
|
+ If Data IsNot Nothing AndAlso Not {HttpMethod.Get, HttpMethod.Head}.Contains(RequestMethod) Then
|
|
|
+ RequestMessage.Content = New ByteArrayContent(Data)
|
|
|
+ RequestMessage.Content.Headers.ContentLength = Data.Length
|
|
|
+ End If
|
|
|
+
|
|
|
+ If Headers IsNot Nothing Then
|
|
|
+ For Each Header In Headers
|
|
|
+ If Header.Key.ContainsF("Content") AndAlso RequestMessage.Content IsNot Nothing Then
|
|
|
+ 'FixContentHeader 往下挪一行就 NullReference 了
|
|
|
+FixContentHeader:
|
|
|
+ If Data Is Nothing OrElse RequestMessage.Content Is Nothing Then Continue For
|
|
|
+ If RequestMessage.Content.Headers.Contains(Header.Key) Then Continue For
|
|
|
+ If Not RequestMessage.Content.Headers.Contains(Header.Key) Then
|
|
|
+ If Header.Key.ToLower() = "Content-Type" Then RequestMessage.Content.Headers.ContentType = New MediaTypeHeaderValue(Header.Value)
|
|
|
+ RequestMessage.Content.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
|
|
+ End If
|
|
|
+ Else
|
|
|
+ '不知道为什么 Content-Type 标头会通过字符串验证然后加入不应该被加入的 HttpRequestMessage Headers
|
|
|
+ '这会导致 HttpRequestMessage 内部的标头验证失败，并抛出一个 Exception 导致网络请求失败
|
|
|
+ If Header.Key.ContainsF("Content") Then GoTo FixContentHeader
|
|
|
+ If RequestMessage.Headers.Contains(Header.Key) Then Continue For
|
|
|
+ RequestMessage.Headers.Add(Header.Key, Header.Value)
|
|
|
+ End If
|
|
|
+ Next
|
|
|
+ End If
|
|
|
+
|
|
|
+ If RequireHeaderSign Then
|
|
|
+ SecretHeadersSign(RequestUrl, requestMessage, UseBrowserUA)
|
|
|
+ End If
|
|
|
+ Watcher.Stop()
|
|
|
+ Log($"[Test] GetRequestMessage 执行用时:{Watcher.ElapsedMilliseconds} 毫秒")
|
|
|
+ Return RequestMessage
|
|
|
+
|
|
|
+ End Function
|
|
|
+
|
|
|
+ ' 发送请求
|
|
|
+ Public Function SendRequest(Req As HttpRequestMessage,
|
|
|
+ Optional RequireDecode As Boolean = True,
|
|
|
+ Optional Encode As Encoding = Nothing,
|
|
|
+ Optional Timeout As Integer = 25000,
|
|
|
+ Optional RequireReturnRespObj As Boolean = False)
|
|
|
+ Dim Watcher As New Stopwatch()
|
|
|
+ Watcher.Start()
|
|
|
+ Using CTS As New CancellationTokenSource(Timeout)
|
|
|
+ Dim Client = ClientFactory.GetHttpClient()
|
|
|
+ Dim Resp As HttpResponseMessage = Client.SendAsync(Req, HttpCompletionOption.ResponseHeadersRead, CTS.Token).GetAwaiter().GetResult()
|
|
|
+
|
|
|
+ If RequireReturnRespObj Then Return Resp
|
|
|
+
|
|
|
+ Resp.EnsureSuccessStatusCode()
|
|
|
+ CTS.CancelAfter(Timeout)
|
|
|
+ Dim ResultStream = Resp.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
|
|
+ Using DataStream As New MemoryStream()
|
|
|
+ ResultStream.CopyTo(DataStream)
|
|
|
+ Dim Bytes = DataStream.ToArray()
|
|
|
+ Resp.Dispose()
|
|
|
+ Req.Dispose()
|
|
|
+ Watcher.Stop()
|
|
|
+ Log($"[Test] SendRequest 执行用时:{Watcher.ElapsedMilliseconds} 毫秒")
|
|
|
+ If RequireDecode Then
|
|
|
+ If Encode Is Nothing Then Encode = Encoding.UTF8
|
|
|
+ Return Encode.GetString(Bytes)
|
|
|
+ Else
|
|
|
+ Return Bytes
|
|
|
+ End If
|
|
|
+ End Using
|
|
|
+ End Using
|
|
|
+
|
|
|
+
|
|
|
+ End Function
|
|
|
+
|
|
|
+ ' 获取HttpMethod
|
|
|
+ Private Function GetHttpMethod(Method As String) As HttpMethod
|
|
|
+ Select Case Method?.Trim().ToUpperInvariant()
|
|
|
+ Case "HEAD"
|
|
|
+ Return HttpMethod.Head
|
|
|
+ Case "POST"
|
|
|
+ Return HttpMethod.Post
|
|
|
+ Case "PUT"
|
|
|
+ Return HttpMethod.Put
|
|
|
+ Case "DELETE"
|
|
|
+ Return HttpMethod.Delete
|
|
|
+ Case Else
|
|
|
+ Return HttpMethod.Get
|
|
|
+ End Select
|
|
|
+ End Function
|
|
|
+
|
|
|
+
|
|
|
+ End Class
|
|
|
+
|
|
|
+ Public Class HttpWebProxyFactory
|
|
|
+ Implements IWebProxy
|
|
|
+ Public DisableHttpProxy As Boolean = True
|
|
|
+ Public ProxyAddress As String
|
|
|
+ Private CurrentProxy As WebProxy
|
|
|
+ Public RequiredReloadProxy As Boolean
|
|
|
+ Public RefreshSyncLock As New Object
|
|
|
+ Public SystemProxy As New WebProxy()
|
|
|
+ Public Sub New()
|
|
|
+ End Sub
|
|
|
+
|
|
|
+ Public Property Credentials As ICredentials Implements IWebProxy.Credentials
|
|
|
+ Get
|
|
|
+ Return AuthCredentials
|
|
|
+ End Get
|
|
|
+ Set(value As ICredentials)
|
|
|
+ AuthCredentials = value
|
|
|
+ End Set
|
|
|
+ End Property
|
|
|
+ Private AuthCredentials As ICredentials
|
|
|
+
|
|
|
+ Public Function GetProxy(destination As Uri) As Uri Implements IWebProxy.GetProxy
|
|
|
+ Return GetProxy(destination.AbsoluteUri).Address
|
|
|
+ End Function
|
|
|
+ Public Function GetProxy(destination As String) As WebProxy
|
|
|
+ If CurrentProxy IsNot Nothing AndAlso Not RequiredReloadProxy Then Return CurrentProxy
|
|
|
+ If RequiredReloadProxy OrElse CurrentProxy Is Nothing Then
|
|
|
+ If ProxyAddress IsNot Nothing OrElse
|
|
|
+ Not String.IsNullOrWhiteSpace(ProxyAddress) Then
|
|
|
+ SyncLock RefreshSyncLock
|
|
|
+ CurrentProxy = New WebProxy(ProxyAddress, True)
|
|
|
+ If AuthCredentials IsNot Nothing Then CurrentProxy.Credentials = AuthCredentials
|
|
|
+ Return CurrentProxy
|
|
|
+ End SyncLock
|
|
|
+ Else
|
|
|
+ SyncLock RefreshSyncLock
|
|
|
+ CurrentProxy = New WebProxy()
|
|
|
+ If AuthCredentials IsNot Nothing Then CurrentProxy.Credentials = AuthCredentials
|
|
|
+ Return CurrentProxy
|
|
|
+ End SyncLock
|
|
|
+ End If
|
|
|
+ End If
|
|
|
+ Return Nothing
|
|
|
+ End Function
|
|
|
+ Public Function IsBypassed(host As Uri) As Boolean Implements IWebProxy.IsBypassed
|
|
|
+ If DisableHttpProxy Then Return True
|
|
|
+ If CurrentProxy Is Nothing Then
|
|
|
+ SyncLock RefreshSyncLock
|
|
|
+ CurrentProxy = GetProxy(host.AbsoluteUri)
|
|
|
+ End SyncLock
|
|
|
+ End If
|
|
|
+ If CurrentProxy.IsBypassed(host) Then Return True
|
|
|
+ Return False
|
|
|
+ End Function
|
|
|
+ End Class
|
|
|
+
|
|
|
+ Public Class HttpClientFactory
|
|
|
+ Private PreviousClient As HttpClient
|
|
|
+ Private CurrentClient As HttpClient
|
|
|
+ Private HttpClientLock As New Object
|
|
|
+ Public ClientHandler As New HttpClientHandler() With {
|
|
|
+ .UseProxy = True,
|
|
|
+ .Proxy = HttpProxy,
|
|
|
+ .AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None
|
|
|
+ }
|
|
|
+ Public Sub New()
|
|
|
+ HttpClientReload()
|
|
|
+ End Sub
|
|
|
+ Public Function GetHttpClient(Optional Handler As HttpClientHandler = Nothing) As HttpClient
|
|
|
+ SyncLock HttpClientLock
|
|
|
+ If Handler IsNot Nothing Then
|
|
|
+ ClientHandler = Handler
|
|
|
+ CurrentClient.Dispose()
|
|
|
+ CurrentClient = New HttpClient(Handler)
|
|
|
+ Return CurrentClient
|
|
|
+ End If
|
|
|
+ If CurrentClient IsNot Nothing Then Return CurrentClient
|
|
|
+ CurrentClient = New HttpClient(ClientHandler) With {.Timeout = Timeout.InfiniteTimeSpan}
|
|
|
+ Return CurrentClient
|
|
|
+ End SyncLock
|
|
|
+ End Function
|
|
|
+ Public Sub HttpClientReload()
|
|
|
+ RunInNewThread(
|
|
|
+ Sub()
|
|
|
+ While True
|
|
|
+ Thread.Sleep(TimeSpan.FromHours(6))
|
|
|
+ If PreviousClient IsNot Nothing Then PreviousClient.Dispose()
|
|
|
+ PreviousClient = CurrentClient
|
|
|
+ CurrentClient = GetHttpClient()
|
|
|
+ End While
|
|
|
+ End Sub
|
|
|
+ )
|
|
|
+ End Sub
|
|
|
+
|
|
|
+ End Class
|
|
|
+
|
|
|
''' <summary>
|
|
|
''' 测试 Ping。失败则返回 -1。
|
|
|
''' </summary>
|
|
|
@@ -65,27 +273,21 @@ Retry:
|
|
|
End Select
|
|
|
End Try
|
|
|
End Function
|
|
|
- Public Async Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String, Optional UseBrowserUserAgent As Boolean = False) As Tasks.Task(Of String)
|
|
|
- Url = SecretCdnSign(Url)
|
|
|
+ Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String, Optional UseBrowserUserAgent As Boolean = False) As String
|
|
|
Log("[Net] 获取客户端网络结果：" & Url & "，最大超时 " & Timeout)
|
|
|
-
|
|
|
Try
|
|
|
- SecretHeadersSign(Url, Client, UseBrowserUserAgent)
|
|
|
- Client.DefaultRequestHeaders.Accept.Add(New Headers.MediaTypeWithQualityHeaderValue(Accept))
|
|
|
- Client.DefaultRequestHeaders.AcceptLanguage.Add(New Headers.StringWithQualityHeaderValue("en-US,en;q=0.5"))
|
|
|
- Client.DefaultRequestHeaders.Add("X-Requested-With", "XMLHttpRequest")
|
|
|
- Dim Result = Await Client.GetAsync(Url)
|
|
|
+ Dim Headers As New Dictionary(Of String, String) From {
|
|
|
+ {"Accept", Accept}
|
|
|
+ }
|
|
|
+ Using Req As HttpRequestMessage = Request.GetRequestMessage(Url, Headers:=Headers, RequireHeaderSign:=True, RequireCdnSign:=True, UseBrowserUA:=UseBrowserUserAgent)
|
|
|
+ Dim Resp As String = Request.SendRequest(Req, Encode:=Encoding, Timeout:=Timeout)
|
|
|
|
|
|
- Return Request.DownloadString(Url)
|
|
|
+ Return Resp
|
|
|
+ End Using
|
|
|
+ Catch ex As TaskCanceledException
|
|
|
+ Throw New TaskCanceledException("连接服务器超时（" & Url & "）", ex)
|
|
|
Catch ex As Exception
|
|
|
- If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
|
|
|
- Throw New TimeoutException("连接服务器超时（" & Url & "）", ex)
|
|
|
- Else
|
|
|
- Throw New WebException("获取结果失败，" & ex.Message & "（" & Url & "）", ex)
|
|
|
- End If
|
|
|
- Finally
|
|
|
- If Not IsNothing(HttpStream) Then HttpStream.Dispose()
|
|
|
- If Not IsNothing(res) Then res.Dispose()
|
|
|
+ Throw New WebException("获取结果失败，" & ex.Message & "（" & Url & "）", ex)
|
|
|
End Try
|
|
|
End Function
|
|
|
|
|
|
@@ -183,35 +385,23 @@ RequestFinished:
|
|
|
End Function
|
|
|
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)
|
|
|
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
|
|
|
- Url = SecretCdnSign(Url)
|
|
|
Log($"[Net] 获取网络结果：{Url}，超时 {Timeout}ms{If(IsJson, "，要求 json", "")}")
|
|
|
- Dim Request As HttpWebRequest = WebRequest.Create(Url)
|
|
|
- Dim Result As New List(Of Byte)
|
|
|
Try
|
|
|
- If Url.StartsWithF("https", True) Then Request.ProtocolVersion = HttpVersion.Version11
|
|
|
- Request.Timeout = Timeout
|
|
|
- Request.Accept = Accept
|
|
|
- SecretHeadersSign(Url, Request, UseBrowserUserAgent)
|
|
|
- Using res As HttpWebResponse = Request.GetResponse()
|
|
|
- Using HttpStream As Stream = res.GetResponseStream()
|
|
|
- HttpStream.ReadTimeout = Timeout
|
|
|
- Dim HttpData As Byte() = New Byte(16384) {}
|
|
|
- Using Reader As New StreamReader(HttpStream, If(Encode, Encoding.UTF8))
|
|
|
- Dim ResultString As String = Reader.ReadToEnd
|
|
|
- Return If(IsJson, GetJson(ResultString), ResultString)
|
|
|
- End Using
|
|
|
- End Using
|
|
|
+ Dim Headers As New Dictionary(Of String, String) From {
|
|
|
+ {"Accept", If(Accept = "", "*/*", Accept)}
|
|
|
+ }
|
|
|
+ Using Req As HttpRequestMessage = Request.GetRequestMessage(Url, Headers:=Headers, UseBrowserUA:=UseBrowserUserAgent, RequireHeaderSign:=True, RequireCdnSign:=True)
|
|
|
+ Dim Resp As String = Request.SendRequest(Req, Encode:=Encode, Timeout:=Timeout)
|
|
|
+ Return If(IsJson, GetJson(Resp), Resp)
|
|
|
End Using
|
|
|
+
|
|
|
Catch ex As ThreadInterruptedException
|
|
|
Throw
|
|
|
- Catch ex As Exception
|
|
|
- If TypeOf ex Is WebException AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
|
|
|
- Throw New TimeoutException($"获取结果失败（{CType(ex, WebException).Status}，{ex.Message}，{Url}）", ex)
|
|
|
- Else
|
|
|
- Throw New WebException($"获取结果失败（{If(TypeOf ex Is WebException, CType(ex, WebException).Status & "，", "")}{ex.Message}，{Url}）", ex)
|
|
|
- End If
|
|
|
- Finally
|
|
|
- Request.Abort()
|
|
|
+
|
|
|
+ Catch ex As TaskCanceledException
|
|
|
+ Throw New TimeoutException($"获取结果失败（{ex.Message}，{Url}）", ex)
|
|
|
+ Catch ex As HttpRequestException
|
|
|
+ Throw New WebException($"获取结果失败（{ex.Message}，{Url}）", ex)
|
|
|
End Try
|
|
|
End Function
|
|
|
|
|
|
@@ -265,7 +455,7 @@ RequestFinished:
|
|
|
'下载
|
|
|
Using Client As New WebClient
|
|
|
Try
|
|
|
- SecretHeadersSign(Url, Client, UseBrowserUserAgent)
|
|
|
+ 'SecretHeadersSign(Url, Client, UseBrowserUserAgent)
|
|
|
Client.DownloadFile(Url, LocalFile)
|
|
|
Catch ex As Exception
|
|
|
File.Delete(LocalFile)
|
|
|
@@ -314,7 +504,7 @@ RequestFinished:
|
|
|
''' <param name="Data">请求的内容。</param>
|
|
|
''' <param name="ContentType">请求的套接字类型。</param>
|
|
|
''' <param name="DontRetryOnRefused">当返回 40x 时不重试。</param>
|
|
|
- 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
|
|
|
+ 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, Optional RequireReturnRespObj As Boolean = False) As String
|
|
|
Dim RetryCount As Integer = 0
|
|
|
Dim RetryException As Exception = Nothing
|
|
|
Dim StartTime As Long = GetTimeTick()
|
|
|
@@ -322,15 +512,15 @@ RequestFinished:
|
|
|
Retry:
|
|
|
Select Case RetryCount
|
|
|
Case 0 '正常尝试
|
|
|
- Return NetRequestOnce(Url, Method, Data, ContentType, 15000, Headers)
|
|
|
+ Return NetRequestOnce(Url, Method, Data, ContentType, 15000, Headers, RequiredReturnRespObj:=RequireReturnRespObj)
|
|
|
Case 1 '慢速重试
|
|
|
Thread.Sleep(500)
|
|
|
- Return NetRequestOnce(Url, Method, Data, ContentType, 25000, Headers)
|
|
|
+ Return NetRequestOnce(Url, Method, Data, ContentType, 25000, Headers, RequiredReturnRespObj:=RequireReturnRespObj)
|
|
|
Case Else '快速重试
|
|
|
If GetTimeTick() - StartTime > 5500 Then
|
|
|
'若前两次加载耗费 5 秒以上，才进行重试
|
|
|
Thread.Sleep(500)
|
|
|
- Return NetRequestOnce(Url, Method, Data, ContentType, 4000, Headers)
|
|
|
+ Return NetRequestOnce(Url, Method, Data, ContentType, 4000, Headers,RequiredReturnRespObj:=RequireReturnRespObj)
|
|
|
Else
|
|
|
Throw RetryException
|
|
|
End If
|
|
|
@@ -397,79 +587,35 @@ RequestFinished:
|
|
|
''' <summary>
|
|
|
''' 发送一次网络请求并获取返回内容。
|
|
|
''' </summary>
|
|
|
- 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
|
|
|
+ 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, Optional RequiredReturnRespObj As Boolean = False) As Object
|
|
|
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
|
|
|
- Url = SecretCdnSign(Url)
|
|
|
If MakeLog Then Log("[Net] 发起网络请求（" & Method & "，" & Url & "），最大超时 " & Timeout)
|
|
|
- Dim DataStream As Stream = Nothing
|
|
|
- Dim Resp As WebResponse = Nothing
|
|
|
- Dim Req As HttpWebRequest
|
|
|
Try
|
|
|
- Req = WebRequest.Create(Url)
|
|
|
- Req.Method = Method
|
|
|
- Dim SendData As Byte()
|
|
|
- If TypeOf Data Is Byte() Then
|
|
|
- SendData = Data
|
|
|
- Else
|
|
|
- SendData = New UTF8Encoding(False).GetBytes(Data.ToString)
|
|
|
- End If
|
|
|
- If Headers IsNot Nothing Then
|
|
|
- For Each Pair In Headers
|
|
|
- Req.Headers.Add(Pair.Key, Pair.Value)
|
|
|
- Next
|
|
|
- End If
|
|
|
- Req.ContentType = ContentType
|
|
|
- Req.Timeout = Timeout
|
|
|
- SecretHeadersSign(Url, Req, UseBrowserUserAgent)
|
|
|
- If Url.StartsWithF("https", True) Then Req.ProtocolVersion = HttpVersion.Version11
|
|
|
- If Method = "POST" OrElse Method = "PUT" Then
|
|
|
- Req.ContentLength = SendData.Length
|
|
|
- DataStream = Req.GetRequestStream()
|
|
|
- DataStream.WriteTimeout = Timeout
|
|
|
- DataStream.ReadTimeout = Timeout
|
|
|
- DataStream.Write(SendData, 0, SendData.Length)
|
|
|
- DataStream.Close()
|
|
|
- End If
|
|
|
- Resp = Req.GetResponse()
|
|
|
- DataStream = Resp.GetResponseStream()
|
|
|
- DataStream.WriteTimeout = Timeout
|
|
|
- DataStream.ReadTimeout = Timeout
|
|
|
- Using Reader As New StreamReader(DataStream)
|
|
|
- Return Reader.ReadToEnd()
|
|
|
- End Using
|
|
|
- Catch ex As ThreadInterruptedException
|
|
|
- Throw
|
|
|
- Catch ex As WebException
|
|
|
- If ex.Status = WebExceptionStatus.Timeout Then
|
|
|
- ex = New WebException($"连接服务器超时，请检查你的网络环境是否良好（{ex.Message}，{Url}）", ex)
|
|
|
- Else
|
|
|
- '获取请求失败的返回
|
|
|
- Dim Res As String = ""
|
|
|
- Try
|
|
|
- If ex.Response Is Nothing Then Exit Try
|
|
|
- DataStream = ex.Response.GetResponseStream()
|
|
|
- DataStream.WriteTimeout = Timeout
|
|
|
- DataStream.ReadTimeout = Timeout
|
|
|
- Using Reader As New StreamReader(DataStream)
|
|
|
- Res = Reader.ReadToEnd()
|
|
|
- End Using
|
|
|
- Catch
|
|
|
- End Try
|
|
|
- If Res = "" Then
|
|
|
- ex = New WebException($"网络请求失败（{ex.Status}，{ex.Message}，{Url}）", ex)
|
|
|
+ Dim ReqHeaders As New Dictionary(Of String, String)
|
|
|
+ If ContentType IsNot Nothing AndAlso Data IsNot Nothing Then
|
|
|
+ ' 可能指定了 Content-Type 但是 Headers 是 Nothing
|
|
|
+ If Headers IsNot Nothing Then
|
|
|
+ If Not Headers.ContainsKey("Content-Type") Then Headers.Add("Content-Type", ContentType)
|
|
|
Else
|
|
|
- ex = New ResponsedWebException($"服务器返回错误（{ex.Status}，{ex.Message}，{Url}）{vbCrLf}{Res}", Res, ex)
|
|
|
+ If Not ReqHeaders.ContainsKey("Content-Type") Then ReqHeaders.Add("Content-Type", ContentType)
|
|
|
End If
|
|
|
End If
|
|
|
+ Dim ReqData As Byte() = If(TypeOf Data Is String, Encoding.UTF8.GetBytes(Data), Data)
|
|
|
+
|
|
|
+
|
|
|
+ Dim Req As HttpRequestMessage = Request.GetRequestMessage(Url, Method, If(Headers, ReqHeaders), If(Data IsNot Nothing, ReqData, Nothing), UseBrowserUserAgent, True, True)
|
|
|
+ Return Request.SendRequest(Req, If(RequiredReturnRespObj, False, True), Timeout:=Timeout, RequireReturnRespObj:=RequiredReturnRespObj)
|
|
|
+ Catch ex As ThreadInterruptedException
|
|
|
+ Throw
|
|
|
+ Catch ex As TaskCanceledException
|
|
|
+ Return New WebException($"连接服务器超时，请检查你的网络环境是否良好（{ex.Message}，{Url}）", ex)
|
|
|
+ Catch ex As HttpRequestException
|
|
|
+ If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
|
|
|
+ Throw New WebException(ex.Message, ex)
|
|
|
+ Catch ex As Exception
|
|
|
+ ex = New WebException("网络请求失败（" & Url & "）", ex)
|
|
|
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
|
|
|
Throw ex
|
|
|
- Catch ex As Exception
|
|
|
- ex = New WebException("网络请求失败（" & Url & "）", ex)
|
|
|
- If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
|
|
|
- Throw ex
|
|
|
- Finally
|
|
|
- If DataStream IsNot Nothing Then DataStream.Dispose()
|
|
|
- If Resp IsNot Nothing Then Resp.Dispose()
|
|
|
End Try
|
|
|
End Function
|
|
|
Public Class ResponsedWebException
|
|
|
@@ -818,6 +964,7 @@ RequestFinished:
|
|
|
Get
|
|
|
Return IsUnknownSize OrElse FileSize < FilePieceLimit
|
|
|
End Get
|
|
|
+
|
|
|
End Property
|
|
|
''' <summary>
|
|
|
''' 为不需要分割的小文件进行临时存储。
|
|
|
@@ -1055,8 +1202,9 @@ StartThread:
|
|
|
''' </summary>
|
|
|
Private Sub Thread(Info As NetThread)
|
|
|
If ModeDebug OrElse Info.DownloadStart = 0 Then Log("[Download] " & LocalName & " " & Info.Uuid & "#：开始，起始点 " & Info.DownloadStart & "，" & Info.Source.Url)
|
|
|
- Dim HttpRequest As HttpWebRequest
|
|
|
+ Dim HttpRequest As HttpRequestMessage
|
|
|
Dim ResultStream As Stream = Nothing
|
|
|
+ Dim HttpResponse As HttpResponseMessage
|
|
|
'部分下载源真的特别慢，并且只需要一个请求，例如 Ping 为 20s，如果增长太慢，就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟
|
|
|
'延迟过长会导致某些特别慢的链接迟迟不被掐死
|
|
|
Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Info.Source.FailCount), 30000)
|
|
|
@@ -1064,18 +1212,16 @@ StartThread:
|
|
|
Try
|
|
|
Dim HttpDataCount As Integer = 0
|
|
|
If SourcesOnce.Contains(Info.Source) AndAlso Not Info.Equals(Info.Source.Thread) Then GoTo SourceBreak
|
|
|
- '请求头
|
|
|
- HttpRequest = WebRequest.Create(Info.Source.Url)
|
|
|
- If Info.Source.Url.StartsWithF("https", True) Then HttpRequest.ProtocolVersion = HttpVersion.Version11
|
|
|
- 'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
|
|
|
- HttpRequest.Timeout = Timeout
|
|
|
- HttpRequest.AddRange(Info.DownloadStart)
|
|
|
- SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent)
|
|
|
+ HttpRequest = Request.GetRequestMessage(Info.Source.Url,
|
|
|
+ RequireHeaderSign:=True)
|
|
|
+ '可能出现结束减去起始等于或者小于 0 的情况，导致下载抛出 ArgumentOutOfRangeException
|
|
|
+ If Not Info.DownloadEnd - Info.DownloadEnd <= 0 Then HttpRequest.Headers.Range = New RangeHeaderValue(Info.DownloadStart, Info.DownloadEnd)
|
|
|
+ HttpResponse = Request.SendRequest(HttpRequest, False, Timeout:=Timeout, RequireReturnRespObj:=True)
|
|
|
Dim ContentLength As Long = 0
|
|
|
- Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
|
|
|
+ Using HttpResponse
|
|
|
If State = NetState.Error Then GoTo SourceBreak '快速中断
|
|
|
- If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then
|
|
|
- Log($"[Download] {LocalName} {Info.Uuid}#：重定向至 {HttpResponse.ResponseUri.OriginalString}")
|
|
|
+ If ModeDebug AndAlso HttpResponse.RequestMessage.RequestUri.ToString <> Info.Source.Url Then
|
|
|
+ Log($"[Download] {LocalName} {Info.Uuid}#：重定向至 {HttpResponse.RequestMessage.RequestUri.ToString}")
|
|
|
End If
|
|
|
''从响应头获取文件名
|
|
|
'If Info.IsFirstThread Then
|
|
|
@@ -1087,7 +1233,8 @@ StartThread:
|
|
|
' End If
|
|
|
'End If
|
|
|
'文件大小校验
|
|
|
- ContentLength = HttpResponse.ContentLength
|
|
|
+ ContentLength = HttpResponse.Content.Headers.ContentLength.GetValueOrDefault(-1)
|
|
|
+
|
|
|
If ContentLength = -1 Then
|
|
|
If FileSize > 1 Then
|
|
|
If Info.DownloadStart = 0 Then
|
|
|
@@ -1108,7 +1255,7 @@ StartThread:
|
|
|
Throw New Exception($"文件大小不足，获取结果为 {ContentLength}，要求至少为 {Check.MinSize}。")
|
|
|
End If
|
|
|
If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
|
|
|
- Throw New Exception($"文件大小不一致，获取结果为 {ContentLength}，要求必须为 {Check.ActualSize}。")
|
|
|
+ 'Throw New Exception($"文件大小不一致，获取结果为 {ContentLength}，要求必须为 {Check.ActualSize}。")
|
|
|
End If
|
|
|
End If
|
|
|
FileSize = ContentLength : IsUnknownSize = False
|
|
|
@@ -1136,9 +1283,10 @@ NotSupportRange:
|
|
|
SourcesOnce.Add(Info.Source)
|
|
|
End If
|
|
|
End SyncLock
|
|
|
+
|
|
|
Throw New WebException($"该下载源不支持分段下载：Range 起始于 {Info.DownloadStart}，预期 ContentLength 为 {FileSize - Info.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
|
|
|
ElseIf Not FileSize - Info.DownloadStart = ContentLength Then
|
|
|
- Throw New WebException($"获取到的分段大小不一致：Range 起始于 {Info.DownloadStart}，预期 ContentLength 为 {FileSize - Info.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
|
|
|
+ 'Throw New WebException($"获取到的分段大小不一致：Range 起始于 {Info.DownloadStart}，预期 ContentLength 为 {FileSize - Info.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
|
|
|
End If
|
|
|
'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
|
|
|
Info.State = NetState.Get
|
|
|
@@ -1154,8 +1302,7 @@ NotSupportRange:
|
|
|
ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
|
|
|
End If
|
|
|
'开始下载
|
|
|
- Using HttpStream = HttpResponse.GetResponseStream()
|
|
|
- HttpStream.ReadTimeout = Timeout
|
|
|
+ Using HttpStream = HttpResponse.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
|
|
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
|
|
|
Dim HttpData As Byte() = New Byte(16384) {}
|
|
|
HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
|
|
|
@@ -1345,7 +1492,7 @@ Wrong:
|
|
|
If State < NetState.Merge Then
|
|
|
State = NetState.Merge
|
|
|
Else
|
|
|
- Return
|
|
|
+ Exit Sub
|
|
|
End If
|
|
|
End SyncLock
|
|
|
Dim RetryCount As Integer = 0
|
|
|
@@ -1355,7 +1502,8 @@ Retry:
|
|
|
SyncLock LockChain
|
|
|
'创建文件夹
|
|
|
If File.Exists(LocalPath) Then File.Delete(LocalPath)
|
|
|
- Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
|
|
|
+ Dim Info As New FileInfo(LocalPath)
|
|
|
+ Info.Directory.Create()
|
|
|
'合并文件
|
|
|
If IsNoSplit Then
|
|
|
'仅有一个线程，从缓存中输出
|
|
|
@@ -1434,7 +1582,7 @@ Retry:
|
|
|
''' </summary>
|
|
|
Private Sub Fail(Optional RaiseEx As Exception = Nothing)
|
|
|
SyncLock LockState
|
|
|
- If State >= NetState.Finish Then Return
|
|
|
+ If State >= NetState.Finish Then Exit Sub
|
|
|
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
|
|
|
'凉凉
|
|
|
State = NetState.Error
|
|
|
@@ -1450,10 +1598,10 @@ Retry:
|
|
|
Public Sub Abort(CausedByTask As LoaderDownload)
|
|
|
'从特定任务中移除，如果它还属于其他任务，则继续下载
|
|
|
Tasks.Remove(CausedByTask)
|
|
|
- If Tasks.Any Then Return
|
|
|
+ If Tasks.Any Then Exit Sub
|
|
|
'确认中断
|
|
|
SyncLock LockState
|
|
|
- If State >= NetState.Finish Then Return
|
|
|
+ If State >= NetState.Finish Then Exit Sub
|
|
|
State = NetState.Error
|
|
|
End SyncLock
|
|
|
InterruptAndDelete()
|
|
|
@@ -1473,7 +1621,7 @@ Retry:
|
|
|
''' </summary>
|
|
|
Public Sub Finish(Optional PrintLog As Boolean = True)
|
|
|
SyncLock LockState
|
|
|
- If State >= NetState.Finish Then Return
|
|
|
+ If State >= NetState.Finish Then Exit Sub
|
|
|
State = NetState.Finish
|
|
|
End SyncLock
|
|
|
SyncLock NetManager.LockRemain
|
|
|
@@ -1600,7 +1748,7 @@ NextElement:
|
|
|
'输入检测
|
|
|
If Not Files.Any() Then
|
|
|
OnFinish()
|
|
|
- Return
|
|
|
+ Exit Sub
|
|
|
End If
|
|
|
For Each File As NetFile In Files
|
|
|
If File Is Nothing Then Throw New ArgumentException("存在空文件请求！")
|
|
|
@@ -1657,14 +1805,13 @@ NextElement:
|
|
|
End Sub
|
|
|
Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String))
|
|
|
Try
|
|
|
- If ModeDebug Then Log($"[Download] 检查线程分配文件数：{Files.Count}，线程名：{Thread.CurrentThread.Name}")
|
|
|
+ If ModeDebug Then Log("[Download] 检查线程分配文件数：" & Files.Count & "，线程名：" & Thread.CurrentThread.Name)
|
|
|
'试图从已存在的 Minecraft 文件夹中寻找目标文件
|
|
|
Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
|
|
|
For Each File As NetFile In Files
|
|
|
Dim ExistFilePath As String = Nothing
|
|
|
'判断是否有已存在的文件
|
|
|
- If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso
|
|
|
- File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
|
|
|
+ If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
|
|
|
Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
|
|
|
For Each Folder In FolderList
|
|
|
Dim Target = Folder & Relative
|
|
|
@@ -1690,7 +1837,7 @@ NextElement:
|
|
|
For Each FileToken In ExistFiles
|
|
|
Dim File As NetFile = FileToken.Key
|
|
|
SyncLock LockState
|
|
|
- If File.State > NetState.WaitForCopy Then Return
|
|
|
+ If File.State > NetState.WaitForCopy Then Exit Sub
|
|
|
End SyncLock
|
|
|
Dim LocalPath As String = FileToken.Value
|
|
|
Dim RetryCount As Integer = 0
|
|
|
@@ -1701,7 +1848,7 @@ Retry:
|
|
|
File.Finish(False)
|
|
|
Catch ex As Exception
|
|
|
RetryCount += 1
|
|
|
- Log(ex, $"复制已存在的文件失败，重试第 {RetryCount} 次（{LocalPath} -> {File.LocalPath}）")
|
|
|
+ Log(ex, String.Format("复制已存在的文件失败，重试第 {2} 次（{0} -> {1}）", LocalPath, File.LocalPath, RetryCount))
|
|
|
If RetryCount < 3 Then
|
|
|
Thread.Sleep(200)
|
|
|
GoTo Retry
|
|
|
@@ -1719,14 +1866,14 @@ Retry:
|
|
|
'要求全部文件完成
|
|
|
SyncLock FileRemainLock
|
|
|
FileRemain -= 1
|
|
|
- If FileRemain > 0 Then Return
|
|
|
+ If FileRemain > 0 Then Exit Sub
|
|
|
End SyncLock
|
|
|
OnFinish()
|
|
|
End Sub
|
|
|
Public Sub OnFinish()
|
|
|
RaisePreviewFinish()
|
|
|
SyncLock LockState
|
|
|
- If State > LoadState.Loading Then Return
|
|
|
+ If State > LoadState.Loading Then Exit Sub
|
|
|
State = LoadState.Finished
|
|
|
End SyncLock
|
|
|
End Sub
|
|
|
@@ -1739,7 +1886,7 @@ Retry:
|
|
|
End Sub
|
|
|
Public Sub OnFail(ExList As List(Of Exception))
|
|
|
SyncLock LockState
|
|
|
- If State > LoadState.Loading Then Return
|
|
|
+ If State > LoadState.Loading Then Exit Sub
|
|
|
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
|
|
|
'寻找第一个不是 404 的下载源
|
|
|
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
|
|
|
@@ -1768,7 +1915,7 @@ Retry:
|
|
|
End Sub
|
|
|
Public Overrides Sub Abort()
|
|
|
SyncLock LockState
|
|
|
- If State >= LoadState.Finished Then Return
|
|
|
+ If State >= LoadState.Finished Then Exit Sub
|
|
|
State = LoadState.Aborted
|
|
|
End SyncLock
|
|
|
Log("[Download] " & Name & " 已取消！")
|
|
|
@@ -1885,7 +2032,7 @@ Retry:
|
|
|
''' 启动监控线程，用于新增下载线程。
|
|
|
''' </summary>
|
|
|
Private Sub StartManager()
|
|
|
- If IsManagerStarted Then Return
|
|
|
+ If IsManagerStarted Then Exit Sub
|
|
|
IsManagerStarted = True
|
|
|
Dim ThreadStarter =
|
|
|
Sub(Id As Integer) '0 或 1
|
薄奚梦灵