diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index fbebe6a..5165cdb 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -38,7 +38,6 @@ jobs:
- name: Update Help
run: |
- $workpath = [System.Environment]::CurrentDirectory
Set-Location ..
git clone https://github.com/LTCatt/PCL2Help.git -b master --single-branch --depth 1
Set-Location PCL2Help
diff --git a/Plain Craft Launcher 2/App.config b/Plain Craft Launcher 2/App.config
index 8d134eb..d464350 100644
--- a/Plain Craft Launcher 2/App.config
+++ b/Plain Craft Launcher 2/App.config
@@ -32,4 +32,4 @@
-
+
\ No newline at end of file
diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb
index f93903a..f7d1b3c 100644
--- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb
+++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb
@@ -1,9 +1,216 @@
-Public Module ModNet
+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 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 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
+
+ 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)
+ 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()
+
+ 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
'''
''' 测试 Ping。失败则返回 -1。
'''
+ '''
Public Function Ping(Ip As String, Optional Timeout As Integer = 10000, Optional MakeLog As Boolean = True) As Integer
Dim PingResult As NetworkInformation.PingReply
Try
@@ -62,30 +269,22 @@ Retry:
End Try
End Function
Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String, Optional UseBrowserUserAgent As Boolean = False) As String
- Url = SecretCdnSign(Url)
Log("[Net] 获取客户端网络结果：" & Url & "，最大超时 " & Timeout)
- Dim Request As CookieWebClient
- Dim res As HttpWebResponse = Nothing
- Dim HttpStream As Stream = Nothing
Try
- Request = New CookieWebClient With {
- .Encoding = Encoding,
- .Timeout = Timeout
+ Dim Headers As New Dictionary(Of String, String) From {
+ {"Accept", Accept}
}
- Request.Headers("Accept") = Accept
- Request.Headers("Accept-Language") = "en-US,en;q=0.5"
- Request.Headers("X-Requested-With") = "XMLHttpRequest"
- SecretHeadersSign(Url, Request, UseBrowserUserAgent)
- Return Request.DownloadString(Url)
+ Using Req As HttpRequestMessage = Request.GetRequestMessage(Url, Headers:=Headers, RequireHeaderSign:=True, RequireCdnSign:=True, UseBrowserUA:=UseBrowserUserAgent)
+ Req.Headers.AcceptLanguage.Add(New StringWithQualityHeaderValue("en-US,en;q=0.5"))
+ Req.Headers.TryAddWithoutValidation("X-Request-With","XMLHttpRequest")
+ Dim Resp As String = Request.SendRequest(Req, Encode:=Encoding, Timeout:=Timeout)
+
+ 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 +382,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 +452,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 +501,7 @@ RequestFinished:
''' 请求的内容。
''' 请求的套接字类型。
''' 当返回 40x 时不重试。
- 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 +509,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 +584,35 @@ RequestFinished:
'''
''' 发送一次网络请求并获取返回内容。
'''
- 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 +961,7 @@ RequestFinished:
Get
Return IsUnknownSize OrElse FileSize < FilePieceLimit
End Get
+
End Property
'''
''' 为不需要分割的小文件进行临时存储。
@@ -1055,8 +1199,9 @@ StartThread:
'''
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 +1209,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.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Info.DownloadStart, Nothing)
+ 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 +1230,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
@@ -1136,11 +1280,12 @@ 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}")
End If
- 'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
+ Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
Info.State = NetState.Get
SyncLock LockState
If State < NetState.Get Then State = NetState.Get
@@ -1154,8 +1299,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 +1489,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 +1499,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 +1579,7 @@ Retry:
'''
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 +1595,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 +1618,7 @@ Retry:
'''
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 +1745,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 +1802,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 +1834,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 +1845,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 +1863,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 +1883,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 +1912,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 +2029,7 @@ Retry:
''' 启动监控线程，用于新增下载线程。
'''
Private Sub StartManager()
- If IsManagerStarted Then Return
+ If IsManagerStarted Then Exit Sub
IsManagerStarted = True
Dim ThreadStarter =
Sub(Id As Integer) '0 或 1
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
index 14edb8a..00469b8 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
@@ -1424,6 +1424,7 @@ Retry:
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
+ If (McLaunchJavaSelected.VersionCode >= 6) Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT")
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", McVersionCurrent))
@@ -1493,6 +1494,7 @@ NextVersion:
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
+ If (McLaunchJavaSelected.VersionCode >= 6) Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT")
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
diff --git a/Plain Craft Launcher 2/Modules/ModSecret.vb b/Plain Craft Launcher 2/Modules/ModSecret.vb
index 5353dfe..37abcf8 100644
--- a/Plain Craft Launcher 2/Modules/ModSecret.vb
+++ b/Plain Craft Launcher 2/Modules/ModSecret.vb
@@ -1,5 +1,6 @@
'由于包含加解密等安全信息，本文件中的部分代码已被删除
+Imports System.Net.Http
Imports System.Security.Cryptography
Friend Module ModSecret
@@ -78,32 +79,19 @@ Friend Module ModSecret
'''
''' 设置 Headers 的 UA、Referer。
'''
- Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
+ Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional UseBrowserUserAgent As Boolean = False)
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
- Client.Headers("User-Agent") = "LogStatistic" '#4951
+ Req.Headers.Add("User-Agent", "LogStatistic") '#4951
ElseIf UseBrowserUserAgent Then
- Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
+ Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
Else
- Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
+ Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
End If
- Client.Headers("Referer") = "http://" & VersionCode & ".open.pcl2.server/"
- If Url.Contains("api.curseforge.com") Then Client.Headers("x-api-key") = CurseForgeAPIKey
- End Sub
- '''
- ''' 设置 Headers 的 UA、Referer。
- '''
- Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
- If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
- Request.UserAgent = "LogStatistic" '#4951
- ElseIf UseBrowserUserAgent Then
- Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
- Else
- Request.UserAgent = "PCL2/" & VersionStandardCode
- End If
- Request.Referer = "http://" & VersionCode & ".open.pcl2.server/"
- If Url.Contains("api.curseforge.com") Then Request.Headers("x-api-key") = CurseForgeAPIKey
+ Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
+ If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
End Sub
+
#End Region
#Region "字符串加解密"
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml.vb
index 3ad75d4..18be6d0 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml.vb
@@ -68,6 +68,10 @@ Public Class PageComp
''' 在切换到页面时，应自动将筛选项设置为与该目标 MC 版本和加载器相同。
'''
Public Shared TargetVersion As McVersion = Nothing
+ '''
+ ''' 在切换到该页面时自动设置的搜索框内的内容。
+ '''
+ Public Shared TargetName As String = Nothing
'在点击 MyCompItem 时会获取 Loader 的输入，以使资源详情页面可以应用相同的筛选项
Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取：XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
@@ -94,6 +98,11 @@ Public Class PageComp
ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
End If
TargetVersion = Nothing
+ If TargetName IsNot Nothing Then
+ '设置搜索框内容
+ TextSearchName.Text = TargetName
+ TargetName = Nothing
+ End If
'如果已经完成请求，则重新开始
If IsLoaderInited Then StartNewSearch()
ScrollToHome()
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb
index 60a8ad3..ea5c4c0 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb
@@ -75,6 +75,8 @@
Dim Results As List(Of CompFile) = CompFileLoader.Output
If PageType = CompType.Any Then
Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
+ ElseIf PageType = CompType.Shader OrElse PageType = CompType.ResourcePack Then
+ Results = Results.ToList
Else
Results = Results.Where(Function(r) r.Type = PageType).ToList
End If
diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
index 647675f..a4cb54d 100644
--- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
@@ -1,4 +1,6 @@
-Public Class PageSetupUI
+Imports NAudio.Wave
+
+Public Class PageSetupUI
Public Shadows IsLoaded As Boolean = False
@@ -274,7 +276,7 @@
'顶部栏
Private Sub BtnLogoChange_Click(sender As Object, e As EventArgs) Handles BtnLogoChange.Click
- Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.webp)|*.png;*.jpg;*.gif;*.webp", "选择图片")
+ Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.webp;*.jpeg)|*.png;*.jpg;*.gif;*.webp;*.jpeg", "选择图片")
If FileName = "" Then Return
Try
'拷贝文件
@@ -357,7 +359,15 @@ Refresh:
PanMusicVolume.Visibility = Visibility.Visible
PanMusicDetail.Visibility = Visibility.Visible
BtnMusicClear.Visibility = Visibility.Visible
- CardMusic.Title = "背景音乐（" & EnumerateFiles(Path & "PCL\Musics\").Count & " 首）"
+ Dim validMusicCount As Integer = 0
+ For Each File In EnumerateFiles(Path & "PCL\Musics\")
+ Try
+ If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(File.Extension.ToLower) Then Continue For
+ validMusicCount += 1
+ Catch ex As Exception
+ End Try
+ Next
+ CardMusic.Title = "背景音乐（" & validMusicCount & " 首）"
Else
PanMusicVolume.Visibility = Visibility.Collapsed
PanMusicDetail.Visibility = Visibility.Collapsed
diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
index 184e924..3fe78d0 100644
--- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
@@ -382,6 +382,7 @@ Install:
'''
Private Sub BtnManageDownload_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageDownload.Click, BtnHintDownload.Click
PageComp.TargetVersion = PageVersionLeft.Version '将当前版本设置为筛选器
+ PageComp.TargetName = SearchBox.Text '将当前搜索框内容设置为筛选器
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadMod)
End Sub
diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb
index 91a8e0c..c85c321 100644
--- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb
@@ -185,7 +185,7 @@
'选择 自定义 时修改图片
Try
If ComboDisplayLogo.SelectedItem Is ItemDisplayLogoCustom Then
- Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片")
+ Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.jpeg)|*.png;*.jpg;*.gif;*.jpeg", "选择图片")
If FileName = "" Then
Reload() '还原选项
Return
@@ -331,7 +331,7 @@
DeleteDirectory(PageVersionLeft.Version.Path)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除！", HintType.Finish)
Else
- FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
+ FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站！", HintType.Finish)
End If
Case 2