Merge branch 'main' into fix#6230

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

@@ -467,7 +467,7 @@ Public Module ModAnimation
     ''' 按照 WPF 方式旋转控件的动画。
     ''' </summary>
     ''' <param name="Obj">动画的对象。它必须已经拥有了单一的 ScaleTransform 值。</param>
-    ''' <param name="Value">大小改变的百分比（如-0.6）。</param>
+    ''' <param name="Value">旋转角度（度）。</param>
     ''' <param name="Time">动画长度（毫秒）。</param>
     ''' <param name="Delay">动画延迟执行的时间（毫秒）。</param>
     ''' <param name="Ease">插值器类型。</param>
@@ -792,44 +792,46 @@ Public Module ModAnimation
         AniFPSTimer = AniLastTick
         AniRunning = True '标记动画执行开始
 
-        RunInNewThread(Sub()
-                           Try
-                               Log("[Animation] 动画线程开始")
-                               Do While True
-                                   '两帧之间的间隔时间
-                                   Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
-                                   If DeltaTime < 3 Then GoTo Sleeper
-                                   AniLastTick = GetTimeTick()
-                                   '记录 FPS
-                                   If ModeDebug Then
-                                       If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
-                                           AniFPS = AniFPSCounter
-                                           AniFPSCounter = 0
-                                           AniFPSTimer = AniLastTick
-                                       End If
-                                       AniFPSCounter += 2
-                                   End If
-                                   '执行动画
-                                   RunInUiWait(Sub()
-                                                   AniCount = 0
-                                                   AniTimer(DeltaTime * AniSpeed)
-                                                   '#If DEBUG Then
-                                                   '    FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
-                                                   '#Else
-                                                   '    If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
-                                                   '#End If
-                                                   If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
-                                                       Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "（" & GetString(NetManager.Speed) & "/s）")
-                                                   End If
-                                               End Sub)
+        RunInNewThread(
+        Sub()
+            Try
+                Log("[Animation] 动画线程开始")
+                Do While True
+                    '两帧之间的间隔时间
+                    Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
+                    If DeltaTime < 3 Then GoTo Sleeper
+                    AniLastTick = GetTimeTick()
+                    '记录 FPS
+                    If ModeDebug Then
+                        If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
+                            AniFPS = AniFPSCounter
+                            AniFPSCounter = 0
+                            AniFPSTimer = AniLastTick
+                        End If
+                        AniFPSCounter += 2
+                    End If
+                    '执行动画
+                    RunInUiWait(
+                    Sub()
+                        AniCount = 0
+                        AniTimer(DeltaTime * AniSpeed)
+                        '#If DEBUG Then
+                        '    FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
+                        '#Else
+                        '    If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
+                        '#End If
+                        If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
+                            Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "（" & GetString(NetManager.Speed) & "/s）")
+                        End If
+                    End Sub)
 Sleeper:
-                                   '控制 FPS
-                                   Thread.Sleep(1)
-                               Loop
-                           Catch ex As Exception
-                               Log(ex, "动画帧执行失败", LogLevel.Critical)
-                           End Try
-                       End Sub, "Animation", ThreadPriority.AboveNormal)
+                    '控制 FPS
+                    Thread.Sleep(1)
+                Loop
+            Catch ex As Exception
+                Log(ex, "动画帧执行失败", LogLevel.Critical)
+            End Try
+        End Sub, "Animation", ThreadPriority.AboveNormal)
     End Sub
 
     ''' <summary>
@@ -996,7 +998,7 @@ NextAni:
                 Case AniType.ScaleTransform
                     Dim Obj As FrameworkElement = Ani.Obj
                     If TypeOf Obj.RenderTransform IsNot ScaleTransform Then
-                        Obj.RenderTransformOrigin = New Point(0.5, 0.5)
+                        If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
                         Obj.RenderTransform = New ScaleTransform(1, 1)
                     End If
                     Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
@@ -1006,7 +1008,7 @@ NextAni:
                 Case AniType.RotateTransform
                     Dim Obj As FrameworkElement = Ani.Obj
                     If TypeOf Obj.RenderTransform IsNot RotateTransform Then
-                        Obj.RenderTransformOrigin = New Point(0.5, 0.5)
+                        If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
                         Obj.RenderTransform = New RotateTransform(0)
                     End If
                     Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))

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

@@ -5,6 +5,7 @@ Imports System.Runtime.CompilerServices
 Imports System.Security.Cryptography
 Imports System.Security.Principal
 Imports System.Text.RegularExpressions
+Imports System.Threading.Tasks
 Imports System.Xaml
 Imports Newtonsoft.Json
 
@@ -13,13 +14,13 @@ Public Module ModBase
 #Region "声明"
 
     '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.10.6" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.10.6." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.11.2" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.11.2." & VersionBranchCode '标准格式的四段式版本号
     Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
-    Public Const VersionCode As Integer = 367 'Release
+    Public Const VersionCode As Integer = 372 'Release
 #Else
-    Public Const VersionCode As Integer = 366 'Snapshot
+    Public Const VersionCode As Integer = 375 'Snapshot
 #End If
     '自动生成的版本信息
     Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -69,7 +70,7 @@ Public Module ModBase
     ''' <summary>
     ''' 识别码。
     ''' </summary>
-    Public UniqueAddress As String = SecretGetUniqueAddress()
+    Public Identify As String = SecretGetIdentify()
     ''' <summary>
     ''' 程序是否已结束。
     ''' </summary>
@@ -498,6 +499,7 @@ Public Module ModBase
             RealNum += Digit * Scale
             Scale *= FromRadix
         Next
+        If RealNum = 0 Then Return "0"
         '转换为指定进制
         Dim Result = ""
         While RealNum > 0
@@ -761,21 +763,9 @@ Public Module ModBase
         If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
         Dim length As Integer = FilePath.Length
         If length = 0 Then Throw New Exception("不包含文件名：" & FilePath)
-        If length > 250 Then Throw New PathTooLongException("文件名过长：" & FilePath)
         Return FilePath
     End Function
     ''' <summary>
-    ''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
-    ''' </summary>
-    Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String
-        Dim Name As String = GetFileNameFromPath(FilePath)
-        If Name.Contains(".") Then
-            Return Name.Substring(0, Name.LastIndexOfF("."))
-        Else
-            Return Name
-        End If
-    End Function
-    ''' <summary>
     ''' 从文件夹路径获取文件夹名。
     ''' </summary>
     Public Function GetFolderNameFromPath(FolderPath As String) As String
@@ -791,8 +781,8 @@ Public Module ModBase
     Public Sub CopyFile(FromPath As String, ToPath As String)
         Try
             '还原文件路径
-            FromPath = ShortenPath(If(FromPath.Contains(":\"), FromPath, Path & FromPath))
-            ToPath = ShortenPath(If(ToPath.Contains(":\"), ToPath, Path & ToPath))
+            FromPath = If(FromPath.Contains(":\"), FromPath, Path & FromPath)
+            ToPath = If(ToPath.Contains(":\"), ToPath, Path & ToPath)
             '如果复制同一个文件则跳过
             If FromPath = ToPath Then Return
             '确保目录存在
@@ -861,7 +851,7 @@ Public Module ModBase
     ''' <param name="Append">是否将文件内容追加到当前文件，而不是覆盖它。</param>
     Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
         '处理相对路径
-        FilePath = ShortenPath(If(FilePath.Contains(":\"), FilePath, Path & FilePath))
+        FilePath = If(FilePath.Contains(":\"), FilePath, Path & FilePath)
         '确保目录存在
         Directory.CreateDirectory(GetPathFromFullPath(FilePath))
         '写入文件
@@ -886,7 +876,7 @@ Public Module ModBase
     ''' <param name="Append">是否将文件内容追加到当前文件，而不是覆盖它。</param>
     Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
         '处理相对路径
-        FilePath = ShortenPath(If(FilePath.Contains(":\"), FilePath, Path & FilePath))
+        FilePath = If(FilePath.Contains(":\"), FilePath, Path & FilePath)
         '确保目录存在
         Directory.CreateDirectory(GetPathFromFullPath(FilePath))
         '写入文件
@@ -1283,7 +1273,7 @@ Re:
                 Return Nothing
             Catch ex As Exception
                 Log(ex, "检查文件出错")
-                Return GetExceptionSummary(ex)
+                Return ex.GetBrief()
             End Try
         End Function
     End Class
@@ -1294,11 +1284,11 @@ Re:
     ''' </summary>
     Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing,
                            Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
-        Directory.CreateDirectory(ShortenPath(DestDirectory))
+        Directory.CreateDirectory(DestDirectory)
         If CompressFilePath.EndsWithF(".gz", True) Then
             '以 gz 方式解压
             Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
-            Dim decompressedFile As New FileStream(ShortenPath(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", "")), FileMode.OpenOrCreate, FileAccess.Write)
+            Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
             Dim data As Integer = stream.ReadByte()
             While data <> -1
                 decompressedFile.WriteByte(data)
@@ -1312,13 +1302,12 @@ Re:
                 Dim TotalCount As Long = Archive.Entries.Count
                 For Each Entry As ZipArchiveEntry In Archive.Entries
                     If ProgressIncrementHandler IsNot Nothing AndAlso TotalCount > 0 Then ProgressIncrementHandler(1 / TotalCount)
-                    Dim DestinationPath As String = ShortenPath(IO.Path.Combine(DestDirectory, Entry.FullName))
-                    If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
-                        Continue For '不创建空文件夹
-                    Else
-                        Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
-                        Entry.ExtractToFile(DestinationPath, True)
-                    End If
+                    Dim DestinationFullPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
+                    If Not IO.Path.GetFullPath(DestinationFullPath).StartsWithF(IO.Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复
+                    If DestinationFullPath.EndsWithF("\") OrElse DestinationFullPath.EndsWithF("/") Then Continue For '不创建空文件夹
+                    Dim DestinationDirectory As String = GetPathFromFullPath(DestinationFullPath)
+                    Directory.CreateDirectory(DestinationDirectory)
+                    Entry.ExtractToFile(DestinationFullPath.Replace(DestinationDirectory, ShortenPath(DestinationDirectory)), True) '#7329
                 Next
             End Using
         End If
@@ -1329,11 +1318,20 @@ Re:
     ''' </summary>
     Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
         If Not Directory.Exists(Path) Then Return 0
+        If Not Path.EndsWithF("\") Then Path &= "\"
+        If Path.EndsWith(":\") OrElse
+           Path = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\" OrElse
+           Path = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" OrElse
+           Path = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\" Then '#7030
+            Throw New UnauthorizedAccessException("这是重要的系统文件夹，无法删除：" & Path)
+        End If
+        '实际删除
         Dim DeletedCount As Integer = 0
         Dim Files As String()
         Try
             Files = Directory.GetFiles(Path)
         Catch ex As DirectoryNotFoundException '#4549
+            If Not Directory.Exists(Path) Then Return 0 '可能已被其他线程删除
             Log(ex, $"疑似为孤立符号链接，尝试直接删除（{Path}）", LogLevel.Developer)
             Directory.Delete(Path)
             Return 0
@@ -1364,6 +1362,7 @@ RetryFile:
 RetryDir:
         Try
             Directory.Delete(Path, True)
+        Catch ex As DirectoryNotFoundException
         Catch ex As Exception
             If Not RetriedDir AndAlso Not RunInUi() Then
                 RetriedDir = True
@@ -1397,21 +1396,24 @@ RetryDir:
     ''' 遍历文件夹中的所有文件。
     ''' </summary>
     Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
-        Dim Info As New DirectoryInfo(ShortenPath(Directory))
+        Dim Info As New DirectoryInfo(Directory)
         If Not Info.Exists Then Return New List(Of FileInfo)
         Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
     End Function
 
     ''' <summary>
     ''' 若路径长度大于指定值，则将长路径转换为短路径。
+    ''' 如果路径不存在，则返回原始路径。
     ''' </summary>
-    Public Function ShortenPath(LongPath As String, Optional ShortenThreshold As Integer = 247) As String
-        If LongPath.Length <= ShortenThreshold Then Return LongPath
+    Public Function ShortenPath(LongPath As String) As String
+        If LongPath.Length <= 200 OrElse LongPath.StartsWithF("http", True) Then Return LongPath
+        If Not Directory.Exists(LongPath) AndAlso Not File.Exists(LongPath) Then Return LongPath
         Dim ShortPath As New StringBuilder(260)
-        GetShortPathName(LongPath, ShortPath, 260)
-        Return ShortPath.ToString
+        GetShortPathName(LongPath.Replace("/", "\"), ShortPath, 260) '第一个参数也会在调用后被修改，使用 Replace 后不会影响原始字符串
+        ShortenPath = ShortPath.ToString
+        If String.IsNullOrEmpty(ShortenPath) Then Return LongPath
     End Function
-    Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As StringBuilder, ByVal cchBuffer As Integer) As Integer
+    Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (lpszLongPath As String, lpszShortPath As StringBuilder, cchBuffer As Integer) As Integer
 
 #End Region
 
@@ -1420,10 +1422,10 @@ RetryDir:
     Public vbRQ As Char = Convert.ToChar(8221)
 
     ''' <summary>
-    ''' 提取 Exception 的具体描述与堆栈。
+    ''' 提取 Exception 与 Inner Exception 的详细描述与堆栈信息。返回内容总是多于一行。
     ''' </summary>
     ''' <param name="ShowAllStacks">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
-    Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
+    <Extension> Public Function GetDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
         If Ex Is Nothing Then Return "无可用错误信息！"
 
         '获取最底层的异常
@@ -1450,17 +1452,17 @@ RetryDir:
         Loop
 
         '构造输出信息
-        Dim CommonReason As String = AnalyzeCommonReason(InnerEx, DescList)
-        If CommonReason Is Nothing Then
+        Dim UsualReason As String = AnalyzeUsualReason(InnerEx, Ex, DescList)
+        If UsualReason Is Nothing Then
             Return DescList.Join(vbCrLf)
         Else
-            Return CommonReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息：" & vbCrLf & DescList.Join(vbCrLf)
+            Return UsualReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息：" & vbCrLf & DescList.Join(vbCrLf)
         End If
     End Function
     ''' <summary>
-    ''' 提取 Exception 描述，汇总到一行。
+    ''' 提取 Exception 与 Inner Exception 的描述，汇总到一行。
     ''' </summary>
-    Public Function GetExceptionSummary(Ex As Exception) As String
+    <Extension> Public Function GetBrief(Ex As Exception) As String
         If Ex Is Nothing Then Return "无可用错误信息！"
 
         '获取最底层的异常
@@ -1479,28 +1481,27 @@ RetryDir:
         Dim Desc As String = Join(DescList, vbCrLf & "→ ")
 
         '构造输出信息
-        Dim CommonReason As String = AnalyzeCommonReason(InnerEx, DescList)
-        If CommonReason IsNot Nothing Then
-            Return CommonReason & "详细错误：" & DescList.First
+        Dim UsualReason As String = AnalyzeUsualReason(InnerEx, Ex, DescList)
+        If UsualReason IsNot Nothing Then
+            Return UsualReason & "详细错误：" & DescList.First
         Else
             DescList.Reverse() '让最深层错误在最左边
             Return Join(DescList, " ← ")
         End If
     End Function
-    Private Function AnalyzeCommonReason(InnerEx As Exception, DescList As List(Of String)) As String
+    Private Function AnalyzeUsualReason(InnerEx As Exception, OuterEx As Exception, DescList As List(Of String)) As String
         If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
             Return "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装，请先卸载较新版本的 .NET Framework，然后再尝试安装。"
         ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
-            Return "PCL 的权限不足。请尝试右键 PCL，选择以管理员身份运行。"
+            Return "PCL 的权限不足。请尝试右键 PCL 选择以管理员身份运行。"
         ElseIf TypeOf InnerEx Is OutOfMemoryException Then
             Return "你的电脑运行内存不足，导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
         ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
             Return "由于操作系统或显卡存在问题，导致出现错误。请尝试重启 PCL。"
         ElseIf TypeOf InnerEx Is SocketException AndAlso DescList.Any(Function(l) l.Contains("WSAStartup")) Then
             Return "请尝试卸载中国移动云盘，然后再试。"
-        ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
-                "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) DescList.Any(Function(l) l.Contains(s))) Then
-            Return "你的网络环境不佳，导致难以连接到服务器。请稍后重试，或使用 VPN 以改善网络环境。"
+        ElseIf OuterEx.IsNetworkRelated() Then
+            Return "你的网络环境不佳，请稍后再试，或使用 VPN 改善网络环境。"
         Else
             Return Nothing
         End If
@@ -1514,6 +1515,19 @@ RetryDir:
         Return [Enum].GetName(EnumData.GetType, EnumData)
     End Function
     ''' <summary>
+    ''' 将字符串转换为枚举类型，支持数字或原文两种格式，若为空字符串则返回 0。
+    ''' 若转换失败会抛出异常。
+    ''' </summary>
+    <Extension> Public Function ParseToEnum(Of T)(Str As String) As T
+        If String.IsNullOrEmpty(Str) Then
+            Return CType(0, Object)
+        ElseIf IsNumeric(Str) Then
+            Return CType(CInt(Str), Object)
+        Else
+            Return [Enum].Parse(GetType(T), Str, True)
+        End If
+    End Function
+    ''' <summary>
     ''' 将文件大小转化为适合的文本形式，如“1.28 M”。
     ''' </summary>
     ''' <param name="FileSize">以字节为单位的大小表示。</param>
@@ -1714,6 +1728,7 @@ RetryDir:
     ''' </summary>
     <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
     Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
+        If Str Is Nothing Then Return False
         Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
     End Function
     ''' <summary>
@@ -1721,6 +1736,7 @@ RetryDir:
     ''' </summary>
     <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
     Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
+        If Str Is Nothing Then Return False
         Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
     End Function
     ''' <summary>
@@ -1728,6 +1744,7 @@ RetryDir:
     ''' </summary>
     <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
     Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
+        If Str Is Nothing Then Return False
         Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
     End Function
     ''' <summary>
@@ -1764,6 +1781,7 @@ RetryDir:
     ''' 如果输入有误，返回 0。
     ''' </summary>
     Public Function Val(Str As Object) As Double
+        If Str Is Nothing Then Return 0
         Try
             Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
         Catch
@@ -2019,8 +2037,8 @@ RetryDir:
         '构造函数
         Public Sub New()
         End Sub
-        Public Sub New(data As IEnumerable(Of KeyValuePair(Of TKey, TValue)))
-            For Each DataItem In data
+        Public Sub New(Data As IEnumerable(Of KeyValuePair(Of TKey, TValue)))
+            For Each DataItem In Data
                 _Dictionary.Add(DataItem.Key, DataItem.Value)
             Next
         End Sub
@@ -2134,6 +2152,29 @@ RetryDir:
         Return result
     End Function
 
+    ''' <summary>
+    ''' 为 Task 设置超时，在超时时抛出 TimeoutException。
+    ''' </summary>
+    <Extension> Public Function GetResultWithTimeout(Of T)(TargetTask As Task(Of T), TokenSource As CancellationTokenSource, TimeoutMs As Integer) As T
+        Dim DelayTask = Task.Delay(TimeoutMs)
+        If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
+            TokenSource.Cancel()
+            Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
+        End If
+        Return TargetTask.GetAwaiter().GetResult()
+    End Function
+    ''' <summary>
+    ''' 为 Task 设置超时，在超时时抛出 TimeoutException。
+    ''' </summary>
+    <Extension> Public Sub GetResultWithTimeout(TargetTask As Task, TokenSource As CancellationTokenSource, TimeoutMs As Integer)
+        Dim DelayTask = Task.Delay(TimeoutMs)
+        If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
+            TokenSource.Cancel()
+            Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
+        End If
+        TargetTask.GetAwaiter().GetResult()
+    End Sub
+
     ''' <summary>
     ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
     ''' </summary>
@@ -2176,7 +2217,7 @@ RetryDir:
     ''' 返回程序的返回代码，如果运行失败将抛出异常。
     ''' </summary>
     Public Function RunAsAdmin(Argument As String) As Integer
-        Dim NewProcess = Process.Start(New ProcessStartInfo(PathWithName) With {.Verb = "runas", .Arguments = Argument})
+        Dim NewProcess = StartProcess(New ProcessStartInfo(PathWithName) With {.Verb = "runas", .Arguments = Argument})
         NewProcess.WaitForExit()
         Return NewProcess.ExitCode
     End Function
@@ -2335,46 +2376,21 @@ NextElement:
     End Class
 
     ''' <summary>
-    ''' 前台运行文件。
+    ''' 启动进程并返回进程实例，若失败则抛出异常。
+    ''' 会自动进行长路径处理。
     ''' </summary>
-    ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
-    ''' <param name="Arguments">运行参数。</param>
-    Public Sub ShellOnly(FileName As String, Optional Arguments As String = "")
-        Try
-            FileName = ShortenPath(FileName)
-            Using Program As New Process
-                Program.StartInfo.Arguments = Arguments
-                Program.StartInfo.FileName = FileName
-                Log("[System] 执行外部命令：" & FileName & " " & Arguments)
-                Program.Start()
-            End Using
-        Catch ex As Exception
-            Log(ex, "打开文件或程序失败：" & FileName, LogLevel.Msgbox)
-        End Try
-    End Sub
+    Public Function StartProcess(FileName As String, Optional Arguments As String = "") As Process
+        Return StartProcess(New ProcessStartInfo With {.FileName = FileName, .Arguments = Arguments})
+    End Function
     ''' <summary>
-    ''' 前台运行文件并返回返回值。
+    ''' 启动进程并返回进程实例，若失败则抛出异常。
+    ''' 会自动进行长路径处理。
     ''' </summary>
-    ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
-    ''' <param name="Arguments">运行参数。</param>
-    ''' <param name="Timeout">等待该程序结束的最长时间（毫秒）。超时会返回 Result.Timeout。</param>
-    Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000) As ProcessReturnValues
-        Try
-            Using Program As New Process
-                Program.StartInfo.Arguments = Arguments
-                Program.StartInfo.FileName = FileName
-                Log("[System] 执行外部命令并等待返回码：" & FileName & " " & Arguments)
-                Program.Start()
-                If Program.WaitForExit(Timeout) Then
-                    Return Program.ExitCode
-                Else
-                    Return ProcessReturnValues.Timeout
-                End If
-            End Using
-        Catch ex As Exception
-            Log(ex, "执行命令失败：" & FileName, LogLevel.Msgbox)
-            Return ProcessReturnValues.Fail
-        End Try
+    Public Function StartProcess(StartInfo As ProcessStartInfo) As Process
+        StartInfo.FileName = ShortenPath(StartInfo.FileName)
+        If Not String.IsNullOrEmpty(StartInfo.WorkingDirectory) Then StartInfo.WorkingDirectory = ShortenPath(StartInfo.WorkingDirectory)
+        Log("[System] 启动进程：" & StartInfo.FileName & " " & StartInfo.Arguments)
+        Return Process.Start(StartInfo)
     End Function
     ''' <summary>
     ''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
@@ -2382,15 +2398,18 @@ NextElement:
     ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
     ''' <param name="Arguments">运行参数。</param>
     ''' <param name="Timeout">等待该程序结束的最长时间（毫秒）。超时会抛出错误。</param>
-    Public Function ShellAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000, Optional WorkingDirectory As String = Nothing) As String
+    Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000,
+        Optional WorkingDirectory As String = Nothing, Optional Encoding As Encoding = Nothing, Optional PrintLog As Boolean = True) As String
         Dim Info = New ProcessStartInfo With {
             .Arguments = Arguments,
-            .FileName = FileName,
+            .FileName = ShortenPath(FileName),
             .UseShellExecute = False,
             .CreateNoWindow = True,
             .RedirectStandardError = True,
             .RedirectStandardOutput = True,
-            .WorkingDirectory = ShortenPath(If(WorkingDirectory, Path.TrimEnd("\"c)))
+            .WorkingDirectory = ShortenPath(If(WorkingDirectory, Path.TrimEnd("\"c))),
+            .StandardErrorEncoding = Encoding,
+            .StandardOutputEncoding = Encoding
         }
         If WorkingDirectory IsNot Nothing Then
             If Info.EnvironmentVariables.ContainsKey("appdata") Then
@@ -2399,8 +2418,8 @@ NextElement:
                 Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
             End If
         End If
-        Log("[System] 执行外部命令并等待返回结果：" & FileName & " " & Arguments)
-        Using Program As New Process() With {.StartInfo = Info}
+        If PrintLog Then Log("[System] 执行命令并等待返回结果：" & FileName & " " & Arguments)
+        Using Program As New Process With {.StartInfo = Info}
             Program.Start()
             Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
             Program.WaitForExit(Timeout)
@@ -2502,17 +2521,14 @@ NextElement:
     ''' <summary>
     ''' 尝试从字典中获取某项，如果该项不存在，则返回默认值。
     ''' </summary>
-    <Extension> Public Function GetOrDefault(Of TKey, TValue)(Dict As Dictionary(Of TKey, TValue), Key As TKey, Optional DefaultValue As TValue = Nothing) As TValue
-        If Dict.ContainsKey(Key) Then
-            Return Dict(Key)
-        Else
-            Return DefaultValue
-        End If
+    <Extension> Public Function GetOrDefault(Of TKey, TValue)(Dict As IDictionary(Of TKey, TValue), Key As TKey, Optional DefaultValue As TValue = Nothing) As TValue
+        Dim Result As TValue
+        Return If(Dict.TryGetValue(Key, Result), Result, DefaultValue)
     End Function
     ''' <summary>
     ''' 将某项添加到以列表作为值的字典中。
     ''' </summary>
-    <Extension> Public Sub AddToList(Of TKey, TValue)(Dict As Dictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue)
+    <Extension> Public Sub AddToList(Of TKey, TValue)(Dict As IDictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue)
         If Dict.ContainsKey(Key) Then
             Dict(Key).Add(Value)
         Else
@@ -2556,11 +2572,11 @@ NextElement:
     ''' </summary>
     Public Sub OpenWebsite(Url As String)
         Try
-            If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) Then
+            If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) AndAlso Not Url.StartsWithF("minecraft-preview://", True) Then
                 Throw New Exception(Url & " 不是一个有效的网址，它必须以 http 开头！")
             End If
             Log("[System] 正在打开网页：" & Url)
-            Process.Start(Url)
+            StartProcess(Url)
         Catch ex As Exception
             Log(ex, "无法打开网页（" & Url & "）")
             ClipboardSet(Url, False)
@@ -2574,12 +2590,12 @@ NextElement:
     ''' </summary>
     Public Sub OpenExplorer(Location As String)
         Try
-            Location = ShortenPath(Location.Replace("/", "\").Trim(" "c, """"c))
+            Location = Location.Replace("/", "\").Trim(" "c, """"c)
             Log("[System] 正在打开资源管理器：" & Location)
             If Location.EndsWith("\") Then
-                ShellOnly(Location)
+                StartProcess(Location)
             Else
-                ShellOnly("explorer", $"/select,""{Location}""")
+                StartProcess("explorer", $"/select,""{Location}""")
             End If
         Catch ex As Exception
             Log(ex, "打开资源管理器失败，请尝试关闭安全软件（如 360 安全卫士）", LogLevel.Msgbox)
@@ -2598,7 +2614,7 @@ Retry:
                 RunInUi(
                 Sub()
                     My.Computer.Clipboard.Clear()
-                    My.Computer.Clipboard.SetText(Text)
+                    If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
                 End Sub)
             Catch ex As Exception
                 RetryCount += 1
@@ -2609,9 +2625,24 @@ Retry:
                     Log(ex, "可能由于剪贴板被其他程序占用，文本复制失败", LogLevel.Hint)
                 End If
             End Try
-            If ShowSuccessHint Then Hint("已成功复制！", HintType.Finish)
+            If ShowSuccessHint Then Hint("已成功复制！", HintType.Green)
         End Sub)
     End Sub
+    ''' <summary>
+    ''' 获取剪贴板文本。将在 UI 线程运行，且不会抛出异常。
+    ''' </summary>
+    Public Function ClipboardGetText() As String
+        Dim Result As String = Nothing
+        RunInUiWait(
+        Sub()
+            Try
+                If My.Computer.Clipboard.ContainsText() Then Result = My.Computer.Clipboard.GetText()
+            Catch ex As Exception
+                Log(ex, "获取剪贴板文本失败")
+            End Try
+        End Sub)
+        Return Result
+    End Function
 
     ''' <summary>
     ''' 以 Byte() 形式获取程序中的资源。
@@ -2746,6 +2777,11 @@ Retry:
     ''' 将 XML 转换为对应 UI 对象。
     ''' </summary>
     Public Function GetObjectFromXML(Str As String) As Object
+        Str = Str. '兼容旧版自定义事件写法
+            Replace("EventType=""", "local:CustomEventService.EventType=""").
+            Replace("EventData=""", "local:CustomEventService.EventData=""").
+            Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType""").
+            Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""")
         Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
             '类型检查
             Using Reader As New XamlXmlReader(Stream)
@@ -2861,7 +2897,7 @@ Retry:
                 File.Create(Path & "PCL\Log1.txt").Dispose()
             Catch ex As IOException
                 IsInitSuccess = False
-                Hint("可能同时开启了多个 PCL，程序可能会出现未知问题！", HintType.Critical)
+                Hint("可能同时开启了多个 PCL，程序可能会出现未知问题！", HintType.Red)
                 Log(ex, "日志初始化失败（疑似文件占用问题）")
             Catch ex As Exception
                 IsInitSuccess = False
@@ -2914,6 +2950,7 @@ Retry:
 
         '输出日志
         Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Text}{vbCrLf}" '减轻同步锁占用
+        AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
         If ModeDebug Then
             SyncLock LogListLock
                 LogList.Append(AppendText)
@@ -2933,16 +2970,16 @@ Retry:
         Select Case Level
 #If DEBUG Then
             Case LogLevel.Developer
-                Hint("[开发者模式] " & Text, HintType.Info, False)
+                Hint("[开发者模式] " & Text, HintType.Blue, False)
             Case LogLevel.Debug
-                Hint("[调试模式] " & Text, HintType.Info, False)
+                Hint("[调试模式] " & Text, HintType.Blue, False)
 #Else
             Case LogLevel.Developer
             Case LogLevel.Debug
-                If ModeDebug Then Hint("[调试模式] " & Text, HintType.Info, False)
+                If ModeDebug Then Hint("[调试模式] " & Text, HintType.Blue, False)
 #End If
             Case LogLevel.Hint
-                Hint(Text, HintType.Critical, False)
+                Hint(Text, HintType.Red, False)
             Case LogLevel.Msgbox
                 MyMsgBox(Text, Title, IsWarn:=True)
             Case LogLevel.Feedback
@@ -2981,10 +3018,11 @@ Retry:
         If TypeOf Ex Is ThreadInterruptedException Then Return
 
         '获取错误信息
-        Dim ExFull As String = Desc & "：" & GetExceptionDetail(Ex)
+        Dim ExFull As String = $"{Desc}：{Ex.GetDetail()}"
 
         '输出日志
-        Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}：{GetExceptionDetail(Ex, True)}{vbCrLf}" '减轻同步锁占用
+        Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}：{Ex.GetDetail(True)}{vbCrLf}" '减轻同步锁占用
+        AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
         If ModeDebug Then
             SyncLock LogListLock
                 LogList.Append(AppendText)
@@ -3002,20 +3040,20 @@ Retry:
             Case LogLevel.Normal
 #If DEBUG Then
             Case LogLevel.Developer
-                Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
-                Hint("[开发者模式] " & ExLine, HintType.Info, False)
+                Dim ExLine As String = Desc & "：" & Ex.GetBrief()
+                Hint("[开发者模式] " & ExLine, HintType.Blue, False)
             Case LogLevel.Debug
-                Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
-                Hint("[调试模式] " & ExLine, HintType.Info, False)
+                Dim ExLine As String = Desc & "：" & Ex.GetBrief()
+                Hint("[调试模式] " & ExLine, HintType.Blue, False)
 #Else
             Case LogLevel.Developer
             Case LogLevel.Debug
-                Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
-                If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False)
+                Dim ExLine As String = Desc & "：" & Ex.GetBrief()
+                If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Blue, False)
 #End If
             Case LogLevel.Hint
-                Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
-                Hint(ExLine, HintType.Critical, False)
+                Dim ExLine As String = Desc & "：" & Ex.GetBrief()
+                Hint(ExLine, HintType.Red, False)
             Case LogLevel.Msgbox
                 MyMsgBox(ExFull, Title, IsWarn:=True)
             Case LogLevel.Feedback
@@ -3084,6 +3122,7 @@ Retry:
     Public Sub Telemetry([Event] As String, ParamArray Datas As String())
         If Not Setup.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
         If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
+        If VersionBranchName = "Debug" Then Return '开发版本不上传遥测
         RunInNewThread(
         Sub()
             Try
@@ -3093,8 +3132,8 @@ Retry:
                     Url &= "&" & WebUtility.UrlEncode(Datas(i)) & "=" & WebUtility.UrlEncode(Datas(i + 1).Replace(vbCrLf, vbLf))
                 Next
                 NetRequestByClient(Url, MakeLog:=False)
-            Catch
-                Log("[System] 匿名数据上报失败", LogLevel.Debug)
+            Catch ex As Exception
+                Log(ex, "匿名数据上报失败")
             End Try
         End Sub, "Telemetry", ThreadPriority.Lowest)
     End Sub
@@ -3121,7 +3160,7 @@ Retry:
     End Function
 
     ''' <summary>
-    ''' 取随机整数。
+    ''' 取随机整数（包含）。
     ''' </summary>
     Public Function RandomInteger(min As Integer, max As Integer) As Integer
         Return Math.Floor((max - min + 1) * Random.NextDouble) + min
@@ -3130,12 +3169,12 @@ Retry:
     ''' <summary>
     ''' 将数组随机打乱。
     ''' </summary>
-    Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T)
-        Shuffle = New List(Of T)
-        Do While array.Any
-            Dim i As Integer = RandomInteger(0, array.Count - 1)
-            Shuffle.Add(array(i))
-            array.RemoveAt(i)
+    <Extension> Public Iterator Function Shuffle(Of T)(Raw As IEnumerable(Of T)) As IEnumerable(Of T)
+        Dim RawCopy As New List(Of T)(Raw)
+        Do While RawCopy.Any
+            Dim i As Integer = RandomInteger(0, RawCopy.Count - 1)
+            Yield RawCopy(i)
+            RawCopy.RemoveAt(i)
         Loop
     End Function
 

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

@@ -8,6 +8,7 @@
         Implements ILoadingTrigger
 
         Public ReadOnly Property IsLoader As Boolean = True Implements ILoadingTrigger.IsLoader
+        Protected Shared LogBlackList As String() = {"EasyTier CLI"}
 
         '基础属性
         ''' <summary>
@@ -89,7 +90,7 @@
                 Dim OldState = _State
                 If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
                 _State = value
-                Log("[Loader] 加载器 " & Name & " 状态改变：" & GetStringFromEnum(value))
+                If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变：{GetStringFromEnum(value)}")
                 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
                 RunInUi(
                 Sub()
@@ -170,6 +171,7 @@
         '状态变化
         Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
         Public MustOverride Sub Abort()
+        Public MustOverride Sub Failed(Ex As Exception)
 
         '等待结束
         Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
@@ -290,11 +292,13 @@
             '检验输入以确定情况
             If IsForceRestart Then Return True '强制要求重启
             If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
-            If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束
-               (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
-                Return False '则不重试
+
+            If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
+               (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
+               LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
+                Return False '…则不重试
             Else
-                Return True '需要开始
+                Return True '否则需要重启
             End If
         End Function
         Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
@@ -315,13 +319,13 @@
             Sub()
                 Try
                     IsForceRestarting = IsForceRestart
-                    If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
+                    If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
                     LoadDelegate(Me)
                     If IsAborted Then
                         Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）", LogLevel.Developer)
                         Return
                     End If
-                    If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
+                    If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
                     RaisePreviewFinish()
                     State = LoadState.Finished
                     LastFinishedTime = GetTimeTick() '未中断，本次输出有效
@@ -334,25 +338,38 @@
                     '如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Aborted
                     If Not IsAborted Then State = LoadState.Aborted
                 Catch ex As Exception
-                    If IsAborted Then Return
-                    Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
-                    [Error] = ex
-                    State = LoadState.Failed
+                    Failed(ex)
                 End Try
             End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
-            LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsAborted
+            Try
+                LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsAborted
+            Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”，则等待后重试
+                Thread.Sleep(500)
+                LastRunningThread.Start()
+            End Try
+        End Sub
+        Public Overrides Sub Failed(ex As Exception)
+            [Error] = ex
+            SyncLock LockState
+                If IsAborted OrElse State >= LoadState.Finished Then Return
+                State = LoadState.Failed
+            End SyncLock
+            Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
+            TriggerThreadAbort()
         End Sub
         Public Overrides Sub Abort()
-            If State <> LoadState.Loading Then Return
             SyncLock LockState
+                If State <> LoadState.Loading Then Return
                 State = LoadState.Aborted
             End SyncLock
             TriggerThreadAbort()
         End Sub
         Private Sub TriggerThreadAbort()
             If LastRunningThread Is Nothing Then Return
-            If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
-            If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
+            If LastRunningThread.IsAlive Then
+                LastRunningThread.Interrupt()
+                If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
+            End If
             LastRunningThread = Nothing
         End Sub
 
@@ -451,6 +468,17 @@
                 Next
             End Sub)
         End Sub
+        Public Overrides Sub Failed(Ex As Exception)
+            [Error] = Ex '先设置错误再调整状态，防止父加载器获取不到异常
+            SyncLock LockState
+                If State >= LoadState.Finished Then Return
+                State = LoadState.Failed
+            End SyncLock
+            For Each Loader In Loaders
+                Loader.Abort()
+            Next
+            FrmMain.BtnExtraDownload.ShowRefresh()
+        End Sub
 
         ''' <summary>
         ''' 子任务状态变更。
@@ -468,18 +496,9 @@
                 Case LoadState.Aborted
                     '被中断，这个任务也中断
                     Abort()
-                Case Else
+                Case LoadState.Failed
                     '完蛋，出错了
-                    SyncLock LockState
-                        If State >= LoadState.Finished Then Return
-                        [Error] = New Exception(Loader.Name & "失败", Loader.Error)
-                        State = Loader.State
-                    End SyncLock
-                    For Each Loader In Loaders
-                        Loader.Abort()
-                    Next
-                    FrmMain.BtnExtraDownload.ShowRefresh()
-                    Return
+                    Failed(New Exception(Loader.Name & "失败", Loader.Error))
             End Select
         End Sub
         ''' <summary>

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

@@ -1,6 +1,7 @@
 Imports System.Net.Http.Headers
+Imports System.Net.Sockets
+Imports System.Runtime.CompilerServices
 Imports System.Threading.Tasks
-Imports CacheCow.Client
 
 Public Module ModNet
 
@@ -11,15 +12,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 +48,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 +57,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
@@ -59,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
@@ -78,8 +97,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 +107,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 +146,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 +173,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 +184,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 +194,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,74 +220,164 @@ 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)
+            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).GetResultWithTimeout(CancelToken, Timeout)
             Dim ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
             Dim ResponseBytes As Byte()
             Using Stream As New MemoryStream
-                ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetAwaiter().GetResult()
+                ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
                 ResponseBytes = Stream.ToArray()
             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}" &
-                    If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), ResponseMessage)
+                    $"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" &
+                    If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, 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 Exception
-            Throw New Exception($"网络请求出现意外异常（{Method}, {Url}）", ex)
+            RecordIPReliability(HostIp, -1)
+            If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时
+                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
         Finally
             Request?.Dispose()
             CancelToken?.Dispose()
             Response?.Dispose()
         End Try
     End Function
+    Private RequestClient As HttpClient = Nothing
+    Private RequestClientLock As New Object
 
+    ''' <summary>
+    ''' 进行 DNS 解析。它仅在选择的 IP 与系统默认的不一致时才对 URL 中的 Host 进行替换。
+    ''' 返回请求时应使用的 IP；若为 IPv6，则加上了方括号。
+    ''' 若解析失败，则返回 Nothing。
+    ''' </summary>
+    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
+            Log(ex, $"DNS 解析失败（{Host}）")
+            Return Nothing
+        End Try
+        Dim Candidates As IPAddress() = DnsTask.Result.ToArray
+        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
+        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
+        Return TargetIp
+    End Function
+    ''' <summary>
+    ''' 记录每个 IP 地址的请求可靠度。
+    ''' 通常取值 -1 ~ +0.5，越高越好。未尝试过的 IP 应视为 0。
+    ''' </summary>
+    Private IPReliability As New SafeDictionary(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>
+    ''' 当 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
@@ -277,6 +386,10 @@ RequestFinished:
 
 #Region "多线程下载引擎"
 
+    Private ThreadClient As New HttpClient(New HttpClientHandler With {
+        .AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None
+    })
+
     ''' <summary>
     ''' 最大线程数。
     ''' </summary>
@@ -581,12 +694,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
@@ -646,9 +759,9 @@ RequestFinished:
         ''' </summary>
         Public Check As FileChecker
         ''' <summary>
-        ''' 下载时是否添加浏览器 UA。
+        ''' 是否模拟浏览器的 UserAgent 和 Referer。
         ''' </summary>
-        Public UseBrowserUserAgent As Boolean
+        Public SimulateBrowserHeaders As Boolean
 
         ''' <summary>
         ''' 上次记速时的时间。
@@ -746,7 +859,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 +870,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 +881,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 +902,8 @@ StartSingleThreadDownload:
                         Reset()
                         State = NetState.Get
                     End If
+                End SyncLock
+                SyncLock LockChain
                     '首个开始点
                     If Threads Is Nothing Then
                         StartPosition = 0
@@ -805,7 +920,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 +967,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 +976,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 = 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)
@@ -867,145 +986,135 @@ 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).GetResultWithTimeout(CancelToken, Timeout)
+                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 < 0 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 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持")
+                            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 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
+                    End SyncLock
+                    Throw New RangeNotSupportedException($"该下载源不支持分段下载：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
+                ElseIf Not FileSize - Th.DownloadStart = ContentLength Then
+                    Throw New RangeNotSupportedException($"获取到的分段大小不一致：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
+                    Directory.CreateDirectory(PathTemp & "Download")
+                    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).GetResultWithTimeout(CancelToken, Timeout)
+                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.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
+                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 +1127,25 @@ 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 OrElse TypeOf ex Is TimeoutException,
+                    $"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{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
@@ -1043,10 +1161,11 @@ SourceBreak:
             Th.State = NetState.Error
             Th.Source.Ex = ex
             '根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
-            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，所以不应因此禁用下载源
+            Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)")
+            If IsMergeFailure OrElse IsRangeNotSupported OrElse
+               ex.Message.Contains("(502)") OrElse ex.Message.Contains("(404)") OrElse
+               ex.Message.Contains("未能解析") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
+               ((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
@@ -1058,9 +1177,9 @@ SourceBreak:
                 End SyncLock
                 '……后续处理
                 If IsThisFail Then
-                    Log($"[Download] {LocalName}：下载源被禁用（{Th.Source.Id}）：{Th.Source.Url}")
+                    Log($"[Download] {LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}")
                     Log(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用",
-                        If(ex.Message.Contains("不支持分段下载") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
+                        If(IsRangeNotSupported OrElse ex.Message.Contains("(404)"), LogLevel.Developer, LogLevel.Debug))
                     SyncLock LockSource
                         SourcesOnce.Remove(Th.Source)
                     End SyncLock
@@ -1069,9 +1188,10 @@ SourceBreak:
                         Fail(ex)
                     ElseIf HasAvailableSource() AndAlso Not IsMergeFailure Then
                         '当前源失败，但还有下载源：正常地继续执行
-                    ElseIf Not Retried AndAlso Sources.Count > 1 Then
+                    ElseIf Not Retried Then
                         '合并失败或首次下载失败，未重试：将所有下载源重新标记为不允许断点续传的下载源，逐个重新尝试下载
-                        Hint($"{LocalName}：文件下载失败，正在自动重试……", If(ModeDebug, HintType.Critical, HintType.Info)) '在调试模式下给出红色提示
+                        '若所有源均不支持 Range，也会走到这里重试
+                        If Not IsRangeNotSupported Then Log($"[Download] {LocalName}：文件下载失败，正在自动重试……", LogLevel.Debug)
                         Retried = True
                         SyncLock LockSource
                             SourcesOnce.Clear()
@@ -1140,10 +1260,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
                         '仅有一个线程，从缓存中输出
@@ -1266,6 +1386,12 @@ Retry:
         End Sub
 
     End Class
+    Private Class RangeNotSupportedException
+        Inherits WebException
+        Public Sub New(Message As String)
+            MyBase.New(Message)
+        End Sub
+    End Class
     ''' <summary>
     ''' 下载一系列文件的加载器。
     ''' </summary>
@@ -1386,13 +1512,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)
@@ -1517,20 +1643,23 @@ Retry:
             Next
             OnFail(File.Ex)
         End Sub
+        Public Overrides Sub Failed(Ex As Exception)
+            OnFail(New List(Of Exception) From {Ex})
+        End Sub
         Public Sub OnFail(ExList As List(Of Exception))
             SyncLock LockState
-                If State > LoadState.Loading Then Return
+                If State >= LoadState.Finished 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 TimeoutException 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)
+                    If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
+                    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])
+                                            "各下载源的错误如下：" & vbCrLf & Detail, [Error])
                     '上报
                     Telemetry("文件下载失败",
                               "FileName", File.LocalName,
@@ -1547,7 +1676,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 +1826,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 +1846,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
@@ -1751,7 +1880,7 @@ 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>
         ''' 开始一个下载任务。
@@ -1759,15 +1888,18 @@ Retry:
         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
+                End If
                 IsDownloadCacheCleared = True
-            End If
-            Directory.CreateDirectory(PathTemp & "Download")
+            End SyncLock
             '文件处理
             SyncLock LockFiles
                 '添加每个文件
@@ -1820,6 +1952,45 @@ Retry:
         Return False
     End Function
 
+#End Region
+
+#Region "端口"
+
+    ''' <summary>
+    ''' 随机获取单个可用的端口。
+    ''' </summary>
+    Public Function FindFreePort() As Integer
+        Dim Listener As New TcpListener(IPAddress.Loopback, 0)
+        Listener.Start()
+        Dim port As Integer = CType(Listener.LocalEndpoint, IPEndPoint).Port
+        Listener.Stop()
+        Return port
+    End Function
+
+    ''' <summary>
+    ''' 获取当前已被占用的端口列表。
+    ''' </summary>
+    Public Function GetUsedPorts() As List(Of Integer)
+        Dim IPProperties = NetworkInformation.IPGlobalProperties.GetIPGlobalProperties()
+        Dim UsedPorts As New List(Of Integer)
+        UsedPorts.AddRange(IPProperties.GetActiveTcpListeners().Select(Function(ep) ep.Port))
+        UsedPorts.AddRange(IPProperties.GetActiveUdpListeners().Select(Function(ep) ep.Port))
+        UsedPorts.AddRange(IPProperties.GetActiveTcpConnections().Select(Function(conn) conn.LocalEndPoint.Port))
+        Return UsedPorts.Distinct().ToList()
+    End Function
+
+    ''' <summary>
+    ''' 寻找数个连续编号的可用端口。
+    ''' </summary>
+    Public Function FindFreePorts(ConsecutiveCount As Integer, ParamArray ExtraBlackLists As Integer()) As List(Of Integer)
+        Dim UsedPorts = GetUsedPorts().Concat(ExtraBlackLists)
+        For port = 12000 + RandomInteger(0, 1000) To 65000 - ConsecutiveCount
+            Dim Range = Enumerable.Range(port, ConsecutiveCount)
+            If Not Range.Any(Function(p) UsedPorts.Contains(p)) Then Return Range.ToList
+        Next
+        Throw New Exception("未能找到可用的端口！")
+    End Function
+
 #End Region
 
     ''' <summary>
@@ -1842,4 +2013,16 @@ Retry:
         End If
     End Function
 
+    ''' <summary>
+    ''' 判断某个 Exception 是否为网络问题所导致。
+    ''' </summary>
+    <Extension> Public Function IsNetworkRelated(Ex As Exception) As Boolean
+        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

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

@@ -113,11 +113,11 @@ Public Class ValidateInteger
         Me.Max = Max
     End Sub
     Public Overrides Function Validate(Str As String) As String
+        Dim Valed As Integer
+        If Not Integer.TryParse(Str, Valed) Then Return "请输入一个整数！"
         If Str.Length > 9 Then Return "请输入一个大小合理的数字！"
-        Dim Valed As Integer = Val(Str)
-        If Valed.ToString <> Str Then Return "请输入一个整数！"
-        If Val(Str) > Max Then Return "不可超过 " & Max & "！"
-        If Val(Str) < Min Then Return "不可低于 " & Min & "！"
+        If Valed > Max Then Return "不可超过 " & Max & "！"
+        If Valed < Min Then Return "不可低于 " & Min & "！"
         Return ""
     End Function
 End Class
@@ -148,7 +148,7 @@ End Class
 ''' </summary>
 Public Class ValidateExcept
     Inherits Validate
-    Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
+    Public Property Excepts As New ObjectModel.Collection(Of String)
     Public Property ErrorMessage As String
     Public Sub New()
         ErrorMessage = "输入内容不能包含 %"
@@ -157,12 +157,15 @@ Public Class ValidateExcept
         Me.Excepts = Excepts
         Me.ErrorMessage = ErrorMessage
     End Sub
-    Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %")
-        Me.Excepts = New ObjectModel.Collection(Of String)
-        Me.ErrorMessage = ErrorMessage
-        For Each Data As String In Excepts
-            Me.Excepts.Add(Data)
-        Next
+    Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
+        Me.New(
+            New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
+            ErrorMessage)
+    End Sub
+    Public Sub New(Excepts As IEnumerable(Of Char), Optional ErrorMessage As String = "输入内容不能包含 %")
+        Me.New(
+            New ObjectModel.Collection(Of String)(Excepts.Select(Function(c) c.ToString).ToList),
+            ErrorMessage)
     End Sub
     Public Overrides Function Validate(Str As String) As String
         For Each Ch As String In Excepts
@@ -181,7 +184,7 @@ End Class
 ''' </summary>
 Public Class ValidateExceptSame
     Inherits Validate
-    Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
+    Public Property Excepts As New ObjectModel.Collection(Of String)
     Public Property ErrorMessage As String
     Public Property IgnoreCase As Boolean = False
     Public Sub New()
@@ -191,13 +194,15 @@ Public Class ValidateExceptSame
         Me.ErrorMessage = ErrorMessage
         Me.IgnoreCase = IgnoreCase
     End Sub
-    Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
-        Me.Excepts = New ObjectModel.Collection(Of String)
-        For Each Data As String In Excepts
-            Me.Excepts.Add(Data)
-        Next
-        Me.ErrorMessage = ErrorMessage
-        Me.IgnoreCase = IgnoreCase
+    Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
+        Me.New(
+            New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
+            ErrorMessage, IgnoreCase)
+    End Sub
+    Public Sub New(Except As String, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
+        Me.New(
+            New ObjectModel.Collection(Of String) From {Except},
+            ErrorMessage, IgnoreCase)
     End Sub
     Public Overrides Function Validate(Str As String) As String
         If Str Is Nothing Then Return ErrorMessage.Replace("%", "null")

Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb

@@ -347,7 +347,7 @@
                             Case 4475 : Tags.Add("冒险")
                             Case 4476 : Tags.Add("探索")
                             Case 4477 : Tags.Add("小游戏")
-                            Case 4471 : Tags.Add("科幻")
+                            Case 4474 : Tags.Add("科幻")
                             Case 4736 : Tags.Add("空岛")
                             Case 5128 : Tags.Add("原版改良")
                             Case 4487 : Tags.Add("FTB")
@@ -1161,9 +1161,9 @@ Retry:
             ElseIf [Error] IsNot Nothing Then
                 '有结果但是有错误
                 If CurseForgeFailed Then
-                    Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，搜索结果可能不全。{vbCrLf}请稍后重试，或使用 VPN 以改善网络环境。"
+                    Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
                 Else
-                    Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，搜索结果可能不全。{vbCrLf}请稍后重试，或使用 VPN 以改善网络环境。"
+                    Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
                 End If
             End If
 
@@ -1211,11 +1211,11 @@ Retry:
         Function(Project As CompProject) As Double
             Select Case Request.Type
                 Case CompType.Mod, CompType.ModPack
-                    Return If(Project.FromCurseForge, 1, 7)
+                    Return If(Project.FromCurseForge, 1, 5)
                 Case CompType.DataPack
                     Return If(Project.FromCurseForge, 10, 1)
                 Case CompType.ResourcePack, CompType.Shader
-                    Return If(Project.FromCurseForge, 1, 5)
+                    Return If(Project.FromCurseForge, 1, 4)
                 Case Else
                     Return 1
             End Select
@@ -1354,7 +1354,7 @@ Retry:
         ''' </summary>
         ''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
         Public Function ToNetFile(LocalAddress As String) As NetFile
-            Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
+            Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), SimulateBrowserHeaders:=True)
         End Function
 
         '实例化
@@ -1395,10 +1395,9 @@ Retry:
                     If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
                     'DownloadAddress
                     Dim Url = Data("downloadUrl").ToString
-                    If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
-                    Url = Url.Replace(FileName, WebUtility.UrlEncode(FileName)) '对文件名进行编码
-                    DownloadUrls = HandleCurseForgeDownloadUrls(Url) '对脑残 CurseForge 的下载地址进行多种修正
-                    DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源，这个写法是为了让镜像源排在后面
+                    If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
+                    DownloadUrls = HandleCurseForgeDownloadUrls(Url.Replace(FileName, WebUtility.UrlEncode(FileName))) '对脑残 CurseForge 的下载地址进行多种修正
+                    DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源；注意 MCIM 源不支持 URL 编码后的文件名，必须传入 URL 编码前的文件名
                     DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
                     'Dependencies
                     If Data.ContainsKey("dependencies") Then

Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb

@@ -341,6 +341,7 @@ Extracted:
     ''' 导致崩溃的原因枚举。
     ''' </summary>
     Private Enum CrashReason
+        Java虚拟机参数有误
         Mod文件被解压
         MixinBootstrap缺失
         内存不足
@@ -484,10 +485,12 @@ Done:
         '崩溃报告分析，高优先级
         If LogCrash IsNot Nothing Then
             If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
+            If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071
         End If
 
         '游戏日志分析
         If LogMc IsNot Nothing Then
+            If LogMc.Contains("Unrecognized option:") Then AppendReason(CrashReason.Java虚拟机参数有误)
             If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge)
             If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL)
             If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
@@ -516,7 +519,7 @@ Done:
             If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
             If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
             If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
-            If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug)
+            If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") AndAlso Not CrashReasons.ContainsKey(CrashReason.Mod配置文件导致游戏崩溃) Then AppendReason(CrashReason.NightConfig的Bug)
             If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
             If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整)
             If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
@@ -539,8 +542,8 @@ Done:
             If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
             If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
             If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
-            If LogMc.Contains("Incompatible mods found!") Then '#5006
-                AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), ""))
+            If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115
+                AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息：").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray))
             End If
             If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
                 AppendReason(CrashReason.Mod缺少前置或MC版本错误,
@@ -656,7 +659,7 @@ Done:
             End If
             'Mod 解析错误（常见于 Fabric 前置校验失败）
             If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
-            'Mixin 失败可以导致大量 Mod 实例创建失败
+            'Mixin 失败可以导致大量 Mod 实例创建失败，因此需要放到低优先级中
             If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
             '注意：Fabric 的 Warnings were found! 不一定是崩溃原因，它可能是单纯的警报
         End If
@@ -715,7 +718,7 @@ NextStack:
                     "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
                     "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
                     "injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
-                    "transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill"
+                    "transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
                    }.Contains(Word.ToLower) Then Continue For
                 PossibleWords.Add(Word.Trim)
             Next
@@ -868,11 +871,11 @@ NextStack:
             Sub()
                 '弹窗选择：查看日志
                 If File.Exists(DirectFile.Value.Key) Then
-                    ShellOnly(DirectFile.Value.Key)
+                    StartProcess(DirectFile.Value.Key)
                 Else
                     Dim FilePath As String = PathTemp & "Crash.txt"
                     WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
-                    ShellOnly(FilePath)
+                    StartProcess(FilePath)
                 End If
             End Sub))
             Case 3
@@ -905,8 +908,7 @@ NextStack:
                         If File.Exists(OutputFile) Then
                             If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
                             Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
-                            FileContent = FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*"))
-                            FileContent = FilterUserName(FileContent, "*")
+                            FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
                             WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
                             Log($"[Crash] 导出文件：{FileName}，编码：{FileEncoding.HeaderName}")
                         End If
@@ -914,7 +916,7 @@ NextStack:
                     '导出报告
                     Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
                     DeleteDirectory(TempFolder & "Report\")
-                    Hint("错误报告已导出！", HintType.Finish)
+                    Hint("错误报告已导出！", HintType.Green)
                 Catch ex As Exception
                     Log(ex, "导出错误报告失败", LogLevel.Feedback)
                     Return
@@ -946,6 +948,8 @@ NextStack:
         For Each Reason In CrashReasons
             Dim Additional As List(Of String) = Reason.Value
             Select Case Reason.Key
+                Case CrashReason.Java虚拟机参数有误
+                    Results.Add("由于 Java 参数有误，导致游戏无法继续运行。\n请检查高级选项中的 Java 虚拟机参数和游戏参数设置是否有误。")
                 Case CrashReason.Mod文件被解压
                     Results.Add("由于 Mod 文件被解压了，导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可，若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod，然后再启动游戏。")
                 Case CrashReason.内存不足
@@ -1026,9 +1030,17 @@ NextStack:
                     End If
                 Case CrashReason.特定实体导致崩溃
                     If Additional.Count = 1 Then
-                        Results.Add("游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界，并生成一个该实体，然后观察游戏的运行情况。\h")
+                        If Additional.First.Contains("minecraft:player") Then
+                            If Additional.First.Contains(" ") Then
+                                Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
+                            Else
+                                Results.Add($"游戏因为玩家实体导致了崩溃。\h")
+                            End If
+                        Else
+                            Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
+                        End If
                     Else
-                        Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界，并生成各种实体，然后观察游戏的运行情况。\h")
+                        Results.Add($"游戏因为下列实体导致了崩溃：{Additional.Join("、")}\h")
                     End If
                 Case CrashReason.OptiFine与Forge不兼容
                     Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容，导致了游戏崩溃。\n\n请前往 OptiFine 官网（https://optifine.net/downloads）查看 OptiFine 所兼容的 Forge 版本，并严格按照对应版本重新安装游戏。")

Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb

@@ -73,8 +73,10 @@
             Sub(Task As LoaderTask(Of String, List(Of NetFile)))
                 Try
                     Dim IndexFile = DlClientAssetIndexGet(Version)
-                    Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
-                    If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
+                    If IndexFile Is Nothing Then
+                        Task.Output = New List(Of NetFile)
+                        Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
+                    ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
                         Task.Output = New List(Of NetFile)
                     Else
                         Task.Output = New List(Of NetFile) From {IndexFile}
@@ -93,6 +95,11 @@
                 LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
                 Sub(Task As LoaderTask(Of String, List(Of NetFile)))
                     Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
+                    If BackAssetsFile Is Nothing Then
+                        Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
+                        Task.Abort()
+                        Throw New ThreadInterruptedException
+                    End If
                     RealAddress = BackAssetsFile.LocalPath
                     TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
                     BackAssetsFile.LocalPath = TempAddress
@@ -198,7 +205,7 @@
     Private IsNewClientVersionHinted As Boolean = False
     Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
         Dim StartTime As Long = GetTimeTick()
-        Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json"))
+        Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
         Try
             Dim Versions As JArray = Json("versions")
             If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
@@ -235,7 +242,7 @@
     ''' </summary>
     Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
     Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
-        Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json"))
+        Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
         Try
             Dim Versions As JArray = Json("versions")
             If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
@@ -413,7 +420,7 @@
     ''' </summary>
     Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
     Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
-        Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList"))
+        Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
         Try
             Dim Versions As New List(Of DlOptiFineListEntry)
             For Each Token As JObject In Json
@@ -483,7 +490,7 @@
     ''' </summary>
     Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
     Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
-        Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", UseBrowserUserAgent:=True)
+        Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
         If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
         '获取所有版本信息
         Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
@@ -631,9 +638,9 @@
         Try
             Result = NetRequestByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
                                           Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057
-                                          ".html", UseBrowserUserAgent:=True)
+                                          ".html", SimulateBrowserHeaders:=True)
         Catch ex As Exception
-            If GetExceptionSummary(ex).Contains("(404)") Then
+            If ex.GetBrief().Contains("(404)") Then
                 Throw New Exception("不可用")
             Else
                 Throw
@@ -701,7 +708,7 @@
     ''' </summary>
     Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
         Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
-                                                      Loader.Input.Replace("-", "_"))) '兼容 Forge 1.7.10-pre4，#4057
+                                                      Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
         Dim Versions As New List(Of DlForgeVersionEntry)
         Try
             Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -839,8 +846,8 @@
     Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
     Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
         '获取版本列表 JSON
-        Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge")
-        Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge")
+        Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", RequireJson:=True)
+        Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", RequireJson:=True)
         If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足（" & ResultLatest & "）")
         '解析
         Try
@@ -857,8 +864,8 @@
     Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
     Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
         '获取版本列表 JSON
-        Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge")
-        Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge")
+        Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", RequireJson:=True)
+        Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", RequireJson:=True)
         If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足（" & ResultLatest & "）")
         '解析
         Try
@@ -963,7 +970,7 @@
     ''' </summary>
     Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
     Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
-        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json"))
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
         Try
             Dim Json As JObject = Result("versions")
             Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -991,7 +998,7 @@
     ''' </summary>
     Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
     Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
-        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json"))
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
         Try
             Dim Json As JObject = Result("versions")
             Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1062,7 +1069,7 @@
     ''' </summary>
     Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
     Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
-        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions"))
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
         Try
             Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
             If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1077,7 +1084,7 @@
     ''' </summary>
     Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
     Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
-        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions"))
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
         Try
             Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
             If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1134,7 +1141,7 @@
         Dim Exs As String = ""
         For Each Source In Urls
             Try
-                Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8))
+                Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
             Catch ex As Exception
                 Exs += ex.Message + vbCrLf
             End Try

Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb

@@ -10,7 +10,7 @@
 
         '路径
         ''' <summary>
-        ''' Java.exe 文件的完整路径。
+        ''' java.exe 文件的完整路径。
         ''' </summary>
         Public ReadOnly Property PathJava As String
             Get
@@ -18,15 +18,7 @@
             End Get
         End Property
         ''' <summary>
-        ''' Javaw.exe 文件的完整路径。
-        ''' </summary>
-        Public ReadOnly Property PathJavaw As String
-            Get
-                Return PathFolder & "javaw.exe"
-            End Get
-        End Property
-        ''' <summary>
-        ''' Javaw.exe 文件所在文件夹的路径，以 \ 结尾。
+        ''' java.exe 文件所在文件夹的路径，以 \ 结尾。
         ''' </summary>
         Public PathFolder As String
         ''' <summary>
@@ -102,20 +94,13 @@
             Dim Output As String = Nothing
             Try
                 '确定文件存在
-                If Not File.Exists(PathJavaw) Then
-                    Throw New FileNotFoundException("未找到 javaw.exe 文件", PathJavaw)
-                End If
-                If Not File.Exists(PathFolder & "java.exe") Then
-                    Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe")
-                End If
-                If File.Exists(PathFolder & "pdf-bookmark") Then
-                    Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
-                End If
+                If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
+                If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
                 IsJre = Not File.Exists(PathFolder & "javac.exe")
                 '运行 -version
-                Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
+                Output = StartProcessAndGetOutput(PathJava, "-version", 15000).ToLower
                 If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
-                If ModeDebug Then Log("[Java] Java 检查输出：" & PathFolder & "java.exe" & vbCrLf & Output)
+                If ModeDebug Then Log("[Java] Java 检查输出：" & PathJava & vbCrLf & Output)
                 If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java，请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
                 If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java，该 Java 或系统存在问题")
                 '获取详细信息
@@ -136,17 +121,17 @@
                 End If
                 Is64Bit = Output.Contains("64-bit")
                 If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败，获取的版本为 " & Version.ToString)
-                '基于 #3649，在 64 位系统上禁用 32 位 Java
+                '#3649：在 64 位系统上禁用 32 位 Java
                 If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本，请安装 64 位的 Java")
-                '基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败，干脆禁用更多版本的 JRE
+                '#2249：JRE 17 似乎会导致 Forge 安装失败，干脆禁用更多版本的 JRE
                 If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差，因此不再允许使用。你可以使用对应版本的 JDK，而非 JRE！")
             Catch ex As ApplicationException
                 Throw ex
             Catch ex As ThreadInterruptedException
                 Throw ex
             Catch ex As Exception
-                Log("[Java] 检查失败的 Java 输出：" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出"))
-                Throw New Exception("检查 Java 失败（" & If(PathJavaw, "Nothing") & "）", ex)
+                Log("[Java] 检查失败的 Java 输出：" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出"))
+                Throw New Exception("检查 Java 失败（" & If(PathJava, "Nothing") & "）", ex)
             End Try
             IsChecked = True
         End Sub
@@ -460,8 +445,8 @@ NoUserJava:
     ''' 将 Java 按照适用性排序。
     ''' </summary>
     Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
-        Dim PathInfo As New DirectoryInfo(ShortenPath(Path))
-        Dim PathMcInfo As New DirectoryInfo(ShortenPath(PathMcFolder))
+        Dim PathInfo As New DirectoryInfo(Path)
+        Dim PathMcInfo As New DirectoryInfo(PathMcFolder)
         '1. 尽量在当前文件夹或当前 Minecraft 文件夹
         Dim ProgramPathParent As String, MinecraftPathParent As String = ""
         ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
@@ -533,7 +518,7 @@ NoUserJava:
                 JavaSearchFolder(Disk.Name, JavaPreList, False)
             Next
             '查找 .jdks 文件夹中的 Java
-            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False)
+            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, True)
             '查找 APPDATA 文件夹中的 Java
             JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
             JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False)
@@ -661,7 +646,7 @@ Wait:
     Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
         Try
             Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找：" & OriginalPath)
-            JavaSearchFolder(New DirectoryInfo(ShortenPath(OriginalPath)), Results, Source, IsFullSearch)
+            JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch)
         Catch ex As UnauthorizedAccessException
             Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath)
         Catch ex As Exception
@@ -689,7 +674,7 @@ Wait:
                             "应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
                             "runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
                             "download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
-                            "4297127d64ec6", "1.", "启动"}
+                            "4297127d64ec6", "1.", "启动", "jbr"}
             For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
                 If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
                 Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串

Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb

@@ -35,7 +35,7 @@ Public Module ModLaunch
         '预检查
         If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
         If McLaunchLoader.State = LoadState.Loading Then
-            Hint("已有游戏正在启动中！", HintType.Critical)
+            Hint("已有游戏正在启动中！", HintType.Red)
             Return False
         End If
         '强制切换需要启动的版本
@@ -44,7 +44,7 @@ Public Module ModLaunch
             '检查版本
             CurrentLaunchOptions.Version.Load()
             If CurrentLaunchOptions.Version.State = McVersionState.Error Then
-                Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Critical)
+                Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Red)
                 Return False
             End If
             '切换版本
@@ -98,7 +98,7 @@ Public Module ModLaunch
             McLaunchPrecheck()
             McLaunchLog("预检测已通过")
         Catch ex As Exception
-            If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
+            If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Red)
             Throw
         End Try
         Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
@@ -146,7 +146,7 @@ Public Module ModLaunch
             '成功与失败处理
             Select Case LaunchLoader.State
                 Case LoadState.Finished
-                    Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish)
+                    Hint(McVersionCurrent.Name & " 启动成功！", HintType.Green)
                     '上报
                     If Not IsSavingBatch Then
                         Telemetry("Minecraft 启动成功",
@@ -155,9 +155,9 @@ Public Module ModLaunch
                     End If
                 Case LoadState.Aborted
                     If AbortHint Is Nothing Then
-                        Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Info)
+                        Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Blue)
                     Else
-                        Hint(AbortHint, HintType.Finish)
+                        Hint(AbortHint, HintType.Green)
                     End If
                 Case LoadState.Failed
                     Throw LaunchLoader.Error
@@ -178,7 +178,7 @@ NextInner:
                 GoTo NextInner
             Else
                 '没有特殊处理过的错误信息
-                McLaunchLog("错误：" & GetExceptionDetail(ex))
+                McLaunchLog("错误：" & ex.GetDetail())
                 Log(ex,
                     If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogLevel.Msgbox,
                     If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
@@ -187,7 +187,7 @@ NextInner:
                     Telemetry("Minecraft 启动失败",
                               "Version", McVersionCurrent.Version.ToString,
                               "LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)),
-                              "Exception", FilterUserName(FilterAccessToken(GetExceptionDetail(ex), "*"), "*"))
+                              "Exception", FilterUserName(FilterAccessToken(ex.GetDetail(), "*"), "*"))
                 End If
                 Throw
             End If
@@ -270,7 +270,7 @@ NextInner:
                 Select Case MyMsgBox("你必须先登录正版账号，才能进行离线登录！", "正版验证", "购买正版", "试玩", "返回",
                     Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
                     Case 2
-                        Hint("游戏将以试玩模式启动！", HintType.Critical)
+                        Hint("游戏将以试玩模式启动！", HintType.Red)
                         CurrentLaunchOptions.ExtraArgs.Add("--demo")
                     Case 3
                         Throw New Exception("$$")
@@ -609,12 +609,8 @@ SkipLogin:
                 McLoginRequestValidate(Data)
                 GoTo LoginFinish
             Catch ex As Exception
-                Dim AllMessage = GetExceptionDetail(ex)
-                McLaunchLog("验证登录失败：" & AllMessage)
-                If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
-                    McLaunchLog("已触发超时登录失败")
-                    Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后重试，或使用加速器或 VPN 以改善网络环境。")
-                End If
+                Log(ex, "验证登录失败")
+                If IsNetworkRelated(ex) Then Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后再试，或使用加速器、VPN 改善网络环境。")
             End Try
             Data.Progress = 0.25
             '尝试刷新登录
@@ -624,7 +620,7 @@ Refresh:
                 McLoginRequestRefresh(Data, NeedRefresh)
                 GoTo LoginFinish
             Catch ex As Exception
-                McLaunchLog("刷新登录失败：" & GetExceptionDetail(ex))
+                McLaunchLog("刷新登录失败：" & ex.GetDetail())
                 If WasRefreshed Then Throw New Exception("二轮刷新登录失败", ex)
             End Try
             Data.Progress = If(NeedRefresh, 0.85, 0.45)
@@ -634,7 +630,7 @@ Refresh:
             If Data.IsAborted Then Throw New ThreadInterruptedException
             NeedRefresh = McLoginRequestLogin(Data)
         Catch ex As Exception
-            McLaunchLog("登录失败：" & GetExceptionDetail(ex))
+            McLaunchLog("登录失败：" & ex.GetDetail())
             Throw
         End Try
         If NeedRefresh Then
@@ -726,7 +722,7 @@ LoginFinish:
                    New JProperty("requestUser", True)
                ).ToString(Newtonsoft.Json.Formatting.None),
                Headers:={{"Accept-Language", "zh-CN"}},
-               ContentType:="application/json; charset=utf-8"))
+               ContentType:="application/json; charset=utf-8", RequireJson:=True))
         '将登录结果输出
         If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效！")
         Data.Output.AccessToken = LoginJson("accessToken").ToString
@@ -756,13 +752,13 @@ LoginFinish:
                 Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
                 Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
                 Headers:={{"Accept-Language", "zh-CN"}},
-                ContentType:="application/json; charset=utf-8"))
+                ContentType:="application/json; charset=utf-8", RequireJson:=True))
             '检查登录结果
             If LoginJson("availableProfiles").Count = 0 Then
-                If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Critical)
+                If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Red)
                 Throw New Exception("$你还没有创建角色，请在创建角色后再试！")
             ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").Count = 1 Then
-                Hint("你的账户中只有一个角色，无法更换！", HintType.Critical)
+                Hint("你的账户中只有一个角色，无法更换！", HintType.Red)
             End If
             Dim SelectedName As String = Nothing
             Dim SelectedId As String = Nothing
@@ -814,13 +810,14 @@ LoginFinish:
             McLaunchLog("登录成功（Login, " & Data.Input.Token & "）")
             Return NeedRefresh
         Catch ex As Exception
-            Dim AllMessage As String = GetExceptionSummary(ex)
+            Dim AllMessage As String = ex.GetBrief()
             Log(ex, "登录失败原始错误信息", LogLevel.Normal)
             '读取服务器返回的错误
             If TypeOf ex Is ResponsedWebException Then
                 Dim ErrorMessage As String = Nothing
                 Try
-                    ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
+                    Dim Response = DirectCast(ex, ResponsedWebException).Response
+                    If ErrorMessage.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage")
                 Catch
                 End Try
                 If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -838,7 +835,7 @@ LoginFinish:
                 End If
             End If
             '通用关键字检测
-            If AllMessage.Contains("403") Then
+            If AllMessage.Contains("(403)") Then
                 Select Case Data.Input.Type
                     Case McLoginType.Auth
                         Throw New Exception("$登录失败，以下为可能的原因：" & vbCrLf &
@@ -852,8 +849,8 @@ LoginFinish:
                                             If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号，而非游戏角色 ID。" & vbCrLf) &
                                             " - 只注册了账号，但没有加入对应服务器。")
                 End Select
-            ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
-                Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后重试，或使用加速器或 VPN 以改善网络环境。")
+            ElseIf ex.IsNetworkRelated() Then
+                Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后再试，或使用加速器、VPN 改善网络环境。")
             ElseIf ex.Message.StartsWithF("$") Then
                 Throw
             Else
@@ -872,7 +869,7 @@ Retry:
         McLaunchLog("开始微软登录步骤 1/6（原始登录）")
         Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
             Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
-            ContentType:="application/x-www-form-urlencoded"))
+            ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
         McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
 
         '弹窗
@@ -907,9 +904,17 @@ Retry:
                 Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
                 ThreadCount:=2)
         Catch ex As ResponsedWebException
-            If ex.Response.ContainsF("must sign in again", True) OrElse ex.Response.ContainsF("password expired", True) OrElse
-               (ex.Response.Contains("refresh_token") AndAlso ex.Response.Contains("is not valid")) Then '#269
+            '修改错误列表时，同时检查 MyMsgLogin.xaml.vb 中的对应代码
+            Dim Response = ex.Response
+            If Response.ContainsF("must sign in again", True) OrElse Response.ContainsF("password expired", True) OrElse
+               (Response.Contains("refresh_token") AndAlso Response.Contains("is not valid")) Then '#269
                 Return {"Relogin", ""}
+            ElseIf Response.Contains("Account security interrupt") Then
+                MyMsgBox("该账号由于安全问题无法登陆，请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
+                Throw New Exception("$$")
+            ElseIf Response.Contains("service abuse") Then
+                MyMsgBox("非常抱歉，该账号已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
+                Throw New Exception("$$")
             Else
                 Throw
             End If
@@ -934,7 +939,7 @@ Retry:
            ""TokenType"": ""JWT""
         }"
         Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
-            Content:=Request, ContentType:="application/json")
+            Content:=Request, ContentType:="application/json", RequireJson:=True)
         Dim ResultJson As JObject = GetJson(Result)
         Dim XBLToken As String = ResultJson("Token").ToString
         Return XBLToken
@@ -956,7 +961,7 @@ Retry:
         Dim Result As String
         Try
             Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post,
-                Content:=Request, ContentType:="application/json")
+                Content:=Request, ContentType:="application/json", RequireJson:=True)
         Catch ex As ResponsedWebException
             '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
             If ex.Response.Contains("2148916227") Then
@@ -968,7 +973,7 @@ Retry:
                 End If
                 Throw New Exception("$$")
             ElseIf ex.Response.Contains("2148916235") Then
-                MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN。", "登录失败", "我知道了")
+                MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN，然后再试。", "登录失败", "我知道了")
                 Throw New Exception("$$")
             ElseIf ex.Response.Contains("2148916238") Then
                 If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf &
@@ -987,15 +992,11 @@ Retry:
             End If
         End Try
 
-        Try '这个 Try 块仅为了追踪 #6683 而添加
-            Dim ResultJson As JObject = GetJson(Result)
-            Dim XSTSToken As String = ResultJson("Token").ToString
-            Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
-            Return {XSTSToken, UHS}
-        Catch
-            Log("[Launch] 返回内容：" & vbCrLf & Result)
-            Throw
-        End Try
+        Dim ResultJson As JObject = GetJson(Result)
+        Return {
+            ResultJson("Token"), 'XSTSToken
+            ResultJson("DisplayClaims")("xui")(0)("uhs") 'UHS
+        }
     End Function
     '微软登录步骤 4：从 {XSTSToken, UHS} 获取 Minecraft AccessToken
     Private Function MsLoginStep4(Tokens As String()) As String
@@ -1005,9 +1006,9 @@ Retry:
         Dim Result As String
         Try
             Result = NetRequestByClientRetry("https://api.minecraftservices.com/authentication/login_with_xbox", HttpMethod.Post,
-                Content:=Request, ContentType:="application/json")
+                Content:=Request, ContentType:="application/json", RequireJson:=True)
         Catch ex As Net.WebException
-            Dim Message As String = GetExceptionSummary(ex)
+            Dim Message As String = ex.GetBrief()
             If Message.Contains("(429)") Then
                 Log(ex, "微软登录第 4 步汇报 429")
                 Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
@@ -1019,16 +1020,14 @@ Retry:
             End If
         End Try
 
-        Dim ResultJson As JObject = GetJson(Result)
-        Dim AccessToken As String = ResultJson("access_token").ToString
-        Return AccessToken
+        Return GetJson(Result)("access_token").ToString
     End Function
     '微软登录步骤 5：验证微软账号是否持有 MC，这也会刷新 XGP
     Private Sub MsLoginStep5(AccessToken As String)
         McLaunchLog("开始微软登录步骤 5/6")
 
         Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
-            ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}})
+            ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
         Try
             Dim ResultJson As JObject = GetJson(Result)
             If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
@@ -1050,9 +1049,9 @@ Retry:
         Dim Result As String
         Try
             Result = NetRequestByClientMultiple("https://api.minecraftservices.com/minecraft/profile",
-                ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}})
-        Catch ex As Net.WebException
-            Dim Message As String = GetExceptionSummary(ex)
+                ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
+        Catch ex As WebException
+            Dim Message As String = ex.GetBrief()
             If Message.Contains("(429)") Then
                 Log(ex, "微软登录第 6 步汇报 429")
                 Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
@@ -1123,7 +1122,7 @@ Retry:
         If Len(Uuid) = 32 Then Return Uuid
         '从官网获取
         Try
-            Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name))
+            Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True))
             If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在（" & Name & "）")
             Uuid = If(GotJson("id"), "")
         Catch ex As Exception
@@ -1305,7 +1304,7 @@ Retry:
             If McLaunchJavaSelected IsNot Nothing Then
                 McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
             Else
-                Hint("没有可用的 Java，已取消启动！", HintType.Critical)
+                Hint("没有可用的 Java，已取消启动！", HintType.Red)
                 Throw New Exception("$$")
             End If
 
@@ -1396,7 +1395,7 @@ Retry:
         Next
         '自定义
         Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Version:=McVersionCurrent)
-        Arguments += " " & If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame)
+        Arguments += " " & ArgumentReplace(If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame))
         '进行参数替换
         Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
         If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
@@ -1413,6 +1412,9 @@ Retry:
             FinalArguments += Argument & " "
         Next
         FinalArguments = FinalArguments.TrimEnd
+        '替换 Module Path 为短路径（Forge 会在版本 JSON 硬编码这些路径）
+        FinalArguments = FinalArguments.RegexReplaceEach("(?<= (-p|--module-path) "")[^""]+(?="" )",
+            Function(ModulePath) ModulePath.Value.RegexReplaceEach("[A-Z]{1}:\\[^;]+", Function(m) ShortenPath(m.Value)))
         '进服
         Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
         If Server.Length > 0 Then
@@ -1428,7 +1430,7 @@ Retry:
                     '不包含端口号
                     FinalArguments += $" --server {Server} --port 25565"
                 End If
-                If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Critical)
+                If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Red)
             End If
         End If
         '输出
@@ -1448,7 +1450,7 @@ Retry:
         If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
         If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
         ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
-        DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
+        DataList.Insert(0, ArgumentReplace(ArgumentJvm)) '可变 JVM 参数
         DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
         DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
         DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
@@ -1461,9 +1463,7 @@ Retry:
         'Authlib-Injector
         If McLoginLoader.Output.Type = "Auth" Then
             If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
-            Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
-                "http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
-                Setup.Get("VersionServerAuthServer", McVersionCurrent))
+            Dim Server As String = Setup.Get("VersionServerAuthServer", McVersionCurrent)
             Try
                 Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
                 DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1488,6 +1488,9 @@ Retry:
             DataList.Add(Version.JsonObject("mainClass"))
         End If
 
+        '处理 DataList 的换行符
+        DataList = DataList.Select(Function(d) d.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ").Trim).ToList
+
         Return Join(DataList, " ")
     End Function
     Private Function McLaunchArgumentsJvmNew(Version As McVersion) As String
@@ -1531,9 +1534,7 @@ NextVersion:
         'Authlib-Injector
         If McLoginLoader.Output.Type = "Auth" Then
             If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
-            Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
-                "http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
-                Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
+            Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
             Try
                 Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
                 DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1555,7 +1556,7 @@ NextVersion:
         '如果不合并，会导致 Forge 1.17 启动无效，它有两个 --add-exports，进一步导致其中一个在后面被去重
         Dim DeDuplicateDataList As New List(Of String)
         For i = 0 To DataList.Count - 1
-            Dim CurrentEntry As String = DataList(i)
+            Dim CurrentEntry As String = DataList(i).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ").Trim
             If DataList(i).StartsWithF("-") Then
                 Do While i < DataList.Count - 1
                     If DataList(i + 1).StartsWithF("-") Then
@@ -1571,7 +1572,7 @@ NextVersion:
 
         '去重
         DeDuplicateDataList.Remove("-XX:MaxDirectMemorySize=256M") '#3511 的清理
-        Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ")
+        Dim Result As String = DeDuplicateDataList.Distinct.Join(" ")
 
         '添加 MainClass
         If Version.JsonObject("mainClass") Is Nothing Then
@@ -1592,7 +1593,7 @@ NextVersion:
         If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
         DataList.Add(BasicString)
 
-        Dim Result As String = Join(DataList, " ")
+        Dim Result As String = DataList.Join(" ")
 
         '特别改变 OptiFineTweaker
         If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
@@ -1697,7 +1698,7 @@ NextVersion:
         GameArguments.Add("${launcher_version}", VersionCode)
         GameArguments.Add("${version_name}", Version.Name)
         Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
-        GameArguments.Add("${version_type}", If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo))
+        GameArguments.Add("${version_type}", ArgumentReplace(If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo)))
         GameArguments.Add("${game_directory}", ShortenPath(Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1)))
         GameArguments.Add("${assets_root}", ShortenPath(PathMcFolder & "assets"))
         GameArguments.Add("${user_properties}", "{}")
@@ -1707,7 +1708,7 @@ NextVersion:
         GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
         GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
         GameArguments.Add("${user_type}", "msa") '#1221
-        GameArguments.Add("${primary_jar}", Version.Path & Version.Name & ".jar") '#6942
+        GameArguments.Add("${primary_jar}", ShortenPath(Version.Path & Version.Name & ".jar")) '#6942
 
         '窗口尺寸参数
         Dim GameSize As Size
@@ -1796,7 +1797,7 @@ NextVersion:
                             File.Delete(FilePath)
                         Catch ex As UnauthorizedAccessException
                             McLaunchLog("删除原 dll 访问被拒绝，这通常代表有一个 MC 正在运行，跳过解压：" & FilePath)
-                            McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
+                            McLaunchLog("实际的错误信息：" & ex.GetDetail())
                             Exit For
                         End Try
                     End If
@@ -1816,7 +1817,7 @@ NextVersion:
                 File.Delete(FileName)
             Catch ex As UnauthorizedAccessException
                 McLaunchLog("删除多余文件访问被拒绝，跳过删除步骤")
-                McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
+                McLaunchLog("实际的错误信息：" & ex.GetDetail())
                 Return
             End Try
         Next
@@ -1827,10 +1828,14 @@ NextVersion:
     ''' </summary>
     Private Function GetNativesFolder() As String
         Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives"
-        If IsGBKEncoding OrElse Result.IsASCII() Then Return Result
-        Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
-        If Result.IsASCII() Then Return Result
-        Return OsDrive & "ProgramData\PCL\natives"
+        If Not (IsGBKEncoding OrElse Result.IsASCII()) Then
+            Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
+            If Not Result.IsASCII() Then
+                Result = OsDrive & "ProgramData\PCL\natives"
+            End If
+        End If
+        Directory.CreateDirectory(Result) '提前创建，这样 ShortenPath 才有结果（否则在长路径下首次启动 Forge 会崩溃）
+        Return ShortenPath(Result)
     End Function
 
 #End Region
@@ -1842,7 +1847,7 @@ NextVersion:
         '要求 Java 使用高性能显卡
         If Setup.Get("LaunchAdvanceGraphicCard") Then
             Try
-                SetGPUPreference(McLaunchJavaSelected.PathJavaw)
+                SetGPUPreference(McLaunchJavaSelected.PathJava)
                 SetGPUPreference(PathWithName)
             Catch ex As Exception
                 If IsAdmin() Then
@@ -1850,7 +1855,7 @@ NextVersion:
                 Else
                     Log(ex, "直接调整显卡设置失败，将以管理员权限重启 PCL 再次尝试")
                     Try
-                        If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJavaw}""") = ProcessReturnValues.TaskDone Then
+                        If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then
                             McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
                         Else
                             Throw New Exception("调整过程中出现异常")
@@ -1981,7 +1986,7 @@ NextVersion:
                McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
                (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
                (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
-            Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Critical)
+            Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Red)
         End If
 
         '离线皮肤资源包
@@ -2125,9 +2130,9 @@ IgnoreCustomSkin:
 
         '获取自定义命令
         Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
-        If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal, True)
+        If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
         Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
-        If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion, True)
+        If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
 
         '输出 bat
         Try
@@ -2159,14 +2164,15 @@ IgnoreCustomSkin:
         '执行自定义命令
         If CustomCommandGlobal <> "" Then
             McLaunchLog("正在执行全局自定义命令：" & CustomCommandGlobal)
-            Dim CustomProcess As New Process
+            Dim CustomProcess As Process = Nothing
             Try
-                CustomProcess.StartInfo.FileName = "cmd.exe"
-                CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandGlobal & """"
-                CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
-                CustomProcess.StartInfo.UseShellExecute = False
-                CustomProcess.StartInfo.CreateNoWindow = True
-                CustomProcess.Start()
+                CustomProcess = StartProcess(New ProcessStartInfo With {
+                    .FileName = "cmd.exe",
+                    .Arguments = $"/c ""{CustomCommandGlobal}""",
+                    .WorkingDirectory = PathMcFolder,
+                    .UseShellExecute = False,
+                    .CreateNoWindow = True
+                })
                 If Setup.Get("LaunchAdvanceRunWait") Then
                     Do Until CustomProcess.HasExited OrElse Loader.IsAborted
                         Thread.Sleep(10)
@@ -2175,7 +2181,7 @@ IgnoreCustomSkin:
             Catch ex As Exception
                 Log(ex, "执行全局自定义命令失败", LogLevel.Hint)
             Finally
-                If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
+                If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
                     McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
                     CustomProcess.Kill()
                 End If
@@ -2183,14 +2189,15 @@ IgnoreCustomSkin:
         End If
         If CustomCommandVersion <> "" Then
             McLaunchLog("正在执行版本自定义命令：" & CustomCommandVersion)
-            Dim CustomProcess As New Process
+            Dim CustomProcess As Process = Nothing
             Try
-                CustomProcess.StartInfo.FileName = "cmd.exe"
-                CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandVersion & """"
-                CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
-                CustomProcess.StartInfo.UseShellExecute = False
-                CustomProcess.StartInfo.CreateNoWindow = True
-                CustomProcess.Start()
+                CustomProcess = StartProcess(New ProcessStartInfo With {
+                    .FileName = "cmd.exe",
+                    .Arguments = $"/c ""{CustomCommandVersion}""",
+                    .WorkingDirectory = PathMcFolder,
+                    .UseShellExecute = False,
+                    .CreateNoWindow = True
+                })
                 If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then
                     Do Until CustomProcess.HasExited OrElse Loader.IsAborted
                         Thread.Sleep(10)
@@ -2199,7 +2206,7 @@ IgnoreCustomSkin:
             Catch ex As Exception
                 Log(ex, "执行版本自定义命令失败", LogLevel.Hint)
             Finally
-                If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
+                If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
                     McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
                     CustomProcess.Kill()
                 End If
@@ -2210,27 +2217,27 @@ IgnoreCustomSkin:
     Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
 
         '启动信息
-        Dim GameProcess = New Process()
-        Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw)
+        Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
 
         '设置环境变量
-        Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
+        Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
+        Dim Paths As New List(Of String)
+        If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
         Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
         StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
         StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
 
         '设置其他参数
-        StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie)
+        StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
         StartInfo.UseShellExecute = False
         StartInfo.RedirectStandardOutput = True
         StartInfo.RedirectStandardError = True
-        StartInfo.CreateNoWindow = False
+        StartInfo.CreateNoWindow = True
         StartInfo.Arguments = McLaunchArgument
-        GameProcess.StartInfo = StartInfo
 
         '开始进程
-        GameProcess.Start()
-        McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJavaw)
+        Dim GameProcess = StartProcess(StartInfo)
+        McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJava)
         If Loader.IsAborted Then
             McLaunchLog("由于取消启动，已强制结束游戏进程") '#1631
             GameProcess.Kill()
@@ -2283,7 +2290,7 @@ IgnoreCustomSkin:
         '获取窗口标题
         Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent)
         If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle")
-        WindowTitle = ArgumentReplace(WindowTitle, False)
+        WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
 
         '初始化等待
         Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle)
@@ -2332,47 +2339,6 @@ IgnoreCustomSkin:
 
     End Sub
 
-    ''' <summary>
-    ''' 在启动结束时，对 PCL 约定的替换标记进行处理。
-    ''' </summary>
-    Private Function ArgumentReplace(Raw As String, ReplaceTimeAndDate As Boolean) As String
-        If Raw Is Nothing Then Return Nothing
-        '路径替换
-        Raw = Raw.Replace("{minecraft}", PathMcFolder)
-        Raw = Raw.Replace("{verpath}", McVersionCurrent.Path)
-        Raw = Raw.Replace("{verindie}", McVersionCurrent.PathIndie)
-        Raw = Raw.Replace("{java}", McLaunchJavaSelected.PathFolder)
-        '普通替换
-        Raw = Raw.Replace("{user}", McLoginLoader.Output.Name)
-        Raw = Raw.Replace("{uuid}", McLoginLoader.Output.Uuid)
-        If ReplaceTimeAndDate Then '设置窗口标题时需要动态替换日期和时间
-            Raw = Raw.Replace("{date}", Date.Now.ToString("yyyy/M/d"))
-            Raw = Raw.Replace("{time}", Date.Now.ToString("HH:mm:ss"))
-        End If
-        Select Case McLoginLoader.Input.Type
-            Case McLoginType.Legacy
-                If PageLinkHiper.HiperState = LoadState.Finished Then
-                    Raw = Raw.Replace("{login}", "联机离线")
-                Else
-                    Raw = Raw.Replace("{login}", "离线")
-                End If
-            Case McLoginType.Ms
-                Raw = Raw.Replace("{login}", "正版")
-            Case McLoginType.Nide
-                Raw = Raw.Replace("{login}", "统一通行证")
-            Case McLoginType.Auth
-                Raw = Raw.Replace("{login}", "Authlib-Injector")
-        End Select
-        Raw = Raw.Replace("{name}", McVersionCurrent.Name)
-        If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then
-            Raw = Raw.Replace("{version}", McVersionCurrent.Name)
-        Else
-            Raw = Raw.Replace("{version}", McVersionCurrent.Version.McName)
-        End If
-        Raw = Raw.Replace("{path}", Path)
-        Return Raw
-    End Function
-
 #End Region
 
 End Module

Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb

@@ -68,7 +68,7 @@ Public Module ModMinecraft
             For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
                 If Folder = "" Then Continue For
                 If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
-                    Hint("无效的 Minecraft 文件夹：" & Folder, HintType.Critical)
+                    Hint("无效的 Minecraft 文件夹：" & Folder, HintType.Red)
                     Continue For
                 End If
                 Dim Name As String = Folder.Split(">")(0)
@@ -86,7 +86,7 @@ Public Module ModMinecraft
                     Next
                     If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
                 Catch ex As Exception
-                    MyMsgBox("失效的 Minecraft 文件夹：" & vbCrLf & Path & vbCrLf & vbCrLf & GetExceptionSummary(ex), "Minecraft 文件夹失效", IsWarn:=True)
+                    MyMsgBox("失效的 Minecraft 文件夹：" & vbCrLf & Path & vbCrLf & vbCrLf & ex.GetBrief(), "Minecraft 文件夹失效", IsWarn:=True)
                     Log(ex, $"无法访问 Minecraft 文件夹 {Path}")
                 End Try
             Next
@@ -261,6 +261,12 @@ Public Module ModMinecraft
         ''' 显示的描述文本。
         ''' </summary>
         Public Info As String = "该版本未被加载，请向作者反馈此问题"
+        Public ReadOnly Property HasCustomInfo As Boolean
+            Get
+                Return ReadIni(Path & "PCL\Setup.ini", "CustomInfo") <> ""
+            End Get
+        End Property
+
         ''' <summary>
         ''' 该版本的列表检查原始结果，不受自定义影响。
         ''' </summary>
@@ -695,7 +701,7 @@ Recheck:
             Catch ex As Exception
                 Log(ex, "依赖版本检查出错（" & Name & "）")
                 State = McVersionState.Error
-                Info = "未知错误：" & GetExceptionSummary(ex)
+                Info = "未知错误：" & ex.GetBrief()
                 Return False
             End Try
 
@@ -784,7 +790,17 @@ ExitDataLoad:
                 End If
                 '确定版本描述
                 Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo")
-                Info = If(CustomInfo <> "", CustomInfo, GetDefaultDescription())
+                If CustomInfo <> "" Then
+                    Info = CustomInfo
+                Else
+                    Info = GetVersionDescription()
+                    If State = McVersionState.Fool Then
+                        Info = GetMcFoolName(Version.McName)
+                    ElseIf State <> McVersionState.Error Then
+                        If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
+                        If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
+                    End If
+                End If
                 '确定版本收藏状态
                 IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False)
                 '确定版本显示种类
@@ -808,7 +824,7 @@ ExitDataLoad:
                     WriteIni(Path & "PCL\Setup.ini", "VersionOriginalSub", Version.McCodeSub)
                 End If
             Catch ex As Exception
-                Info = "未知错误：" & GetExceptionSummary(ex)
+                Info = "未知错误：" & ex.GetBrief()
                 Logo = PathImage & "Blocks/RedstoneBlock.png"
                 State = McVersionState.Error
                 Log(ex, "加载版本失败（" & Name & "）", LogLevel.Feedback)
@@ -817,11 +833,13 @@ ExitDataLoad:
             End Try
             Return Me
         End Function
+        Public IsLoaded As Boolean = False
         ''' <summary>
-        ''' 获取版本的默认描述。
+        ''' 获取对该版本的简短描述。
+        ''' 例如 “快照 16w01a”、“原版 1.12.2”、“愚人节版本 2.0”。
         ''' </summary>
-        Public Function GetDefaultDescription() As String
-            Dim Info As String = ""
+        Public Function GetVersionDescription() As String
+            Dim Info As String
             Select Case State
                 Case McVersionState.Snapshot
                     If Version.McName.ContainsF("pre", True) Then
@@ -838,21 +856,38 @@ ExitDataLoad:
                 Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
                     Info = Version.ToString
                 Case McVersionState.Fool
-                    Info = GetMcFoolName(Version.McName)
+                    Info = "愚人节版本 " & Version.McName
                 Case McVersionState.Error
                     Return Me.Info '已有错误信息
                 Case Else
                     Info = "发生了未知错误，请向作者反馈此问题"
             End Select
-            If Not State = McVersionState.Error Then
-                If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
-                If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
-            End If
             Return Info
         End Function
 
-        Public IsLoaded As Boolean = False
+        Public Function ToListItem() As MyListItem
+            Dim NewItem As New MyListItem With {.Info = Info, .Height = 42, .Tag = Me, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable}
+            '标题
+            NewItem.Inlines.Clear()
+            NewItem.Inlines.Add(New Run(Name))
+            If HasCustomInfo Then '如果版本设置了自定义描述，在标题后面以淡灰色显示其版本号
+                NewItem.Inlines.Add(New Run("  |  " & GetVersionDescription()) With {.Foreground = New MyColor(215, 215, 215), .FontSize = 12})
+            End If
+            'Logo
+            Try
+                If Logo.EndsWith("PCL\Logo.png") Then
+                    NewItem.Logo = Path & "PCL\Logo.png" '修复老版本中，存储的自定义 Logo 使用完整路径，导致移动后无法加载的 Bug
+                Else
+                    NewItem.Logo = Logo
+                End If
+            Catch ex As Exception
+                Log(ex, "加载版本图标失败", LogLevel.Hint)
+                NewItem.Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
+            End Try
+            Return NewItem
+        End Function
 
+        '运算符支持
         Public Overrides Function Equals(obj As Object) As Boolean
             Dim version = TryCast(obj, McVersion)
             Return version IsNot Nothing AndAlso Path = version.Path
@@ -865,7 +900,6 @@ ExitDataLoad:
         Public Shared Operator <>(a As McVersion, b As McVersion) As Boolean
             Return Not (a = b)
         End Operator
-
     End Class
     Public Enum McVersionState
         [Error]
@@ -1186,6 +1220,7 @@ OnLoaded:
             If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
         Catch ex As ThreadInterruptedException
         Catch ex As Exception
+            If Loader.IsAborted Then Return '#5617
             WriteIni(Path & "PCL.ini", "VersionCache", "") '要求下次重新加载
             Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback)
         End Try
@@ -1566,12 +1601,12 @@ OnLoaded:
         Try
             Dim Image As New MyBitmap(FileName)
             If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then
-                Hint("皮肤图片大小应为 64x32 像素或 64x64 像素！", HintType.Critical)
+                Hint("皮肤图片大小应为 64x32 像素或 64x64 像素！", HintType.Red)
                 Return New McSkinInfo With {.IsVaild = False}
             End If
             Dim FileInfo As New FileInfo(FileName)
             If FileInfo.Length > 24 * 1024 Then
-                Hint("皮肤文件大小需小于 24 KB，而所选文件大小为 " & Math.Round(FileInfo.Length / 1024, 2) & " KB", HintType.Critical)
+                Hint("皮肤文件大小需小于 24 KB，而所选文件大小为 " & Math.Round(FileInfo.Length / 1024, 2) & " KB", HintType.Red)
                 Return New McSkinInfo With {.IsVaild = False}
             End If
         Catch ex As Exception
@@ -1592,11 +1627,11 @@ OnLoaded:
     ''' <summary>
     ''' 获取 Uuid 对应的皮肤文件地址，失败将抛出异常。
     ''' </summary>
-    Public Function McSkinGetAddress(Uuid As String, Type As String) As String
-        If Uuid = "" Then Throw New Exception("Uuid 为空。")
-        If Uuid.StartsWithF("00000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
+    Public Function McSkinGetAddress(UUID As String, Type As String) As String
+        If UUID = "" Then Throw New Exception("UUID 为空。")
+        If UUID.StartsWithF("00000") AndAlso Type <> "Auth" Then Throw New Exception("离线 UUID 无正版皮肤文件：" & UUID)
         '尝试读取缓存
-        Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
+        Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", UUID)
         If Not CacheSkinAddress = "" Then Return CacheSkinAddress
         '获取皮肤地址
         Dim Url As String
@@ -1610,7 +1645,7 @@ OnLoaded:
             Case Else
                 Throw New ArgumentException("皮肤地址种类无效：" & If(Type, "null"))
         End Select
-        Dim SkinString = NetRequestByClientRetry(Url & Uuid)
+        Dim SkinString = NetRequestByClientRetry(Url & UUID, RequireJson:=True)
         If SkinString = "" Then Throw New Exception("皮肤返回值为空，可能是未设置自定义皮肤的用户")
         '处理皮肤地址
         Dim SkinValue As String
@@ -1635,8 +1670,8 @@ OnLoaded:
             SkinValue = If(SkinUrl.Contains("minecraft.net/"), SkinUrl.Replace("http://", "https://"), SkinUrl)
         End If
         '保存缓存
-        WriteIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid, SkinValue)
-        Log("[Skin] UUID " & Uuid & " 对应的皮肤文件为 " & SkinValue)
+        WriteIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", UUID, SkinValue)
+        Log("[Skin] UUID " & UUID & " 对应的皮肤文件为 " & SkinValue)
         Return SkinValue
     End Function
 
@@ -1891,17 +1926,29 @@ OnLoaded:
                              .OriginalName = Library("name"),
                              .Url = If(RootUrl, Library("downloads")("classifiers")("natives-windows")("url")),
                              .LocalPath = If(Library("downloads")("classifiers")("natives-windows")("path") Is Nothing,
-                                 McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
-                                 CustomMcFolder & "libraries\" & Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")),
+                                 McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
+                                    Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").
+                                    Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
+                                    $"{CustomMcFolder}libraries\{Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")}"),
                              .Size = Val(Library("downloads")("classifiers")("natives-windows")("size").ToString),
                              .IsNatives = True,
                              .SHA1 = Library("downloads")("classifiers")("natives-windows")("sha1").ToString})
                     Else
-                        BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
+                        BasicArray.Add(
+                        New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
+                            .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
+                                 Replace(".jar", $"-{Library("natives")("windows")}.jar").
+                                 Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
+                        })
                     End If
                 Catch ex As Exception
                     Log(ex, "处理实际支持库列表失败（有 Natives，" & If(Library("name"), "Nothing").ToString & "）")
-                    BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
+                    BasicArray.Add(
+                        New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
+                             .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
+                                 Replace(".jar", $"-{Library("natives")("windows")}.jar").
+                                 Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
+                        })
                 End Try
             End If
 
@@ -1966,7 +2013,7 @@ OnLoaded:
             Try
                 Log("[Minecraft] 开始获取统一通行证下载信息")
                 '测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
-                DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)))
+                DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version), RequireJson:=True))
             Catch ex As Exception
                 Log(ex, "获取统一通行证下载信息失败")
             End Try
@@ -1983,16 +2030,20 @@ OnLoaded:
 
         'Authlib-Injector 文件
         If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
-            Dim TargetFile = PathPure & "\authlib-injector.jar"
+            Dim TargetFile = PathPure & "authlib-injector.jar"
             Dim DownloadInfo As JObject = Nothing
             '获取下载信息
             Try
                 Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
                 DownloadInfo = GetJson(NetRequestByClientRetry(
                         "https://authlib-injector.yushi.moe/artifact/latest.json",
-                        BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"))
+                        BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True))
             Catch ex As Exception
-                Log(ex, "获取 Authlib-Injector 下载信息失败")
+                If File.Exists(TargetFile) Then
+                    Log(ex, "获取 Authlib-Injector 下载信息失败")
+                Else
+                    Throw New Exception("获取 Authlib-Injector 下载信息失败", ex)
+                End If
             End Try
             '校验文件
             If DownloadInfo IsNot Nothing Then
@@ -2091,19 +2142,12 @@ OnLoaded:
     ''' <param name="WithHead">是否包含 Lib 文件夹头部，若不包含，则会类似以 com\xxx\ 开头。</param>
     Public Function McLibGet(Original As String, Optional WithHead As Boolean = True, Optional IgnoreLiteLoader As Boolean = False, Optional CustomMcFolder As String = Nothing) As String
         CustomMcFolder = If(CustomMcFolder, PathMcFolder)
+        '有时候原始的有四段，例如 net.minecraftforge:forge:1.21.4-54.0.34:client
+        '文件夹名应该忽略最后一段（client），但文件名需要保留
+        '参见 #7306（以及 #5376 也是因为这里没有处理好导致的）
         Dim Splited = Original.Split(":")
         McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
-                   Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
-        '判断 OptiFine 是否应该使用 installer
-        If McLibGet.Contains("optifine\OptiFine\1.") AndAlso Splited(2).Split(".").Count > 1 Then
-            Dim MajorVersion As Integer = Val(Splited(2).Split(".")(1).BeforeFirst("_"))
-            Dim MinorVersion As Integer = If(Splited(2).Split(".").Count > 2, Val(Splited(2).Split(".")(2).BeforeFirst("_")), 0)
-            If (MajorVersion = 12 OrElse (MajorVersion = 20 AndAlso MinorVersion >= 4) OrElse MajorVersion >= 21) AndAlso '仅在 1.12 (无法追溯) 和 1.20.4+ (#5376) 遇到此问题
-                File.Exists($"{CustomMcFolder}libraries\{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited(1)}-{Splited(2)}-installer.jar") Then
-                McLaunchLog("已将 " & Original & " 替换为对应的 Installer 文件")
-                McLibGet = McLibGet.Replace(".jar", "-installer.jar")
-            End If
-        End If
+            $"{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited.Skip(1).Join("-")}.jar"
     End Function
 
     ''' <summary>
@@ -2415,7 +2459,12 @@ NextEntry:
     Public Function FilterUserName(Raw As String, FilterChar As Char) As String
         If Raw.Contains(":\Users\") Then
             For Each Token In RegexSearch(Raw, "(?<=:\\Users\\)[^\\]+")
-                Raw = Raw.Replace("\" & Token, "\" & New String(FilterChar, Token.Count))
+                Raw = Raw.Replace("\Users\" & Token, "\Users\" & New String(FilterChar, Token.Count))
+            Next
+        End If
+        If Raw.Contains(":/Users/") Then
+            For Each Token In RegexSearch(Raw, "(?<=:/Users/)[^/]+")
+                Raw = Raw.Replace("/Users/" & Token, "/Users/" & New String(FilterChar, Token.Count))
             Next
         End If
         Return Raw

Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb

@@ -73,7 +73,7 @@ Public Module ModMod
             Get
                 If _Name Is Nothing Then Load()
                 If _Name Is Nothing Then _Name = _ModId
-                If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(Path)
+                If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
                 Return _Name
             End Get
             Set(value As String)
@@ -688,7 +688,7 @@ Finished:
         ''' </summary>
         Public ReadOnly Property CanUpdate As Boolean
             Get
-                Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any()
+                Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version) AndAlso ChangelogUrls.Any()
             End Get
         End Property
 
@@ -1113,8 +1113,8 @@ Finished:
         End Sub, "Mod List Detail Loader CurseForge")
         '等待线程结束
         Do Until EndedThreadCount = 2
-            If Loader.IsAborted Then Return
             Thread.Sleep(10)
+            If Loader.IsAborted Then Return
         Loop
         '保存缓存
         Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
@@ -1126,6 +1126,7 @@ Finished:
         Next
         WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
         '刷新边栏
+        If Loader.IsAborted Then Return
         If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
             RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
         Else
@@ -1212,7 +1213,7 @@ Finished:
                         If ReqVersionHead = ReqVersionTail Then
                             VersionRequire = "应为 " & ReqVersionHead
                         ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
-                            VersionRequire = "应为 " & ReqVersionHead & " 至 " & ReqVersionTail
+                            VersionRequire = $"应为 {ReqVersionHead} 至 {ReqVersionTail}"
                         ElseIf ReqVersionHead.Contains(".") Then
                             If ReqVersionHeadCanEqual Then
                                 VersionRequire = "最低应为 " & ReqVersionHead
@@ -1230,7 +1231,7 @@ Finished:
                         End If
                         '检查前置 Mod 是否存在，并获取其版本
                         If Not CurrentDependencies.ContainsKey(ReqId) Then
-                            Result.Add("缺少前置 Mod：" & ReqId & If(VersionRequire = "", "", "，其版本" & VersionRequire) & "。" & vbCrLf & " - " & ModEntity.FileName)
+                            Result.Add($"缺少前置 Mod：{ReqId}{If(VersionRequire = "", "", "，其版本" & VersionRequire)}。{vbCrLf} - {ModEntity.FileName}")
                             Continue For
                         End If
                         Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
@@ -1239,7 +1240,7 @@ Finished:
                         If ReqVersionHead.Contains(".") Then
                             If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
                                 Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf &
-                                           " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置：" & CurrentDependencies(ReqId)(1), ""))
+                                           " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置：{CurrentDependencies(ReqId)(1)}", ""))
                                 Continue For
                             End If
                         End If
@@ -1247,26 +1248,26 @@ Finished:
                         If ReqVersionTail.Contains(".") Then
                             If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
                                 Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf &
-                                           " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置：" & CurrentDependencies(ReqId)(1), ""))
+                                           " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置：{CurrentDependencies(ReqId)(1)}", ""))
                                 Continue For
                             End If
                         End If
                     Else
                         If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
-                            Result.Add("缺少前置 Mod：" & Dependency.Key & "。" & vbCrLf & " - " & ModEntity.FileName)
+                            Result.Add($"缺少前置 Mod：{Dependency.Key}。{vbCrLf} - {ModEntity.FileName}")
                             Continue For
                         End If
                     End If
                 Next
             Catch ex As Exception
-                Result.Add("检查 Mod 时出错：" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
+                Result.Add($"检查 Mod 时出错：{ex.GetBrief()}{vbCrLf} - {ModEntity.FileName}")
                 Log(ex, "检查 Mod 时出错")
             End Try
         Next
         If Not Result.Any() Then
             Log("[Minecraft] Mod 检查未发现异常")
         Else
-            Log("[Minecraft] Mod 检查异常结果：" & vbCrLf & Join(Result, vbCrLf))
+            Log($"[Minecraft] Mod 检查异常结果：{vbCrLf}{Join(Result, vbCrLf)}")
         End If
         Return Result
     End Function

Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb

@@ -31,7 +31,7 @@ Public Module ModModpack
         Try
             '字符校验
             Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
-            If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Critical) : Throw New CancelledException
+            If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New CancelledException
             '获取整合包种类与关键 Json
             Dim PackType As Integer = -1
             Try
@@ -72,7 +72,7 @@ Public Module ModModpack
                     If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
                 Next
             Catch ex As Exception
-                If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
+                If ex.GetDetail(True).Contains("Error.WinIOError") Then
                     Throw New Exception("打开整合包文件失败", ex)
                 ElseIf File.EndsWithF(".rar", True) Then
                     Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex)
@@ -158,6 +158,7 @@ Retry:
         If File.Exists(OverridesIni) Then
             WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
             WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
+            WriteIni(OverridesIni, "IsStar", False)
             CopyFile(OverridesIni, VersionIni) '覆写已有的 ini
         Else
             WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
@@ -165,6 +166,15 @@ Retry:
         End If
         IniClearCache(VersionIni) '重置缓存，避免被安装过程中写入的 ini 覆盖
     End Sub
+    ''' <summary>
+    ''' 弹窗提示整合包中存在不兼容的加载器。
+    ''' 如果取消，则抛出 CancelledException。
+    ''' </summary>
+    ''' <exception cref="CancelledException" />
+    Private Sub NotifyIncompatibleLoader(LoaderName As String)
+        If MyMsgBox($"整合包中存在不兼容的加载器：{LoaderName}{vbCrLf}如果你知道如何手动安装它，可以先选择跳过，然后在整合包下载结束后手动安装。",
+            "不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
+    End Sub
 
 #Region "不同类型整合包的安装方法"
 
@@ -210,7 +220,8 @@ Retry:
                 Log("[ModPack] 整合包 Fabric 版本：" & Id)
                 FabricVersion = Id.Replace("fabric-", "")
             Else
-                Log("[ModPack] 未知 Mod 加载器：" & Id)
+                'ElseIf Id.StartsWithF("quilt-") Then
+                NotifyIncompatibleLoader(Id)
             End If
         Next
         '解压
@@ -324,7 +335,7 @@ Retry:
                     File.Delete(Target)
                 End If
             Next
-            If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
+            If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
                 Log("[ModPack] 删除安装整合包文件：" & FileAddress)
                 File.Delete(FileAddress)
             End If
@@ -333,7 +344,7 @@ Retry:
         '重复任务检查
         Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中！", HintType.Critical)
+            Hint("该整合包正在安装中！", HintType.Red)
             Throw New CancelledException
         End If
 
@@ -375,12 +386,9 @@ Retry:
                 Case "fabric-loader" 'eg. 0.14.14
                     FabricVersion = Entry.Value.ToString
                     Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion)
-                Case "quilt-loader" 'eg. 1.0.0
-                    Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
-                    Throw New CancelledException
                 Case Else
-                    Hint($"无法安装整合包，其中出现了未知的 Mod 加载器 {Entry.Value}！", HintType.Critical)
-                    Throw New CancelledException
+                    'Case "quilt-loader" 'eg. 1.0.0
+                    NotifyIncompatibleLoader(Entry.Name)
             End Select
         Next
         '获取版本名
@@ -468,7 +476,7 @@ Retry:
                     File.Delete(Target)
                 End If
             Next
-            If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
+            If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
                 Log("[ModPack] 删除安装整合包文件：" & FileAddress)
                 File.Delete(FileAddress)
             End If
@@ -477,7 +485,7 @@ Retry:
         '重复任务检查
         Dim LoaderName As String = $"Modrinth 整合包安装：{VersionName} "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中！", HintType.Critical)
+            Hint("该整合包正在安装中！", HintType.Red)
             Throw New CancelledException
         End If
 
@@ -532,7 +540,7 @@ Retry:
         '重复任务检查
         Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中！", HintType.Critical)
+            Hint("该整合包正在安装中！", HintType.Red)
             Throw New CancelledException
         End If
         '启动
@@ -631,8 +639,9 @@ Retry:
         '构造版本安装请求
         If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！")
         Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
-        For Each Component In PackJson("components")
-            Select Case If(Component("uid"), "").ToString
+        For Each Component As JObject In PackJson("components")
+            If Not Component.ContainsKey("uid") Then Continue For
+            Select Case Component("uid").ToString
                 Case "org.lwjgl"
                     Log("[ModPack] 已跳过 LWJGL 项")
                 Case "net.minecraft"
@@ -643,9 +652,9 @@ Retry:
                     Request.NeoForgeVersion = Component("version")
                 Case "net.fabricmc.fabric-loader"
                     Request.FabricVersion = Component("version")
-                Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
-                    Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
-                    Throw New CancelledException
+                Case Else
+                    'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
+                    NotifyIncompatibleLoader(Component("uid"))
             End Select
         Next
         '构造加载器
@@ -658,7 +667,7 @@ Retry:
         '重复任务检查
         Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中！", HintType.Critical)
+            Hint("该整合包正在安装中！", HintType.Red)
             Throw New CancelledException
         End If
 
@@ -716,7 +725,7 @@ Retry:
         Next
         If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
         If Addons.ContainsKey("quilt") Then
-            Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
+            Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Red)
             Throw New CancelledException
         End If
         Dim Request As New McInstallRequest With {
@@ -737,7 +746,7 @@ Retry:
         '重复任务检查
         Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中！", HintType.Critical)
+            Hint("该整合包正在安装中！", HintType.Red)
             Throw New CancelledException
         End If
 
@@ -757,7 +766,7 @@ Retry:
         MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
         Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
         If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
-        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException
+        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
         '解压
         Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
             New LoaderTask(Of String, Integer)("解压压缩包",
@@ -786,7 +795,7 @@ Retry:
                     Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
                     If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
                         OpenExplorer(TargetFolder)
-                        ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
+                        StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
                         Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
                         FrmMain.EndProgram(False)
                         Return
@@ -834,8 +843,8 @@ Retry:
         MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
         Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
         If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
-        If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Throw New CancelledException
-        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException
+        If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New CancelledException
+        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
         '解压
         Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
             New LoaderTask(Of String, Integer)("解压压缩包",

Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb

@@ -349,7 +349,7 @@
             State = MinecraftState.Crashed
             '崩溃分析
             WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析")
-            Hint("检测到 Minecraft 出现错误，错误分析已开始……", HintType.Critical)
+            Hint("检测到 Minecraft 出现错误，错误分析已开始……", HintType.Red)
             FeedbackInfo()
             RunInNewThread(
             Sub()

Plain Craft Launcher 2/Modules/ModEvent.vb

@@ -1,129 +1,305 @@
-Public Module ModEvent
+
+#Region "附加属性"
 
-    Public Sub TryStartEvent(Type As String, Data As String)
-        If String.IsNullOrWhiteSpace(Type) Then Return
-        Dim RealData As String() = {""}
-        If Data IsNot Nothing Then RealData = Data.Split("|")
-        StartEvent(Type, RealData)
+''' <summary>
+''' 用于在 XAML 中初始化列表对象。
+''' 附加属性无法在 XAML 中为每个对象初始化独立的列表对象，因此需要一个包装类，然后在 XAML 中显式初始化。
+''' </summary>
+<Markup.ContentProperty("Events")>
+Public Class CustomEventCollection
+    Implements IEnumerable(Of CustomEvent)
+    Dim _Events As New List(Of CustomEvent)
+    Public ReadOnly Property Events As List(Of CustomEvent)
+        Get
+            Return _Events
+        End Get
+    End Property
+    Public Function GetEnumerator() As IEnumerator(Of CustomEvent) Implements IEnumerable(Of CustomEvent).GetEnumerator
+        Return DirectCast(Events, IEnumerable(Of CustomEvent)).GetEnumerator()
+    End Function
+    Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
+        Return DirectCast(Events, IEnumerable).GetEnumerator()
+    End Function
+End Class
+
+''' <summary>
+''' 提供自定义事件的附加属性。
+''' </summary>
+Public Class CustomEventService
+
+    'Events
+    Public Shared ReadOnly EventsProperty As DependencyProperty =
+            DependencyProperty.RegisterAttached("Events", GetType(CustomEventCollection), GetType(CustomEventService), New PropertyMetadata(Nothing))
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Sub SetEvents(d As DependencyObject, value As CustomEventCollection)
+        d.SetValue(EventsProperty, value)
     End Sub
-    Public Sub StartEvent(Type As String, Data As String())
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Function GetEvents(d As DependencyObject) As CustomEventCollection
+        If d.GetValue(EventsProperty) Is Nothing Then d.SetValue(EventsProperty, New CustomEventCollection)
+        Return d.GetValue(EventsProperty)
+    End Function
+
+    'EventType
+    Public Shared ReadOnly EventTypeProperty As DependencyProperty =
+            DependencyProperty.RegisterAttached("EventType", GetType(CustomEvent.EventType), GetType(CustomEventService), New PropertyMetadata(Nothing))
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Sub SetEventType(d As DependencyObject, value As CustomEvent.EventType)
+        d.SetValue(EventTypeProperty, value)
+    End Sub
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Function GetEventType(d As DependencyObject) As CustomEvent.EventType
+        Return d.GetValue(EventTypeProperty)
+    End Function
+
+    'EventData
+    Public Shared ReadOnly EventDataProperty As DependencyProperty =
+            DependencyProperty.RegisterAttached("EventData", GetType(String), GetType(CustomEventService), New PropertyMetadata(Nothing))
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Sub SetEventData(d As DependencyObject, value As String)
+        d.SetValue(EventDataProperty, value)
+    End Sub
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Function GetEventData(d As DependencyObject) As String
+        Return d.GetValue(EventDataProperty)
+    End Function
+
+End Class
+
+Partial Public Module ModMain
+
+    ''' <summary>
+    ''' 触发该控件上的自定义事件。
+    ''' 事件会在新线程中执行。
+    ''' </summary>
+    <Runtime.CompilerServices.Extension>
+    Public Sub RaiseCustomEvent(Control As DependencyObject)
+        '收集事件列表
+        Dim Events = CustomEventService.GetEvents(Control).ToList
+        Dim EventType = CustomEventService.GetEventType(Control)
+        If EventType <> CustomEvent.EventType.None Then Events.Add(New CustomEvent(EventType, CustomEventService.GetEventData(Control)))
+        '执行事件
+        If Not Events.Any Then Return
+        RunInNewThread(
+        Sub()
+            For Each e In Events
+                e.Raise()
+            Next
+        End Sub, "执行自定义事件 " & GetUuid())
+    End Sub
+
+End Module
+
+#End Region
+
+''' <summary>
+''' 自定义事件。
+''' </summary>
+Public Class CustomEvent
+
+#Region "属性与触发"
+
+    Public Property Type As EventType = EventType.None
+    Public Property Data As String = Nothing
+    Public Sub New()
+    End Sub
+    Public Sub New(Type As EventType, Data As String)
+        Me.Type = Type
+        Me.Data = Data
+    End Sub
+
+    ''' <summary>
+    ''' 在当前线程中触发该自定义事件。
+    ''' </summary>
+    Public Sub Raise()
+        Raise(Type, Data)
+    End Sub
+
+#End Region
+
+    Public Enum EventType
+        None = 0
+        打开网页
+        打开文件
+        打开帮助
+        执行命令
+        启动游戏
+        复制文本
+        刷新主页
+        刷新页面
+        刷新帮助
+        今日人品
+        内存优化
+        清理垃圾
+        弹出窗口
+        弹出提示
+        切换页面
+        导入整合包
+        安装整合包
+        下载文件
+        修改设置
+        写入设置
+        修改变量
+        写入变量
+        加入房间
+    End Enum
+
+    ''' <summary>
+    ''' 在当前线程中触发一个自定义事件。
+    ''' </summary>
+    Public Shared Sub Raise(Type As EventType, Arg As String)
+        If Type = EventType.None Then Return
+        Log($"[Control] 执行自定义事件：{Type}, {Arg}")
         Try
-            Log("[Control] 执行自定义事件：" & Type & ", " & Join(Data, ", "))
+            Dim Args As String() = If(Arg?.Split("|"), {""})
             Select Case Type
 
-                Case "打开网页"
-                    Data(0) = Data(0).Replace("\", "/")
-                    If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议（#2200）
+                Case EventType.打开网页
+                    Arg = Arg.Replace("\", "/")
+                    If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议（#2200）
                         MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序，请将 EventType 改为 打开文件。", "事件执行失败")
                         Return
                     End If
-                    Hint("正在开启中，请稍候……")
-                    OpenWebsite(Data(0))
+                    Hint("正在开启中，请稍候：" & Arg)
+                    RunInThread(Sub() OpenWebsite(Arg))
 
-                Case "打开文件", "打开帮助", "执行命令"
+                Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
                     RunInThread(
                     Sub()
                         Try
                             '确认实际路径
-                            Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
+                            Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
                             Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
                             Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
                             '执行
-                            If Type = "打开帮助" Then
+                            If Type = EventType.打开帮助 Then
                                 PageOtherHelp.EnterHelpPage(Location)
                             Else
-                                If Not Setup.Get("HintCustomCommand") Then
-                                    Select Case MyMsgBox(
-                                    "即将执行：" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
-                                    "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
-                                        Case 2
-                                            Setup.Set("HintCustomCommand", True)
-                                        Case 3
-                                            Return
-                                    End Select
-                                End If
+                                If Not EventSafetyConfirm("即将执行：" & Location & If(Args.Length >= 2, " " & Args(1), "")) Then Return
                                 Dim Info As New ProcessStartInfo With {
-                                    .Arguments = If(Data.Length >= 2, Data(1), ""),
+                                    .Arguments = If(Args.Length >= 2, Args(1), ""),
                                     .FileName = Location,
-                                    .WorkingDirectory = ShortenPath(WorkingDir)
+                                    .WorkingDirectory = WorkingDir
                                 }
-                                Process.Start(Info)
+                                StartProcess(Info)
                             End If
                         Catch ex As Exception
                             Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
                         End Try
                     End Sub)
 
-                Case "启动游戏"
-                    If Data(0) = "\current" Then
+                Case EventType.启动游戏
+                    If Args(0) = "\current" Then
                         If McVersionCurrent Is Nothing Then
-                            Hint("请先选择一个 Minecraft 版本！", HintType.Critical)
+                            Hint("请先选择一个 Minecraft 版本！", HintType.Red)
                             Return
                         Else
-                            Data(0) = McVersionCurrent.Name
+                            Args(0) = McVersionCurrent.Name
                         End If
                     End If
-                    If McLaunchStart(New McLaunchOptions With
-                                     {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
-                        Hint("正在启动 " & Data(0) & "……")
+                    RunInUi(
+                    Sub()
+                        If McLaunchStart(New McLaunchOptions With
+                                {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Version = New McVersion(Args(0))}) Then
+                            Hint($"正在启动 {Args(0)}……")
+                        End If
+                    End Sub)
+
+                Case EventType.复制文本
+                    ClipboardSet(Arg)
+
+                Case EventType.刷新主页
+                    RunInUi(
+                    Sub()
+                        FrmLaunchRight.ForceRefresh()
+                        If String.IsNullOrEmpty(Arg) Then Hint("已刷新！", HintType.Green)
+                    End Sub)
+
+                Case EventType.刷新页面
+                    If TypeOf FrmMain.PageRight Is IRefreshable Then
+                        RunInUiWait(Sub() CType(FrmMain.PageRight, IRefreshable).Refresh())
+                        If String.IsNullOrEmpty(Arg) Then Hint("已刷新！", HintType.Green)
+                    Else
+                        Hint("当前页面不支持刷新操作！", HintType.Red)
                     End If
 
-                Case "复制文本"
-                    ClipboardSet(Join(Data, "|"))
+                Case EventType.刷新帮助
+                    RunInUiWait(Sub() PageOtherLeft.RefreshHelp())
+                    If String.IsNullOrEmpty(Arg) Then Hint("已刷新！", HintType.Green)
 
-                Case "刷新主页"
-                    FrmLaunchRight.ForceRefresh()
-                    If Data(0) = "" Then Hint("已刷新主页！", HintType.Finish)
-
-                Case "刷新帮助"
-                    PageOtherLeft.RefreshHelp()
-
-                Case "今日人品"
+                Case EventType.今日人品
                     PageOtherTest.Jrrp()
 
-                Case "内存优化"
+                Case EventType.内存优化
                     RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
 
-                Case "清理垃圾"
+                Case EventType.清理垃圾
                     RunInThread(Sub() PageOtherTest.RubbishClear())
 
-                Case "弹出窗口"
-                    MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
+                Case EventType.弹出窗口
+                    If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数，例如 弹窗标题|弹窗内容")
+                    MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
 
-                Case "切换页面"
-                    FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
+                Case EventType.弹出提示
+                    Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ParseToEnum(Of HintType)))
 
-                Case "导入整合包", "安装整合包"
+                Case EventType.切换页面
+                    RunInUi(Sub() FrmMain.PageChange(
+                                Args(0).ParseToEnum(Of FormMain.PageType),
+                                If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ParseToEnum(Of FormMain.PageSubType))))
+
+                Case EventType.导入整合包, EventType.安装整合包
                     RunInUi(Sub() ModpackInstall())
 
-                Case "下载文件"
-                    Data(0) = Data(0).Replace("\", "/")
-                    If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
+                Case EventType.下载文件
+                    Args(0) = Args(0).Replace("\", "/")
+                    If Not (Args(0).StartsWithF("http://", True) OrElse Args(0).StartsWithF("https://", True)) Then
                         MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
                         Return
                     End If
-                    Try
-                        Select Case Data.Length
-                            Case 1
-                                PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
-                            Case 2
-                                PageOtherTest.StartCustomDownload(Data(0), Data(1))
-                            Case Else
-                                PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
-                        End Select
-                    Catch
-                        PageOtherTest.StartCustomDownload(Data(0), "未知")
-                    End Try
+                    If Not EventSafetyConfirm("即将从该网址下载文件：" & vbCrLf & Args(0)) Then Return
+                    RunInUi(
+                    Sub()
+                        Try
+                            Select Case Args.Length
+                                Case 1
+                                    PageOtherTest.StartCustomDownload(Args(0), GetFileNameFromPath(Args(0)))
+                                Case 2
+                                    PageOtherTest.StartCustomDownload(Args(0), Args(1))
+                                Case Else
+                                    PageOtherTest.StartCustomDownload(Args(0), Args(1), Args(2))
+                            End Select
+                        Catch
+                            PageOtherTest.StartCustomDownload(Args(0), "未知")
+                        End Try
+                    End Sub)
 
-                Case "修改设置"
-                    Setup.Set(Data(0), Data(1))
-                    Hint($"已写入设置：{Data(0)} → {Data(1)}", HintType.Finish)
+                Case EventType.修改设置, EventType.写入设置
+                    If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数，例如 UiLauncherTransparent|400")
+                    Setup.SetSafe(Args(0), Args(1), Version:=McVersionCurrent)
+                    If Args.Length = 2 Then Hint($"已写入设置：{Args(0)} → {Args(1)}", HintType.Green)
+
+                Case EventType.修改变量, EventType.写入变量
+                    If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数，例如 VariableName|SomeValue")
+                    WriteReg("CustomEvent" & Args(0), Args(1))
+                    If Args.Length = 2 Then Hint($"已写入变量：{Args(0)} → {Args(1)}", HintType.Green)
+
+                Case EventType.加入房间
+                    RunInUi(
+                    Sub()
+                        If String.IsNullOrWhiteSpace(Arg) Then
+                            PageLinkMain.Join()
+                        Else
+                            If Not EventSafetyConfirm("即将加入第三方联机房间。") Then Return
+                            PageLinkMain.Join(Arg)
+                        End If
+                    End Sub)
 
                 Case Else
                     MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败")
             End Select
         Catch ex As Exception
-            Log(ex, "事件执行失败", LogLevel.Msgbox)
+            Log(ex, $"事件执行失败（{Type}, {Arg}）", LogLevel.Msgbox)
         End Try
     End Sub
 
@@ -131,7 +307,7 @@
     ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
     ''' 失败会抛出异常。
     ''' </summary>
-    Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
+    Public Shared Function GetAbsoluteUrls(RelativeUrl As String, Type As EventType) As String()
 
         '网页确认
         If RelativeUrl.StartsWithF("http", True) Then
@@ -172,25 +348,25 @@
         If RelativeUrl.Contains(":\") Then
             '绝对路径
             Location = RelativeUrl
-            Log("[Control] 自定义事件中由绝对路径" & EventType & "：" & Location)
+            Log("[Control] 自定义事件中由绝对路径" & Type & "：" & Location)
         ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
             '相对 PCL 文件夹的路径
             Location = Path & "PCL\" & RelativeUrl
-            Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & "：" & Location)
+            Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & Type & "：" & Location)
         ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
             '相对 PCL 本地帮助文件夹的路径
             Location = Path & "PCL\Help\" & RelativeUrl
             WorkingDir = Path & "PCL\Help\"
-            Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & "：" & Location)
-        ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
+            Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & Type & "：" & Location)
+        ElseIf Type = EventType.打开帮助 AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
             '相对 PCL 自带帮助文件夹的路径
             Location = PathTemp & "Help\" & RelativeUrl
             WorkingDir = PathTemp & "Help\"
-            Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & "：" & Location)
-        ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
+            Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & Type & "：" & Location)
+        ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
             '直接使用原有路径启动程序
             Location = RelativeUrl
-            Log("[Control] 自定义事件中直接" & EventType & "：" & Location)
+            Log("[Control] 自定义事件中直接" & Type & "：" & Location)
         Else
             '打开帮助，但是格式不对劲
             Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件：" & RelativeUrl, RelativeUrl)
@@ -199,4 +375,20 @@
         Return {Location, WorkingDir}
     End Function
 
-End Module
+    ''' <summary>
+    ''' 弹出安全确认弹窗。返回是否继续执行。
+    ''' </summary>
+    Private Shared Function EventSafetyConfirm(Message As String) As Boolean
+        If Setup.Get("HintCustomCommand") Then Return True
+        Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
+            Case 1
+                Return True
+            Case 2
+                Setup.Set("HintCustomCommand", True)
+                Return True
+            Case Else
+                Return False
+        End Select
+    End Function
+
+End Class

Plain Craft Launcher 2/Modules/ModMain.vb

@@ -7,23 +7,12 @@ Public Module ModMain
 
     ''' <summary>
     ''' 提示信息的种类。
+    ''' 该枚举在自定义事件中使用，是公开 API 的一部分。
     ''' </summary>
     Public Enum HintType
-        ''' <summary>
-        ''' 信息，通常是蓝色的“i”。
-        ''' </summary>
-        ''' <remarks></remarks>
-        Info
-        ''' <summary>
-        ''' 已完成，通常是绿色的“√”。
-        ''' </summary>
-        ''' <remarks></remarks>
-        Finish
-        ''' <summary>
-        ''' 错误，通常是红色的“×”。
-        ''' </summary>
-        ''' <remarks></remarks>
-        Critical
+        Blue
+        Green
+        Red
     End Enum
     Private Structure HintMessage
         Public Text As String
@@ -38,7 +27,7 @@ Public Module ModMain
     ''' <summary>
     ''' 在窗口左下角弹出提示文本。
     ''' </summary>
-    Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
+    Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
         If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
         HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
     End Sub
@@ -68,13 +57,13 @@ Public Module ModMain
                 Dim TargetColor0, TargetColor1 As MyColor
                 Dim Percent As Double = 0.3
                 Select Case CurrentHint.Type
-                    Case HintType.Info
+                    Case HintType.Blue
                         TargetColor0 = New MyColor(215, 37, 155, 252)
                         TargetColor1 = New MyColor(215, 10, 142, 252)
-                    Case HintType.Finish
+                    Case HintType.Green
                         TargetColor0 = New MyColor(215, 33, 177, 33)
                         TargetColor1 = New MyColor(215, 29, 160, 29)
-                    Case Else 'HintType.Critical
+                    Case Else 'HintType.Red
                         TargetColor0 = New MyColor(215, 255, 53, 11)
                         TargetColor1 = New MyColor(215, 255, 43, 0)
                 End Select
@@ -248,10 +237,6 @@ EndHint:
         '将弹窗列入队列
         Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
         WaitingMyMsgBox.Add(Converter)
-        If RunInUi() Then
-            '若为 UI 线程，立即执行弹窗刻， 避免快速（连点器）点击时多次弹窗
-            MyMsgBoxTick()
-        End If
         If Button2.Length > 0 OrElse ForceWait Then
             '若有多个按钮则开始等待
             If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
@@ -275,6 +260,7 @@ EndHint:
             Else
                 Try
                     FrmMain.DragStop()
+                    If RunInUi() Then MyMsgBoxTick()
                     ComponentDispatcher.PushModal()
                     Dispatcher.PushFrame(Converter.WaitFrame)
                 Finally
@@ -306,6 +292,7 @@ EndHint:
         '虽然我也不知道这是啥但是能用就成了 :)
         Try
             If FrmMain IsNot Nothing Then FrmMain.DragStop()
+            If RunInUi() Then MyMsgBoxTick()
             ComponentDispatcher.PushModal()
             Dispatcher.PushFrame(Converter.WaitFrame)
         Finally
@@ -328,6 +315,7 @@ EndHint:
         '虽然我也不知道这是啥但是能用就成了 :)
         Try
             If FrmMain IsNot Nothing Then FrmMain.DragStop()
+            If RunInUi() Then MyMsgBoxTick()
             ComponentDispatcher.PushModal()
             Dispatcher.PushFrame(Converter.WaitFrame)
         Finally
@@ -350,7 +338,7 @@ EndHint:
             ElseIf WaitingMyMsgBox.Any Then
                 '没有弹窗，显示一个等待的弹窗
                 FrmMain.PanMsg.Visibility = Visibility.Visible
-                Select Case CType(WaitingMyMsgBox(0), MyMsgBoxConverter).Type
+                Select Case WaitingMyMsgBox(0).Type
                     Case MyMsgBoxType.Input
                         FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
                     Case MyMsgBoxType.Select
@@ -363,7 +351,7 @@ EndHint:
                 WaitingMyMsgBox.RemoveAt(0)
             Else
                 '没有弹窗，没有等待的弹窗
-                If Not FrmMain.PanMsg.Visibility = Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
+                If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
             End If
         Catch ex As Exception
             Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback)
@@ -388,21 +376,11 @@ EndHint:
     Public FrmSpeedRight As PageSpeedRight
 
     '联机页面声明
-    Public FrmLinkLeft As PageLinkLeft
-    Public FrmLinkIoi As PageLinkIoi
-    Public FrmLinkHiper As PageLinkHiper
-    Public FrmLinkHelp As PageOtherHelpDetail
-    Public FrmLinkFeedback As PageLinkFeedback
+    Public FrmLinkMain As PageLinkMain
 
     '下载页面声明
     Public FrmDownloadLeft As PageDownloadLeft
     Public FrmDownloadInstall As PageDownloadInstall
-    Public FrmDownloadClient As PageDownloadClient
-    Public FrmDownloadOptiFine As PageDownloadOptiFine
-    Public FrmDownloadLiteLoader As PageDownloadLiteLoader
-    Public FrmDownloadForge As PageDownloadForge
-    Public FrmDownloadNeoForge As PageDownloadNeoForge
-    Public FrmDownloadFabric As PageDownloadFabric
     Public FrmDownloadMod As PageDownloadMod
     Public FrmDownloadPack As PageDownloadPack
     Public FrmDownloadDataPack As PageDownloadDataPack
@@ -496,7 +474,7 @@ EndHint:
         ''' 是否为 “执行事件”。
         ''' </summary>
         Public IsEvent As Boolean
-        Public EventType As String
+        Public EventType As CustomEvent.EventType
         Public EventData As String
         ''' <summary>
         ''' 若非执行事件，其对应的 .xaml 本地文件内容。
@@ -510,7 +488,7 @@ EndHint:
         ''' </summary>
         Public Sub New(FilePath As String)
             RawPath = FilePath
-            Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
+            Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeXML))
             If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
             '加载常规信息
             If JsonData("Title") IsNot Nothing Then
@@ -530,8 +508,7 @@ EndHint:
             Next
             '加载事件信息
             If If(JsonData("IsEvent"), False) Then
-                EventType = JsonData("EventType")
-                If EventType Is Nothing Then Throw New ArgumentException("未找到 EventType 项")
+                EventType = [Enum].Parse(GetType(CustomEvent.EventType), JsonData("EventType").ToString)
                 EventData = If(JsonData("EventData"), "")
                 IsEvent = True
             Else
@@ -556,7 +533,7 @@ EndHint:
         Public Function SetToListItem(Item As MyListItem) As MyListItem
             Dim Logo As String
             If IsEvent Then
-                If EventType = "弹出窗口" Then
+                If EventType = CustomEvent.EventType.弹出窗口 Then
                     Logo = PathImage & "Blocks/GrassPath.png"
                 Else
                     Logo = PathImage & "Blocks/CommandBlock.png"
@@ -573,9 +550,9 @@ EndHint:
                 .Height = 42
                 .Type = MyListItem.CheckType.Clickable
                 .Tag = Me
-                .EventType = Nothing
-                .EventData = Nothing
             End With
+            CustomEventService.SetEventType(Item, CustomEvent.EventType.None) '清空自定义事件属性，它们会被下面的点击事件处理
+            CustomEventService.SetEventData(Item, Nothing)
             '项目的点击事件
             AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
             Return Item
@@ -675,15 +652,6 @@ NextFile:
             Log("[Help] 已解压内置帮助文件，目前状态：" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
         End If
     End Sub
-    ''' <summary>
-    ''' 对帮助文件约定的替换标记进行处理，如果遇到需要转义的字符会进行转义。
-    ''' </summary>
-    Public Function HelpArgumentReplace(Xaml As String) As String
-        Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
-        Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
-        Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
-        Return Result
-    End Function
 
 #End Region
 
@@ -842,6 +810,79 @@ NextFile:
         End Using
     End Sub
 
+    ''' <summary>
+    ''' 对替换标记进行处理。会对替换内容使用 EscapeHandler 进行转义。
+    ''' </summary>
+    Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String
+        '预处理
+        If Text Is Nothing Then Return Nothing
+        Dim Replacer =
+        Function(s As String) As String
+            If s Is Nothing Then Return ""
+            If EscapeHandler Is Nothing Then Return s
+            If s.Contains(":\") Then s = ShortenPath(s)
+            Return EscapeHandler(s)
+        End Function
+        '基础
+        Text = Text.Replace("{pcl_version}", Replacer(VersionBaseName))
+        Text = Text.Replace("{pcl_version_code}", Replacer(VersionCode))
+        Text = Text.Replace("{pcl_version_branch}", Replacer(VersionBranchName))
+        Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
+        Text = Text.Replace("{identify}", Replacer(Identify))
+        Text = Text.Replace("{path}", Replacer(Path))
+        Text = Text.Replace("{path_with_name}", Replacer(PathWithName))
+        Text = Text.Replace("{path_temp}", Replacer(PathTemp))
+        '时间
+        If ReplaceTime Then '在窗口标题中，时间会被后续动态替换，所以此时不应该替换
+            Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy/M/d")))
+            Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH:mm:ss")))
+        End If
+        'Minecraft
+        Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
+        Text = Text.Replace("{minecraft}", Replacer(PathMcFolder))
+        If McVersionCurrent IsNot Nothing Then
+            Text = Text.Replace("{version_path}", Replacer(McVersionCurrent.Path)) : Text = Text.Replace("{verpath}", Replacer(McVersionCurrent.Path))
+            Text = Text.Replace("{version_indie}", Replacer(McVersionCurrent.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McVersionCurrent.PathIndie))
+            Text = Text.Replace("{name}", Replacer(McVersionCurrent.Name))
+            If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then
+                Text = Text.Replace("{version}", Replacer(McVersionCurrent.Name))
+            Else
+                Text = Text.Replace("{version}", Replacer(McVersionCurrent.Version.McName))
+            End If
+        Else
+            Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
+            Text = Text.Replace("{version_indie}", Replacer(Nothing)) : Text = Text.Replace("{verindie}", Replacer(Nothing))
+            Text = Text.Replace("{name}", Replacer(Nothing))
+            Text = Text.Replace("{version}", Replacer(Nothing))
+        End If
+        '登录信息
+        If McLoginLoader.State = LoadState.Finished Then
+            Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name))
+            Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.ToLower))
+            Select Case McLoginLoader.Input.Type
+                Case McLoginType.Legacy
+                    Text = Text.Replace("{login}", Replacer("离线"))
+                Case McLoginType.Ms
+                    Text = Text.Replace("{login}", Replacer("正版"))
+                Case McLoginType.Nide
+                    Text = Text.Replace("{login}", Replacer("统一通行证"))
+                Case McLoginType.Auth
+                    Text = Text.Replace("{login}", Replacer("Authlib-Injector"))
+            End Select
+        Else
+            Text = Text.Replace("{user}", Replacer(Nothing))
+            Text = Text.Replace("{uuid}", Replacer(Nothing))
+            Text = Text.Replace("{login}", Replacer(Nothing))
+        End If
+        '高级
+        Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
+        Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
+        Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Setup.GetSafe(m.Groups(1).Value, McVersionCurrent)))
+        Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
+        Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
+        Return Text
+    End Function
+
 #End Region
 
 #Region "任务缓存"

Plain Craft Launcher 2/Modules/ModMusic.vb

@@ -30,7 +30,7 @@
                 Next
             End If
             '打乱顺序播放
-            MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
+            MusicWaitingList = If(Setup.Get("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList))
             If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
                 '若需要避免成为第一项的为第一项，则将它放在最后
                 MusicWaitingList.RemoveAt(0)
@@ -79,7 +79,7 @@
                     If MusicState = MusicStates.Pause Then
                         FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
                         FrmMain.BtnExtraMusic.LogoScale = 0.8
-                        ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
+                        ToolTipText = "已暂停：" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
                         If MusicAllList.Count > 1 Then
                             ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
                         Else
@@ -88,7 +88,7 @@
                     Else
                         FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
                         FrmMain.BtnExtraMusic.LogoScale = 1
-                        ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
+                        ToolTipText = "正在播放：" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
                         If MusicAllList.Count > 1 Then
                             ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
                         Else
@@ -111,7 +111,7 @@
     ''' </summary>
     Public Sub MusicControlPause()
         If MusicNAudio Is Nothing Then
-            Hint("音乐播放尚未开始！", HintType.Critical)
+            Hint("音乐播放尚未开始！", HintType.Red)
         Else
             Select Case MusicState
                 Case MusicStates.Pause
@@ -131,14 +131,14 @@
     Public Sub MusicControlNext()
         If MusicAllList.Count = 1 Then
             MusicStartPlay(MusicCurrent)
-            Hint("重新播放：" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
+            Hint("重新播放：" & GetFileNameFromPath(MusicCurrent), HintType.Green)
         Else
             Dim Address As String = DequeueNextMusicAddress()
             If Address Is Nothing Then
-                Hint("没有可以播放的音乐！", HintType.Critical)
+                Hint("没有可以播放的音乐！", HintType.Red)
             Else
                 MusicStartPlay(Address)
-                Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Finish)
+                Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Green)
             End If
         End If
         MusicRefreshUI()
@@ -182,19 +182,19 @@
             MusicListInit(True)
             If Not MusicAllList.Any() Then
                 If MusicNAudio Is Nothing Then
-                    If ShowHint Then Hint("未检测到可用的背景音乐！", HintType.Critical)
+                    If ShowHint Then Hint("未检测到可用的背景音乐！", HintType.Red)
                 Else
                     MusicNAudio = Nothing
-                    If ShowHint Then Hint("背景音乐已清除！", HintType.Finish)
+                    If ShowHint Then Hint("背景音乐已清除！", HintType.Green)
                 End If
             Else
                 Dim Address As String = DequeueNextMusicAddress()
                 If Address Is Nothing Then
-                    If ShowHint Then Hint("没有可以播放的音乐！", HintType.Critical)
+                    If ShowHint Then Hint("没有可以播放的音乐！", HintType.Red)
                 Else
                     Try
                         MusicStartPlay(Address, IsFirstLoad)
-                        If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Finish, False)
+                        If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Green, False)
                     Catch
                     End Try
                 End If
@@ -303,18 +303,18 @@
         Catch ex As Exception
             Log(ex, "播放音乐出现内部错误（" & MusicCurrent & "）", LogLevel.Developer)
             If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
-                Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Critical)
+                Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Red)
                 Thread.Sleep(1000000000)
             End If
             If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
-                Hint("由于音频设备变更，音乐播放功能在重启 PCL 后才能恢复！", HintType.Critical)
+                Hint("由于音频设备变更，音乐播放功能在重启 PCL 后才能恢复！", HintType.Red)
                 Thread.Sleep(1000000000)
             End If
             If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
-                Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
+                Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Red)
             ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
                 ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
-                Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
+                Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
             Else
                 Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", LogLevel.Hint)
             End If

Plain Craft Launcher 2/Modules/ModSecret.vb

@@ -6,6 +6,8 @@ Friend Module ModSecret
 
 #Region "杂项"
 
+    '标注 PCL 的不同分支，仅用于替换标记
+    Public Const VersionBranchMain As String = "OpenSource"
     '在开源版的注册表与常规版的注册表隔离，以防数据冲突
     Public Const RegFolder As String = "PCLDebug"
     '用于微软登录的 ClientId
@@ -56,13 +58,13 @@ Friend Module ModSecret
     ''' <summary>
     ''' 获取设备标识码。
     ''' </summary>
-    Friend Function SecretGetUniqueAddress() As String
+    Friend Function SecretGetIdentify() As String
         Return "0000-0000-0000-0000"
     End Function
 
     Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
         Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
-        DataList.Insert(0, If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom)) '可变 JVM 参数
+        DataList.Insert(0, ArgumentReplace(If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom))) '可变 JVM 参数
         McLaunchLog("当前剩余内存：" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
         DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m")
         DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
@@ -80,15 +82,17 @@ Friend Module ModSecret
     ''' <summary>
     ''' 设置 Headers 的 UA、Referer。
     ''' </summary>
-    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
-            Req.Headers.Add("User-Agent", "LogStatistic")  '#4951
-        ElseIf UseBrowserUserAgent Then
-            Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
-        Else
-            Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
+    Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False)
+        If Not Req.Headers.UserAgent.Any Then
+            If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
+                Req.Headers.Add("User-Agent", "LogStatistic")  '#4951
+            ElseIf SimulateBrowserHeaders Then
+                Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
+            Else
+                Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
+            End If
         End If
-        Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
+        If Not SimulateBrowserHeaders Then 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
 
@@ -277,9 +281,16 @@ Friend Module ModSecret
 
 #End Region
 
-#Region "联网通知"
+#Region "联网配置"
 
-    Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal)
+    ''' <summary>
+    ''' 联网获取的配置信息。
+    ''' 若获取失败或仍在获取中，可能为 Nothing。
+    ''' </summary>
+    Public ServerConfig As JObject
+
+    Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 配置更新", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) With
+        {.ReloadTimeout = 1000 * 60 * 60} '超时 1 小时
 
 #End Region