2.10.8

Author: LTCatt

Plain Craft Launcher 2/Application.xaml.vb

@@ -19,6 +19,9 @@ Public Class Application
     '开始
     Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
         Try
+            '动态 DLL 调用（必须尽量在前面，否则模块加载 CacheCow 等 DLL 就可能导致崩溃）
+            AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
+            '开始
             SecretOnApplicationStart()
             '检查参数调用
             If e.Args.Length > 0 Then
@@ -116,8 +119,6 @@ WaitRetry:
                 FrmStart = New SplashScreen("Images\icon.ico")
                 FrmStart.Show(False, True)
             End If
-            '动态 DLL 调用
-            AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
             '日志初始化
             LogStart()
             '添加日志

Plain Craft Launcher 2/Controls/MyImage.vb

@@ -121,7 +121,6 @@
         RunInNewThread(
         Sub()
             Try
-RetryStart:
                 '下载
                 ActualSource = LoadingSource '显示加载中的占位图片
                 NetDownloadByLoader(

Plain Craft Launcher 2/FormMain.xaml.vb

@@ -11,6 +11,14 @@ Public Class FormMain
         Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
         '统计更新日志条目
 #If BETA Then
+        If LastVersion < 369 Then 'Release 2.10.8
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许在版本设置中设置禁止更新 Mod，以防整合包玩家误操作"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化：若整合包需要 PCL 不兼容的加载器，允许选择跳过它的安装"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "删除：由于已不再需要，删除手动安装包下载功能"))
+            FeatureCount += 21
+            BugCount += 32
+        End If
         If LastVersion < 367 Then 'Release 2.10.6
             FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：启用 MCIM 社区资源镜像源，以缓解社区资源难以下载的问题"))
             FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：正版登录出错时无法给出正确的错误信息"))
@@ -96,6 +104,11 @@ Public Class FormMain
         '3：BUG+ IMP* FEAT-
         '2：BUG* IMP-
         '1：BUG-
+        If LastVersion < 370 Then 'Snapshot 2.10.8
+            If LastVersion >= 368 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化"))
+            FeatureCount += 3
+            BugCount += 4
+        End If
         If LastVersion < 368 Then 'Snapshot 2.10.7
             FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许在版本设置中设置禁止更新 Mod，以防整合包玩家误操作"))
             FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化"))
@@ -590,7 +603,7 @@ Public Class FormMain
                 FeedbackInfo()
                 Log("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告，以便于作者解决此问题！")
                 IsLogShown = True
-                ShellOnly(Path & "PCL\Log1.txt")
+                StartProcess(Path & "PCL\Log1.txt")
             End If
             Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
         End If

Plain Craft Launcher 2/Modules/Base/ModBase.vb

@@ -1,9 +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
 
 Public Module ModNet
 
@@ -75,6 +73,11 @@ Retry:
         Catch ex As ThreadInterruptedException
             Throw
         Catch ex As Exception
+            If TypeOf ex Is ResponsedWebException Then
+                If CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Forbidden Then Throw
+                If CType(ex, ResponsedWebException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests
+            End If
+            '重试
             Select Case RetryCount
                 Case 0
                     RetryException = ex
@@ -245,8 +248,20 @@ RequestFinished:
             SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
             'DNS 解析
             CancelToken = New CancellationTokenSource(Timeout)
-            HostIp = DnsLookup(Request, CancelToken)
+            HostIp = DNSLookup(Request, CancelToken)
+            If HostIp IsNot Nothing AndAlso Not IPReliability.ContainsKey(HostIp) Then
+                IPReliability(HostIp) = -0.01 '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
+            End If
             '发送请求
+            SyncLock RequestClientLock
+                '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
+                If RequestClient Is Nothing Then
+                    RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
+                        .AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None,
+                        .UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies
+                    })
+                End If
+            End SyncLock
             Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
             Dim ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
             Dim ResponseBytes As Byte()
@@ -263,18 +278,18 @@ RequestFinished:
                 Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes)
                 Throw New ResponsedWebException(
                     $"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" &
-                    If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), ResponseMessage)
+                    If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage)
             End If
         Catch ex As ThreadInterruptedException
             Throw
         Catch ex As ResponsedWebException
             Throw
-        Catch ex As DnsLookupException
-            Throw
         Catch ex As Exception
             RecordIPReliability(HostIp, -1)
             If TypeOf ex Is OperationCanceledException Then 'CancellationToken 超时
-                Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，{HostIp}）", WebExceptionStatus.Timeout)
+                Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
+            ElseIf ex.IsNetworkRelated Then
+                Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
             Else
                 Throw New Exception($"网络请求出现意外异常（{Method}, {Url}，{HostIp}）", ex)
             End If
@@ -284,17 +299,15 @@ RequestFinished:
             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
-    })
+    Private RequestClient As HttpClient = Nothing
+    Private RequestClientLock As New Object
 
     ''' <summary>
     ''' 进行 DNS 解析。它仅在选择的 IP 与系统默认的不一致时才对 URL 中的 Host 进行替换。
     ''' 返回请求时应使用的 IP；若为 IPv6，则加上了方括号。
+    ''' 若解析失败，则返回 Nothing。
     ''' </summary>
-    ''' <exception cref="DnsLookupException"></exception>
-    Private Function DnsLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String
+    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
@@ -303,10 +316,14 @@ RequestFinished:
             DnsTask = Dns.GetHostAddressesAsync(Host)
             DnsTask.Wait(CancelToken.Token)
         Catch ex As Exception
-            Throw New DnsLookupException($"DNS 解析失败，请检查你的网络连接（{Host}）", ex)
+            Log(ex, $"DNS 解析失败（{Host}）")
+            Return Nothing
         End Try
         Dim Candidates As IPAddress() = DnsTask.Result.ToArray
-        If Not Candidates.Any Then Throw New DnsLookupException($"DNS 解析无结果，请检查你的网络连接（{Host}）")
+        If Not Candidates.Any Then
+            Log($"[Net] DNS 解析无结果（{Host}）")
+            Return Nothing
+        End If
         '若同时存在 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
@@ -322,20 +339,19 @@ RequestFinished:
         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("；")}")
+            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)
+    Private IPReliability As New SafeDictionary(Of String, Double)
     ''' <summary>
     ''' 根据请求结果，记录 IP 地址的可靠度。
     ''' </summary>
@@ -346,29 +362,22 @@ RequestFinished:
     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 属性，可用于获取远程服务器给予的回复。
+    ''' 当 HTTP 状态码不指示成功时引发的异常。
+    ''' 附带额外属性，可用于获取远程服务器给予的回复以及 HTTP 状态码。
     ''' </summary>
     Public Class ResponsedWebException
         Inherits WebException
         ''' <summary>
+        ''' HTTP 状态码。
+        ''' </summary>
+        Public StatusCode As HttpStatusCode
+        ''' <summary>
         ''' 远程服务器给予的回复。
         ''' </summary>
         Public Overloads Property Response As String
-        Public Sub New(Message As String, Response As String)
+        Public Sub New(Message As String, StatusCode As HttpStatusCode, Response As String)
             MyBase.New(Message)
+            Me.StatusCode = StatusCode
             Me.Response = Response
         End Sub
     End Class
@@ -750,7 +759,7 @@ RequestFinished:
         ''' </summary>
         Public Check As FileChecker
         ''' <summary>
-        ''' 下载时是否添加浏览器 UA。
+        ''' 是否模拟浏览器的 UserAgent 和 Referer。
         ''' </summary>
         Public SimulateBrowserHeaders As Boolean
 
@@ -969,7 +978,7 @@ StartThread:
             If ModeDebug OrElse Th.DownloadStart = 0 Then Log($"[Download] {LocalName}：开始，起始点 {Th.DownloadStart}，{Th.Source.Url}")
             Dim ResultStream As Stream = Nothing, HttpRequest As HttpRequestMessage = Nothing,
                 Response As HttpResponseMessage = Nothing, ResponseStream As Stream = Nothing,
-                CancelToken As CancellationTokenSource = Nothing, HostIp As String = ""
+                CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing
             '部分下载源真的特别慢，并且只需要一个请求，例如 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)
@@ -980,7 +989,7 @@ StartThread:
                 HttpRequest = New HttpRequestMessage(HttpMethod.Get, Th.Source.Url)
                 SecretHeadersSign(Th.Source.Url, HttpRequest, SimulateBrowserHeaders)
                 CancelToken = New CancellationTokenSource(Timeout)
-                HostIp = DnsLookup(HttpRequest, CancelToken) 'DNS 预解析
+                HostIp = DNSLookup(HttpRequest, CancelToken) 'DNS 预解析
                 If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Th.DownloadStart, Nothing)
                 Dim ContentLength As Long = 0
                 Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
@@ -1126,7 +1135,7 @@ SourceBreak:
                     RecordIPReliability(HostIp, 0.5)
                 End If
             Catch ex As Exception
-                Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException, $"已超时（{Timeout}ms）", ex.GetDetail())}，{HostIp}")
+                Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException, $"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{HostIp}")
                 RecordIPReliability(HostIp, -0.7)
                 SourceFail(Th, ex, False)
             Finally
@@ -1864,23 +1873,27 @@ Retry:
         End Sub
         Private IsManagerStarted As Boolean = False
 
-        'Public FileRemainList As New List(Of String)
+        Private DownloadCacheLock As New Object
         Private IsDownloadCacheCleared As Boolean = False
         ''' <summary>
         ''' 开始一个下载任务。
         ''' </summary>
         Public Sub Start(Task As LoaderDownload)
             StartManager()
             '清理缓存
-            If Not IsDownloadCacheCleared Then
-                Try
-                    DeleteDirectory(PathTemp & "Download")
-                Catch ex As Exception
-                    Log(ex, "清理下载缓存失败")
-                End Try
+            SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理
+                If Not IsDownloadCacheCleared Then
+                    Try
+                        Log("[Net] 开始清理下载缓存")
+                        DeleteDirectory(PathTemp & "Download")
+                        Log("[Net] 下载缓存已清理")
+                    Catch ex As Exception
+                        Log(ex, "清理下载缓存失败")
+                    End Try
+                    Directory.CreateDirectory(PathTemp & "Download")
+                End If
                 IsDownloadCacheCleared = True
-            End If
-            Directory.CreateDirectory(PathTemp & "Download")
+            End SyncLock
             '文件处理
             SyncLock LockFiles
                 '添加每个文件
@@ -1959,11 +1972,12 @@ Retry:
     ''' 判断某个 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))
+        Return {
+            "(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称",
+            "由于目标计算机积极拒绝", "基础连接已经关闭"
+        }.Any(Function(k) Detail.ContainsF(k, True))
     End Function
 
 End Module