2.13.1.0

2026-08-02 01:00:16 +08:00
parent c7ccdd65dc
commit 7fb6e5d68e
61 changed files with 3291 additions and 1165 deletions
@@ -79,7 +79,7 @@ Public Module ModAnimation
        ''' 已经执行的动画长度。如果为负数则为延迟。
        ''' </summary>
        ''' <remarks></remarks>
-        Public TimeFinished As Integer
+        Public TimeFinished As Double
        ''' <summary>
        ''' 已经完成的百分比。
        ''' </summary>
@@ -853,9 +853,8 @@ Sleeper:
    ''' <summary>
    ''' 动画定时器事件。
    ''' </summary>
-    Public Sub AniTimer(DeltaTick As Integer)
+    Public Sub AniTimer(DeltaTick As Double)
        Try
-
            If DeltaTick / AniSpeed > 100 Then Logger.Info($"两个动画帧间隔 {DeltaTick} ms")
            Dim i As Integer = -1
            '循环每个动画组
@@ -1034,6 +1033,7 @@ NextAni:
                    End If

                Case AniType.Code
+                    Ani.TimeFinished = Ani.TimeTotal
                    CType(Ani.Value, ThreadStart)()

                Case AniType.ScaleTransform
@@ -6,12 +6,12 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.13.0.1" '显示用版本名
+    Public Const VersionBaseName As String = "2.13.1.0" '显示用版本名
    Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If RELEASE Then
-    Public Const VersionCode As Integer = 406 '正式版
+    Public Const VersionCode As Integer = 408 '正式版
 #Else
-    Public Const VersionCode As Integer = 407 '快照版
+    Public Const VersionCode As Integer = 409 '快照版
 #End If

    '版本信息
@@ -465,57 +465,7 @@ Public Module ModBase

 #Region "文件"

-    '=============================
-    '  注册表
-    '=============================
-
-    ''' <summary>
-    ''' 读取注册表键。如果失败则返回默认值。
-    ''' </summary>
-    Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
-        Try
-            Return If(My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False)?.GetValue(Key), DefaultValue)
-        Catch ex As Exception
-            Logger.Error(ex, $"读取注册表出错：{Key}", LogBehavior.Toast)
-            Return DefaultValue
-        End Try
-    End Function
-    ''' <summary>
-    ''' 写入注册表键。
-    ''' </summary>
-    Public Sub WriteReg(Key As String, Value As String, Optional ThrowException As Boolean = False)
-        Try
-            Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
-            If SubKey Is Nothing Then SubKey = My.Computer.Registry.CurrentUser.CreateSubKey("Software\" & RegFolder) '如果不存在就创建  
-            SubKey.SetValue(Key, Value)
-        Catch ex As Exception
-            Logger.Warn(ex, $"写入注册表出错：{Key}", If(ThrowException, LogBehavior.Toast, LogBehavior.ToastIfDebug))
-            If ThrowException Then Throw
-        End Try
-    End Sub
-    ''' <summary>
-    ''' 是否存在某个注册表键。
-    ''' </summary>
-    Public Function HasReg(Key As String) As Boolean
-        Return ReadReg(Key, Nothing) IsNot Nothing
-    End Function
-    ''' <summary>
-    ''' 删除注册表键。
-    ''' </summary>
-    Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False)
-        Try
-            Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
-            If SubKey?.GetValue(Key) Is Nothing Then Return
-            SubKey.DeleteValue(Key)
-        Catch ex As Exception
-            Logger.Warn(ex, $"删除注册表出错：{Key}", If(ThrowException, LogBehavior.Toast, LogBehavior.ToastIfDebug))
-            If ThrowException Then Throw
-        End Try
-    End Sub
-
-    '=============================
-    '  ini
-    '=============================
+    'ini

    Private ReadOnly IniCache As New ConcurrentDictionary(Of String, ConcurrentDictionary(Of String, String))
    ''' <summary>
@@ -617,7 +567,8 @@ Public Module ModBase
        End Try
    End Sub

-    '文件校验
+    '权限检查
+
    ''' <summary>
    ''' 检查是否拥有某一文件夹的 I/O 权限。如果文件夹不存在，会返回 False。
    ''' </summary>
@@ -837,8 +788,8 @@ Public Module ModBase
    ''' <summary>
    ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
    ''' </summary>
-    Public PathPure As String = GetPureASCIIDir()
-    Private Function GetPureASCIIDir() As String
+    Public PathPure As Lazy(Of String) = New Lazy(Of String)(
+    Function()
        If Paths.Base.IsAsciiOnly() Then
            Return Paths.Base & "PCL\"
        ElseIf Paths.AppDataThenName.IsAsciiOnly() Then
@@ -848,7 +799,7 @@ Public Module ModBase
        Else
            Return OsDrive & "ProgramData\PCL\"
        End If
-    End Function
+    End Function)

    ''' <summary>
    ''' 指示接取到这个异常的函数进行重试。
@@ -288,7 +288,7 @@ Retry:
        Catch ex As TimeoutException
            Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
        Catch ex As Exception
-            ex.ThrowIfCanceled()
+            If TypeOf ex IsNot TaskCanceledException Then ex.ThrowIfCanceled() 'GetResultWithTimeout 会抛出 TaskCanceledException
            RecordIPReliability(HostIp, -1)
            If ex.IsBadNetwork Then
                Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
@@ -1423,8 +1423,8 @@ Retry:
            End Get
            Set(value As Integer)
                _FailCount = value
-                If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then
-                    Logger.Warn($"由于同加载器中失败次数过多引发强制失败：连续失败了 {value} 次")
+                If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 8, NetTaskThreadLimit * 8 + 3)) Then
+                    Logger.Error($"由于同加载器中失败次数过多引发强制失败：连续失败了 {value} 次", LogBehavior.ToastIfDebug)
                    On Error Resume Next
                    Dim ExList As New List(Of Exception)
                    For Each File In Files
@@ -1917,7 +1917,7 @@ FinishExCatch:
    End Class

    ''' <summary>
-    ''' 是否有正在进行中、需要在下载管理页面显示的下载任务？
+    ''' 是否有正在进行中、需要在任务管理页面显示的下载任务？
    ''' </summary>
    Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
        Return LoaderTaskbar.Any(
@@ -260,16 +260,16 @@ Public Class ValidateFolderName
    Inherits Validate
    Public Property Folder As String
    Public Property UseMinecraftCharCheck As Boolean = True
-    Public Property IgnoreCase As Boolean = True
    Private ReadOnly PathIgnore As IEnumerable(Of String)
+    Private ReadOnly IgnoreList As List(Of String)
    Public Sub New()
    End Sub
-    Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
+    Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreList As List(Of String) = Nothing)
        Me.Folder = Folder
-        Me.IgnoreCase = IgnoreCase
        Me.UseMinecraftCharCheck = UseMinecraftCharCheck
        On Error Resume Next
        PathIgnore = DirectoryUtils.EnumerateDirectories(Folder)
+        Me.IgnoreList = IgnoreList
    End Sub
    Public Overrides Function Validate(Str As String) As String
        Try
@@ -291,15 +291,17 @@ Public Class ValidateFolderName
            Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！", True).Validate(Str)
            If InvalidStrCheck <> "" Then Return InvalidStrCheck
            '检查 NTFS 8.3 文件名（#4505）
-            If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不可包含这一特殊格式！"
+            If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
            '检查文件夹重名
            Dim Arr As New List(Of String)
+            Dim folderName As String
            If PathIgnore IsNot Nothing Then
                For Each FolderPath In PathIgnore
-                    Arr.Add(PathUtils.GetLastPart(FolderPath))
+                    folderName = PathUtils.GetLastPart(FolderPath)
+                    If IgnoreList Is Nothing OrElse Not IgnoreList.Contains(folderName, StringComparer.OrdinalIgnoreCase) Then Arr.Add(folderName)
                Next
            End If
-            Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str)
+            Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", True).Validate(Str)
            If Not SameNameCheck = "" Then Return SameNameCheck
            Return ""
        Catch ex As Exception
@@ -387,6 +389,9 @@ Public Class ValidateFolderPath
        '检查长度
        LengthCheck = New ValidateLength(1, 254).Validate(Str)
        If LengthCheck <> "" Then Return LengthCheck
+        '检查 NTFS 8.3 文件名（#4505）
+        Dim Match = Str.RegexSeek(".{2,}~\d")
+        If Match IsNot Nothing Then Return $"文件夹名不能包含 {Match} 这一特殊格式！"
        '检查开头
        If Str.StartsWithF("\\Mac\") Then GoTo Fin
        For Each Drive In Environment.GetLogicalDrives().Where(Function(p) DirectoryUtils.Exists(p))
@@ -413,8 +418,6 @@ Fin:
            '检查特殊字符串
            Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr)
            If Not InvalidStrCheck = "" Then Return InvalidStrCheck
-            '检查 NTFS 8.3 文件名（#4505）
-            If SubStr.RegexCheck(".{2,}~\d") Then Return "文件夹名不可包含这一特殊格式！"
        Next
        Return ""
    End Function
@@ -514,7 +514,6 @@ Done:
            If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(LogMc.RegexSeek("(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
            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") 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安装不完整)
@@ -522,7 +521,9 @@ Done:
            If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
            If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
            If LogMc.Contains("java.lang.IllegalArgumentException: The requested compatibility level JAVA_11 could not be set. Level is not supported by the active JRE or ASM version") Then AppendReason(CrashReason.Mod需要Java11)
+            If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
            If LogMc.Contains("Unsupported major.minor version") Then AppendReason(CrashReason.Java版本不兼容)
+            If LogMc.Contains("Level is not supported by the active JRE or ASM version") Then AppendReason(CrashReason.Java版本不兼容)
            If LogMc.Contains("Invalid maximum heap size") Then AppendReason(CrashReason.使用32位Java导致JVM无法分配足够多的内存)
            If LogMc.Contains("Could not reserve enough space") Then
                If LogMc.Contains("for 1048576KB object heap") Then
@@ -543,8 +544,8 @@ Done:
            End If
            If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
                AppendReason(CrashReason.Mod缺少前置或MC版本错误,
-                    LogMc.RegexSearch("(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
-                    Select(Function(s) s.Trim((vbCrLf & vbTab & " ").ToCharArray)).Distinct().ToList())
+                LogMc.RegexSearch("(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
+                Select(Function(s) s.Trim((vbCrLf & vbTab & " ").ToCharArray)).Distinct().ToList())
            End If
        End If

@@ -65,7 +65,7 @@ Public Module ModDownload

 #Region "下载资源文件"
        If ShouldIgnoreFileCheck(Instance) Then
-            Logger.Info("已跳过所有 Assets 检查")
+            Logger.Warn("设置要求跳过所有 Assets 检查，文件可能不是最新的", LogBehavior.None)
        Else
            Dim LoadersAssets As New List(Of LoaderBase)
            '获取资源文件索引地址
@@ -78,13 +78,23 @@ Public Module ModDownload
                    If IndexFile Is Nothing Then
                        Task.Output = New List(Of NetFile)
                        Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
-                    ElseIf DownloadAssetIndexInBackground Then
+                        Return
+                    End If
+                    Dim IndexBackgroundFile = PathTemp & "Cache\" & IndexFile.LocalName & "_background"
+                    If FileUtils.Exists(IndexBackgroundFile) AndAlso
+                       FileUtils.GetInfo(IndexBackgroundFile).LastWriteTime.Date > FileUtils.GetInfo(IndexFile.LocalPath).LastWriteTime.Date Then
+                        Logger.Info($"发现后台更新的资源索引缓存文件：{IndexBackgroundFile}")
+                        FileUtils.Move(IndexBackgroundFile, IndexFile.LocalPath)
+                    End If
+                    If DownloadAssetIndexInBackground Then
+                        '允许后台更新索引
                        If IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
                            Task.Output = New List(Of NetFile)
                        Else
                            Task.Output = New List(Of NetFile) From {IndexFile}
                        End If
-                    Else '强制要求重新下载
+                    Else
+                        '强制要求重新下载
                        RealAddressMain = IndexFile.LocalPath
                        TempAddressMain = PathTemp & "Cache\" & IndexFile.LocalName
                        IndexFile.LocalPath = TempAddressMain
@@ -114,28 +124,24 @@ Public Module ModDownload
                Dim LoadersAssetsUpdate As New List(Of LoaderBase)
                LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
                Sub(Task As LoaderTask(Of String, List(Of NetFile)))
-                    Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
-                    If BackAssetsFile Is Nothing Then
+                    Dim IndexFile As NetFile = DlClientAssetIndexGet(Instance)
+                    If IndexFile Is Nothing Then
                        Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
                        Task.Cancel()
                        Throw New OperationCanceledException
                    End If
-                    RealAddressBg = BackAssetsFile.LocalPath
-                    TempAddressBg = PathTemp & "Cache\" & BackAssetsFile.LocalName & "_background"
-                    BackAssetsFile.LocalPath = TempAddressBg
-                    Task.Output = New List(Of NetFile) From {BackAssetsFile}
+                    RealAddressBg = IndexFile.LocalPath
+                    TempAddressBg = PathTemp & "Cache\" & IndexFile.LocalName & "_background"
+                    IndexFile.LocalPath = TempAddressBg
+                    Task.Output = New List(Of NetFile) From {IndexFile}
                    '检查是否需要更新：每天只更新一次
-                    If FileUtils.Exists(RealAddressBg) AndAlso Math.Abs((FileUtils.GetInfo(RealAddressBg).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
-                        Logger.Info("无需更新资源文件索引，取消")
+                    Dim LastUpdate As Date = FileUtils.GetInfo(RealAddressBg).LastWriteTime.Date
+                    If FileUtils.Exists(RealAddressBg) AndAlso Math.Abs((LastUpdate - Now.Date).TotalDays) < 1 Then
+                        Logger.Info($"无需更新资源文件索引，上次更新于 {LastUpdate}")
                        Task.Cancel()
                    End If
                End Sub))
                LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
-                LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
-                Sub(Task As LoaderTask(Of List(Of NetFile), String))
-                    FileUtils.Move(TempAddressBg, RealAddressBg)
-                    McLaunchLog("后台更新资源文件索引成功：" & TempAddressBg)
-                End Sub))
                Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
                Logger.Info("开始后台检查资源文件索引")
                Updater.Start()
@@ -1193,15 +1199,15 @@ Public Module ModDownload
            Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10)))
            Urls.Add((Url, 30))
        End If
-        Dim Exs As String = ""
+        Dim Errors As New List(Of Exception)
        For Each Source In Urls
            Try
                Return NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True).DeserializeJson()
            Catch ex As Exception
-                Exs += ex.Message + vbCrLf
+                Errors.Add(ex)
            End Try
        Next
-        Throw New Exception(Exs)
+        Throw New AggregateException(Errors)
    End Function

 #End Region
@@ -101,11 +101,12 @@ Public Module ModJava
    End Sub

    ''' <summary>
-    ''' 手动触发搜索 Java。
+    ''' 手动触发搜索 Java，强制检查所有 Java。
    ''' </summary>
    Public Sub ManuallySearchJava(Optional CancellationToken As CancellationToken = Nothing)
        RunInThread(
        Sub()
+            Configs.JavaList.Get().ForAll(Sub(java) java.InvalidateChecked()) '重置已检查的状态
            JavaListRefreshWorker.Start(cancellationToken:=CancellationToken)
            JavaListRefreshWorker.WaitIfRunningAsync(cancellationToken:=CancellationToken).Run() 'worker 开始/结束时会自动重载 UI
            If Configs.JavaList.Get().Any Then
@@ -142,7 +143,10 @@ Public Module ModJava
        Dim AddConstraint =
        Sub(Constraint As ValueRange(Of Version))
            JavaRange = JavaRange?.Intersect(Constraint)
-            If JavaRange.IsEmpty Then Logger.Warn($"Java 版本要求冲突（当前追加的要求为 {Constraint}，版本为 {Instance.VersionDisplayName}）")
+            If JavaRange.IsEmpty Then
+                Logger.Warn($"Java 版本要求冲突，若启动失败请在版本设置手动指定 Java：当前追加的要求为 {Constraint}，游戏版本为 {Instance.VersionDisplayName}", LogBehavior.Toast)
+                JavaRange = Constraint
+            End If
        End Sub

        '原版 26-：通过版本号判断
@@ -294,7 +298,7 @@ Public Module ModJava

                Case 3 '=============================== 强制指定特定 Java ===============================

-                    Dim ChosenJava = Configs.InstanceForcedJava.Get(Instance.Config)
+                    Dim ChosenJava = Configs.JavaForced.Get(Instance.Config)
                    Logger.Info($"版本设置中强制指定的 Java：{Instance.PathVersion} → {ChosenJava}")
                    If ChosenJava Is Nothing Then
                        If TryFixOrHint Then
@@ -305,7 +309,7 @@ Public Module ModJava
                        p?.Skip() : Return Nothing '<==== 设置中未指定 Java
                    End If
                    If Not Configs.JavaList.Get().Contains(ChosenJava) Then
-                        Configs.InstanceForcedJava.Reset(Instance.Config)
+                        Configs.JavaForced.Reset(Instance.Config)
                        UpdateJavaLists()
                        If TryFixOrHint Then
                            SwitchToInstanceSetup(Instance)
@@ -314,7 +318,7 @@ Public Module ModJava
                        p?.Skip() : Return Nothing '<==== 设置中指定的 Java 不在列表中
                    End If
                    If Not ChosenJava.CheckAsync(c).Run() Then
-                        Configs.InstanceForcedJava.Reset(Instance.Config)
+                        Configs.JavaForced.Reset(Instance.Config)
                        UpdateJavaLists()
                        If TryFixOrHint Then
                            SwitchToInstanceSetup(Instance)
@@ -365,9 +369,41 @@ Public Module ModJava

                        '电脑中没有合适的 Java，获取 Mojang 提供的 Java 下载列表
                        Logger.Warn($"电脑中没有合适的 Java，开始获取 Mojang 提供的 Java 下载列表")
-                        Dim Components = DownloadJavaList()
-                        c.ThrowIfCancellationRequested()
-                        p?.Set(0.4)
+                        Static DownloadListWorker As New RedoableWorker(Of List(Of JavaDownloadInfo))(
+                        Function(cancellationToken)
+                            '下载 Mojang 提供的 Java 列表
+                            Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
+                                {"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
+                                {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
+                            ), IsJson:=True)
+                            cancellationToken?.ThrowIfCancellationRequested()
+                            '解析 Java 列表
+                            Dim Results = New List(Of JavaDownloadInfo)
+                            For Each Prop As JProperty In IndexFileStr.DeserializeJson(Of JObject)()("windows-x64")
+                                cancellationToken?.ThrowIfCancellationRequested()
+                                If Prop.Name = "minecraft-java-exe" Then Continue For '不是完整 Java
+                                Try
+                                    Dim Entry = Prop.Value.FirstOrDefault
+                                    If Entry Is Nothing Then Continue For
+                                    Dim JavaName = Entry("version")("name").ToString '可能的名称格式："12"、"8u51-cacert462b08"、"17.0.8.1"、"17.0.1.12.1"、"21.0.7"
+                                    If JavaName.Contains(".") Then
+                                        Dim Parts As String() = JavaName.Split(".")
+                                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(Val(Parts(0)), Val(Parts(1)), If(Parts.Length >= 3, Val(Parts(2)), 0), If(Parts.Length >= 4, Val(Parts(3)), 0))})
+                                    ElseIf JavaName.StartsWithF("8u51-") Then
+                                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(8, 0, 51, 0)})
+                                    Else
+                                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(Val(JavaName.BeforeFirstOfAny({"u", "."})), 0, 0, 0)})
+                                    End If
+                                Catch ex As Exception
+                                    Logger.Warn(ex, $"解析 Mojang 提供的 Java 列表项失败，已跳过（{Prop.Name}）")
+                                End Try
+                            Next
+                            Return Results
+                        End Function)
+                        If Not DownloadListWorker.HasSucceeded Then DownloadListWorker.Start(c, p?.SplitTo(0.4))
+                        DownloadListWorker.WaitIfRunning(cancellationToken:=c)
+                        p?.Set(0.4, skiped:=True)
+                        Dim Components = DownloadListWorker.LastResult

                        '确定要下载的目标 Java
                        Dim JavaToDownload As JavaDownloadInfo = If(
@@ -443,7 +479,7 @@ Public Module ModJava
    ''' 从老版本 PCL 迁移版本独立的 Java 设置。
    ''' </summary>
    Private Sub MigrateInstanceJavaSettings(Instance As McInstance, Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
-        If Configs.InstanceMigratedJava.Get(Instance.Config) Then p?.Skip() : Return
+        If Configs.JavaMigrated.Get(Instance.Config) Then p?.Skip() : Return
        If FrmInstanceSetup IsNot Nothing Then RunInUiWait(Sub() FrmInstanceSetup.ComboArgumentJava.IsEnabled = False)
        Try
            Logger.Info($"正在尝试迁移版本独立的 Java 设置（{Instance.Name}）")
@@ -462,10 +498,10 @@ Public Module ModJava
                Configs.JavaList.Edit(Sub(ByRef List) List.Add(ForcedJava)) '加入列表底部
                Logger.Info($"已将强制指定的 Java 加入 Java 列表底部：{ForcedJava}")
            End If
-            Configs.InstanceForcedJava.Set(ForcedJava, Instance.Config)
+            Configs.JavaForced.Set(ForcedJava, Instance.Config)
            Settings.Set("VersionArgumentJavaV2", 3, Instance)
            UpdateJavaLists()
-            Configs.InstanceMigratedJava.Set(True, Instance.Config) '完成
+            Configs.JavaMigrated.Set(True, Instance.Config) '完成
            p?.Finish() : Return
 NoForcedJava:
            Dim JavaFound = JavaUtils.SearchFoldersAsync(True, {Instance.PathVersion}, c, p?.SplitTo(1)).Run()
@@ -478,7 +514,7 @@ NoForcedJava:
                Logger.Info("没有需要迁移的内容，自动选择 Java")
                Settings.Set("VersionArgumentJavaV2", 0, Instance)
            End If
-            Configs.InstanceMigratedJava.Set(True, Instance.Config) '完成
+            Configs.JavaMigrated.Set(True, Instance.Config) '完成
        Finally
            If FrmInstanceSetup IsNot Nothing Then RunInUiWait(
            Sub()
@@ -499,44 +535,6 @@ NoForcedJava:
        Public Property JavaVersion As Version
    End Class

-    ''' <summary>
-    ''' 下载 Mojang 提供的 Java 列表。
-    ''' <para/> 若本次打开程序已经下载过，则会直接返回缓存的结果。
-    ''' </summary>
-    Private Function DownloadJavaList() As List(Of JavaDownloadInfo)
-        'TODO: 写一个更简单的 Lazy，允许重置缓存
-        Static Components As New Lazy(Of List(Of JavaDownloadInfo))(
-        Function()
-            '下载 Mojang 提供的 Java 列表
-            Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
-                {"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
-                {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
-            ), IsJson:=True)
-            '解析 Java 列表
-            Dim Results = New List(Of JavaDownloadInfo)
-            For Each Prop As JProperty In IndexFileStr.DeserializeJson(Of JObject)()("windows-x64")
-                If Prop.Name = "minecraft-java-exe" Then Continue For '不是完整 Java
-                Try
-                    Dim Entry = Prop.Value.FirstOrDefault
-                    If Entry Is Nothing Then Continue For
-                    Dim JavaName = Entry("version")("name").ToString '可能的名称格式："12"、"8u51-cacert462b08"、"17.0.8.1"、"17.0.1.12.1"、"21.0.7"
-                    If JavaName.Contains(".") Then
-                        Dim Parts As String() = JavaName.Split(".")
-                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(Val(Parts(0)), Val(Parts(1)), If(Parts.Length >= 3, Val(Parts(2)), 0), If(Parts.Length >= 4, Val(Parts(3)), 0))})
-                    ElseIf JavaName.StartsWithF("8u51-") Then
-                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(8, 0, 51, 0)})
-                    Else
-                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(Val(JavaName.BeforeFirstOfAny({"u", "."})), 0, 0, 0)})
-                    End If
-                Catch ex As Exception
-                    Logger.Warn(ex, $"解析 Mojang 提供的 Java 列表项失败，已跳过（{Prop.Name}）")
-                End Try
-            Next
-            Return Results
-        End Function)
-        Return Components.Value
-    End Function
-
    ''' <summary>
    ''' 构建下载指定 Java 的加载器。
    ''' </summary>
@@ -463,7 +463,8 @@ NextInner:
    End Function

    '登录主模块加载器
-    Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
+    Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With
+        {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
    Public Function McLoginInput() As McLoginData
        Dim LoginData As McLoginData = Nothing
        Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
@@ -1175,6 +1176,7 @@ Retry:

 #Region "启动参数"
    Private McLaunchArgument As String
+    Private McLaunchEncoding As Encoding

    '主方法
    Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, Integer))
@@ -1296,8 +1298,8 @@ NextInstance:
        'LUA
        Dim UseLUA As Boolean =
            Not Settings.Get(Of Boolean)("LaunchAdvanceDisableLUA") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableLUA", McInstanceSelected) AndAlso
-            McLibListGet(McInstanceSelected, False).Any(Function(e) e.OriginalName = "org.lwjgl:lwjgl:3.4.1")
-        If UseLUA Then Args.Add($"-javaagent:""{ExtractPatch("LUA")}""")
+            McLibListGet(McInstanceSelected, False).Select(Function(e) e.OriginalName).Contains("org.lwjgl:lwjgl:3.4.1")
+        If UseLUA Then Args.Add($"-javaagent:""{LaunchUtils.ExtractPatch("Launch\LwjglUnsafeAgent.jar", PathPure.Value)}""")
        McLaunchLog("使用 LUA：" & UseLUA)

 #Region "内存管理"
@@ -1361,14 +1363,34 @@ NextInstance:
        'Log4j 漏洞防御参数
        Args.Add("-Dlog4j2.formatMsgNoLookups=true")

-        '编码（#4700、#5892、#5909）
-        If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
-        If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
-        If McLaunchJavaSelected.Version.Major >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
+        '编码（#4700、#5892、#5909、#6934、#8950）
+        Dim EncodingName As String
+        Select Case McLaunchJavaSelected.Version.Major
+            Case Is >= 21 'Java 21+ 会固定使用 UTF-8
+                EncodingName = "UTF-8"
+            Case Is >= 18 'Java 18~20 时，启动 MC 时会添加 COMPAT 参数，因此 Java 会回退到 native.encoding
+                EncodingName = McLaunchJavaSelected.NativeEncodingName
+            Case Else 'Java 17- 时，直接使用 file.encoding
+                EncodingName = McLaunchJavaSelected.FileEncodingName
+        End Select
+        Try
+            McLaunchEncoding = Encoding.GetEncoding(If(EncodingName.Equals("GBK", StringComparison.OrdinalIgnoreCase), "GB18030", EncodingName))
+        Catch ex As Exception
+            Dim FallbackEncoding = Encoding.GetEncoding(Globalization.CultureInfo.CurrentCulture.TextInfo.ANSICodePage) '老版本 Java 的编码选择行为
+            McLaunchLog($"无法识别 Java 编码 {If(EncodingName, "Nothing")}，已回退为 {FallbackEncoding.WebName}", LogLevel.Warn)
+            McLaunchEncoding = FallbackEncoding
+        End Try
+        McLaunchLog($"使用编码：{McLaunchEncoding.WebName}")
+        Dim LaunchEncodingName = If(McLaunchEncoding.CodePage = 54936, "GBK", McLaunchEncoding.WebName)
+        Dim StdoutArgName = If(McLaunchJavaSelected.Version.Major < 19, "sun.stdout.encoding", "stdout.encoding") '老版本 Java 应该设置 sun.std
+        Dim StderrArgName = If(McLaunchJavaSelected.Version.Major < 19, "sun.stderr.encoding", "stderr.encoding")
+        If Not Args.Any(Function(a) a.StartsWithF($"-D{StdoutArgName}=")) Then Args.Add($"-D{StdoutArgName}={LaunchEncodingName}")
+        If Not Args.Any(Function(a) a.StartsWithF($"-D{StderrArgName}=")) Then Args.Add($"-D{StderrArgName}={LaunchEncodingName}")
+        If McLaunchJavaSelected.Version.Major >= 18 AndAlso McLaunchJavaSelected.Version.Major < 21 Then Args.Add("-Dfile.encoding=COMPAT") '使用 COMPAT 防止部分 Mod 配置文件不兼容 UTF-8

        '为 JLW 添加 -jar，它必须放在最后
        If UseJLW Then
-            Args.Add("-jar") : Args.Add(ExtractPatch("JavaWrapper"))
+            Args.Add("-jar") : Args.Add(LaunchUtils.ExtractPatch("Launch\JavaWrapper.jar", PathPure.Value))
        End If

        '再次去重并输出
@@ -1482,7 +1504,7 @@ NextInstance:
        Yield ("${natives_directory}", GetNativesFolder().TrimEnd("\"c))
        Yield ("${library_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
        Yield ("${libraries_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
-        Yield ("${pure_directory}", PathPure.TrimEnd("\"c)) '由 PCL 添加，这会允许在分割参数并去重后再替换路径，防止路径中的特殊字符影响参数分割和去重
+        Yield ("${pure_directory}", PathPure.Value.TrimEnd("\"c)) '由 PCL 添加，这会允许在分割参数并去重后再替换路径，防止路径中的特殊字符影响参数分割和去重
        Yield ("${launcher_name}", "PCL")
        Yield ("${launcher_version}", VersionCode)
        Yield ("${version_name}", McInstanceSelected.Name)
@@ -1997,7 +2019,7 @@ IgnoreCustomSkin:
        '输出 bat
        Try
            Dim CmdString As String =
-                $"{If(McLaunchJavaSelected.Version.Major > 8, "chcp 65001>nul" & vbCrLf, "")}" &
+                $"chcp {If(McLaunchEncoding.CodePage = 54936 AndAlso IsGBKEncoding, 936, McLaunchEncoding.CodePage)}>nul" & vbCrLf &
                "@echo off" & vbCrLf &
                $"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
                "echo 游戏正在启动，请稍候。" & vbCrLf &
@@ -2010,7 +2032,7 @@ IgnoreCustomSkin:
            FileUtils.Write(
                filePath:=If(CurrentLaunchOptions.SaveBatch, Paths.Base & "PCL\LatestLaunch.bat"),
                text:=FilterAccessToken(CmdString, "F").Replace("%", "%%"),
-                encoding:=If(McLaunchJavaSelected.Version.Major > 8, Encoding.UTF8, Encoding.Default))
+                encoding:=McLaunchEncoding)
            If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
                McLaunchLog("导出启动脚本完成，强制结束启动过程")
                CanceledHint = "导出启动脚本成功！"
@@ -2092,6 +2114,8 @@ IgnoreCustomSkin:
        '设置其他参数
        StartInfo.WorkingDirectory = McInstanceSelected.PathIndie
        StartInfo.UseShellExecute = False
+        StartInfo.StandardOutputEncoding = McLaunchEncoding
+        StartInfo.StandardErrorEncoding = McLaunchEncoding
        StartInfo.RedirectStandardOutput = True
        StartInfo.RedirectStandardError = True
        StartInfo.CreateNoWindow = True
@@ -484,7 +484,7 @@ VersionSearchFinish:
            Return JsonPath
        End Function
        ''' <summary>
-        ''' 该版本的 Json 文本。
+        ''' 该版本的 Json 文本。会抛出异常。
        ''' </summary>
        Public Property JsonText As String
            Get
@@ -2073,7 +2073,7 @@ OnLoaded:

        '统一通行证文件
        If Settings.Get(Of Integer)("VersionServerLogin", Instance:=Instance) = 3 Then
-            Dim TargetFile As String = PathPure & "nide8auth.jar"
+            Dim TargetFile As String = PathPure.Value & "nide8auth.jar"
            Try
                '测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
                Logger.Info("开始获取统一通行证下载信息")
@@ -2093,7 +2093,7 @@ OnLoaded:

        'Authlib-Injector 文件
        If Settings.Get(Of Integer)("VersionServerLogin", Instance:=Instance) = 4 Then
-            Dim TargetFile = PathPure & "authlib-injector.jar"
+            Dim TargetFile = PathPure.Value & "authlib-injector.jar"
            Try
                Logger.Info("开始获取 Authlib-Injector 下载信息")
                Dim DownloadInfo As JObject = NetRequestByClientRetry(
@@ -109,29 +109,10 @@ Public Module ModModpack
        End Try
    End Function

-    Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, ProgressIncrement As Double)
-        '解压文件
-        Dim RetryCount As Integer = 1
-        Dim InitialProgress = Loader.Progress
-Retry:
-        Try
-            Loader.Progress = InitialProgress
-            DirectoryUtils.Delete(InstallTemp)
-            Dim RawProgress As Double = Loader.Progress
-            FileUtils.ExtractToDirectory(FileAddress, InstallTemp, progressHandler:=Sub(Percentage) Loader.Progress = RawProgress + Percentage * ProgressIncrement)
-        Catch ex As Exception
-            Logger.Warn(ex, $"第 {RetryCount} 次解压尝试失败")
-            '完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试
-            If RetryCount < 5 Then
-                Thread.Sleep(RetryCount * 2000)
-                If Loader IsNot Nothing AndAlso Loader.LoadingState <> MyLoading.MyLoadingState.Run Then Return
-                RetryCount += 1
-                GoTo Retry
-            Else
-                Throw New Exception("解压整合包文件失败", ex)
-            End If
-        End Try
-        Loader.Progress = InitialProgress + ProgressIncrement
+    Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
+        DirectoryUtils.Delete(InstallTemp)
+        c.ThrowIfCancellationRequested()
+        FileUtils.ExtractToDirectory(FileAddress, InstallTemp, c, p)
    End Sub
    ''' <summary>
    ''' 从整合包的 override 目录复制文件，同时设置 PCL 的配置文件与版本隔离。
@@ -213,7 +194,6 @@ Retry:
                Logger.Info($"整合包 Fabric 版本：{Id}")
                TargetVersion.Fabric = Id.Replace("fabric-", "")
            Else
-                'ElseIf Id.StartsWithF("quilt-") Then
                NotifyIncompatibleLoader(Id)
            End If
        Next
@@ -224,7 +204,7 @@ Retry:
        If OverrideHome <> "" Then
            InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
            Sub(Task As LoaderTask(Of String, Integer))
-                ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+                ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
                CopyOverrideDirectory(
                    InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
                    $"{McFolderSelected}versions\{InstanceName}", Task)
@@ -296,13 +276,15 @@ Retry:
                    Dim TargetFolder As String, Type As ResourceTypes
                    If ModJson("modules").Any Then 'modules 可能返回 null（#1006）
                        Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
-                        If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
-                           ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
+                        If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse ModuleNames.Contains("fabric.mod.json") OrElse
+                            ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
                            TargetFolder = "mods" : Type = ResourceTypes.Mod
                        ElseIf ModuleNames.Contains("pack.mcmeta") Then
                            TargetFolder = "resourcepacks" : Type = ResourceTypes.ResourcePack
-                        Else
+                        ElseIf ModuleNames.Contains("shaders") Then
                            TargetFolder = "shaderpacks" : Type = ResourceTypes.Shader
+                        Else
+                            TargetFolder = "saves" : Type = ResourceTypes.Map
                        End If
                    Else
                        TargetFolder = "mods" : Type = ResourceTypes.Mod
@@ -348,6 +330,12 @@ Retry:
                WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
                Logger.Info($"已设置整合包 Logo：{Logo}")
            End If
+            '解压地图文件
+            Dim SaveFolder As String = $"{VersionFolder}saves\"
+            For Each MapFile In DirectoryUtils.EnumerateFiles(SaveFolder, searchPattern:="*.zip")
+                FileUtils.ExtractToDirectory(MapFile, SaveFolder, Task.CreateCancellationToken())
+                FileUtils.Delete(MapFile)
+            Next
            '删除原始整合包文件
            For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
                If FileUtils.Exists(Target) Then
@@ -373,7 +361,6 @@ Retry:
        Loader.Start(Request.VersionFolder)
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
-        RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
        Return Loader
    End Function

@@ -404,7 +391,6 @@ Retry:
                    TargetVersion.Fabric = Entry.Value.ToString
                    Logger.Info($"整合包 Fabric 版本：{TargetVersion.Fabric}")
                Case Else
-                    'Case "quilt-loader" 'eg. 1.0.0
                    NotifyIncompatibleLoader(Entry.Name)
            End Select
        Next
@@ -421,7 +407,7 @@ Retry:
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
        Sub(Task As LoaderTask(Of String, Integer))
-            ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
+            ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.5))
            CopyOverrideDirectory(
                InstallTemp & ArchiveBaseFolder & "overrides",
                McFolderSelected & "versions\" & InstanceName, Task)
@@ -456,7 +442,7 @@ Retry:
                Throw New OperationCanceledException
            End If
            FileList.Add(New NetFile(Urls, TargetPath,
-                New FileChecker With {.ActualSize = File("fileSize").ToObject(Of Long), .Hash = File("hashes")("sha1").ToString}, True))
+                New FileChecker With {.Hash = File("hashes")("sha1").ToString}, True)) 'Modrinth 整合包不应校验文件大小（他们官方自己说的）
        Next
        If FileList.Any Then
            InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
@@ -511,7 +497,6 @@ Retry:
        Loader.Start(Request.VersionFolder)
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
-        RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
        Return Loader
    End Function

@@ -535,7 +520,7 @@ Retry:
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
        Sub(Task As LoaderTask(Of String, Integer))
-            ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+            ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
            CopyOverrideDirectory(
                InstallTemp & ArchiveBaseFolder & "minecraft",
                McFolderSelected & "versions\" & InstanceName, Task)
@@ -564,7 +549,6 @@ Retry:
        Loader.Start(Request.VersionFolder)
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
-        RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
        Return Loader
    End Function

@@ -590,7 +574,7 @@ Retry:
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
        Sub(Task As LoaderTask(Of String, Integer))
-            ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
+            ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.55))
            CopyOverrideDirectory(
                InstallTemp & ArchiveBaseFolder & ".minecraft",
                McFolderSelected & "versions\" & InstanceName, Task)
@@ -662,7 +646,6 @@ Retry:
                    Request.NeoForgeVersion = Component("version")
                Case "net.fabricmc.fabric-loader"
                    Request.FabricVersion = Component("version")
-                    'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
                Case Else
                    If UID.StartsWithF("org.lwjgl") Then '#8210
                        Logger.Info($"已跳过 LWJGL 项：{UID}")
@@ -690,7 +673,6 @@ Retry:
        Loader.Start(Request.VersionFolder)
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
-        RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
        Return Loader
    End Function

@@ -719,7 +701,7 @@ Retry:
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
        Sub(Task As LoaderTask(Of String, Integer))
-            ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+            ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
            CopyOverrideDirectory(
                InstallTemp & ArchiveBaseFolder & "overrides",
                McFolderSelected & "versions\" & InstanceName, Task)
@@ -738,7 +720,7 @@ Retry:
        Next
        If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
        If Addons.ContainsKey("quilt") Then
-            Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Red)
+            Hint("PCL 不支持安装 Quilt 整合包！", HintType.Red)
            Throw New OperationCanceledException
        End If
        Dim Request As New McInstallRequest With {
@@ -769,7 +751,6 @@ Retry:
        Loader.Start(Request.VersionFolder)
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
-        RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
        Return Loader
    End Function

@@ -784,7 +765,7 @@ Retry:
        Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
            New LoaderTask(Of String, Integer)("解压压缩包",
            Sub(Task As LoaderTask(Of String, Integer))
-                ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
+                ExtractModpackFiles(TargetFolder, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.9))
                OpenExplorer(TargetFolder)
                Thread.Sleep(400) '避免文件争用
                '查找解压后的 exe 文件
@@ -860,7 +841,7 @@ Retry:
        Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
            New LoaderTask(Of String, Integer)("解压压缩包",
            Sub(Task As LoaderTask(Of String, Integer))
-                ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
+                ExtractModpackFiles(TargetFolder, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.95))
                '加入文件夹列表
                PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, PathUtils.GetLastPart(TargetFolder), False)
                Thread.Sleep(400) '避免文件争用
@@ -8,7 +8,8 @@ Public Module ModWatcher
        Dim IsRunning As Boolean = False
        Dim TriggerLauncherShutdown As Boolean = True
        For Each Watcher In McWatcherList
-            If Watcher.State = Watcher.MinecraftState.Loading OrElse Watcher.State = Watcher.MinecraftState.Running Then
+            If Watcher.State = Watcher.MinecraftState.Loading OrElse Watcher.State = Watcher.MinecraftState.Running OrElse
+               (Watcher.State = Watcher.MinecraftState.Crashed AndAlso Not Watcher.GameProcess.HasExited) Then
                IsRunning = True
                Exit For
            ElseIf Watcher.State = Watcher.MinecraftState.Crashed OrElse Watcher.State = Watcher.MinecraftState.Canceled Then
@@ -91,7 +92,9 @@ Public Module ModWatcher
            RunInNewThread(
            Sub()
                Try
-                    Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Canceled
+                    Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Canceled OrElse
+                             (Loader.State = LoadState.Canceled AndAlso State <> MinecraftState.Crashed) OrElse
+                             (State = MinecraftState.Crashed AndAlso GameProcess.HasExited)
                        TimerWindow()
                        TimerLog()
                        '设置窗口标题
@@ -103,6 +106,7 @@ Public Module ModWatcher
                            Thread.Sleep(64)
                        Next
                    Loop
+                    If State = MinecraftState.Crashed Then WatcherStateChanged()
                    WatcherLog("Minecraft 日志监控已退出")
                Catch ex As Exception
                    Logger.Error(ex, "Minecraft 日志监控主循环出错")
@@ -314,7 +318,7 @@ Public Module ModWatcher
                    Dim str As New StringBuilder(512)
                    GetClassName(hwnd, str, str.Capacity)
                    Dim ClassName As String = str.ToString
-                    If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Return
+                    If Not (ClassName = "GLFW30" OrElse ClassName = "SDL_app" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Return
                    '获取窗口标题名
                    str = New StringBuilder(512)
                    GetWindowText(hwnd, str, str.Capacity)
@@ -178,6 +178,8 @@ Public Class CustomEvent
        Logger.Info($"执行自定义事件：{Type}, {Arg}")
        If Arg Is Nothing Then Arg = ""
        Dim Args As String() = Arg.Split("|")
+        Dim Arg0 As String = Arg.BeforeFirst("|")
+        Dim Arg1 As String = Arg.AfterFirst("|")
        Try
            Select Case Type
                Case EventType.打开网页
@@ -194,16 +196,16 @@ Public Class CustomEvent
                    Sub()
                        Try
                            '确认实际路径
-                            Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
+                            Dim ActualPaths = GetAbsoluteUrls(Arg0, Type)
                            Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
                            Logger.Info($"打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
                            '执行
                            If Type = EventType.打开帮助 Then
                                PageOtherHelp.EnterHelpPage(Location)
                            Else
-                                If Not EventSafetyConfirm("即将执行：" & Location & If(Args.Length >= 2, " " & Args(1), "")) Then Return
+                                If Not EventSafetyConfirm("即将执行：" & Location & If(Args.Length >= 2, " " & Arg1, "")) Then Return
                                Dim Info As New ProcessStartInfo With {
-                                    .Arguments = If(Args.Length >= 2, Args(1), ""),
+                                    .Arguments = If(Args.Length >= 2, Arg1, ""),
                                    .FileName = Location,
                                    .WorkingDirectory = WorkingDir
                                }
@@ -215,19 +217,19 @@ Public Class CustomEvent
                    End Sub)

                Case EventType.启动游戏
-                    If Args(0) = "\current" Then
+                    If Arg0 = "\current" Then
                        If McInstanceSelected Is Nothing Then
                            Hint("请先选择一个 Minecraft 版本！", HintType.Red)
                            Return
                        Else
-                            Args(0) = McInstanceSelected.Name
+                            Arg0 = McInstanceSelected.Name
                        End If
                    End If
                    RunInUi(
                    Sub()
                        If McLaunchStart(New McLaunchOptions With
-                                {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Args(0))}) Then
-                            Hint($"正在启动 {Args(0)}……")
+                                {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Arg0)}) Then
+                            Hint($"正在启动 {Arg0}……")
                        End If
                    End Sub)

@@ -264,51 +266,55 @@ Public Class CustomEvent

                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), "确定"))
+                    MyMsgBox(Arg1.BeforeLast("|").Replace("\n", vbCrLf), Arg0.Replace("\n", vbCrLf), If(Args.Length > 2, Arg1.AfterLast("|"), "确定"))

                Case EventType.弹出提示
-                    Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Args(1))))
+                    Hint(Arg0.Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Arg1)))

                Case EventType.切换页面
                    RunInUi(Sub() FrmMain.PageChange(
-                                EnumUtils.FromString(Of FormMain.PageType)(Args(0)),
-                                If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Args(1)))))
+                                EnumUtils.FromString(Of FormMain.PageType)(Arg0),
+                                If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Arg1))))

                Case EventType.导入整合包, EventType.安装整合包
                    RunInUi(Sub() ModpackInstall())

                Case EventType.下载文件
-                    Args(0) = Args(0).Replace("\", "/")
-                    If Not (Args(0).StartsWithF("http://", True) OrElse Args(0).StartsWithF("https://", True)) Then
+                    Arg0 = Arg0.Replace("\", "/")
+                    If Not (Arg0.StartsWithF("http://", True) OrElse Arg0.StartsWithF("https://", True)) Then
                        MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
                        Return
                    End If
-                    If Not EventSafetyConfirm("即将从该网址下载文件：" & vbCrLf & Args(0)) Then Return
+                    If Not EventSafetyConfirm("即将从该网址下载文件：" & vbCrLf & Arg0) Then Return
                    RunInUi(
                    Sub()
                        Try
                            Select Case Args.Length
                                Case 1
-                                    PageOtherTest.StartCustomDownload(Args(0), PathUtils.GetLastPart(Args(0)))
+                                    PageOtherTest.StartCustomDownload(Arg0, PathUtils.GetLastPart(Arg0))
                                Case 2
-                                    PageOtherTest.StartCustomDownload(Args(0), Args(1))
+                                    PageOtherTest.StartCustomDownload(Arg0, Arg1)
                                Case Else
-                                    PageOtherTest.StartCustomDownload(Args(0), Args(1), Args(2))
+                                    PageOtherTest.StartCustomDownload(Arg0, Arg(1), Args(2))
                            End Select
                        Catch
-                            PageOtherTest.StartCustomDownload(Args(0), "未知")
+                            PageOtherTest.StartCustomDownload(Arg0, "未知")
                        End Try
                    End Sub)

                Case EventType.修改设置, EventType.写入设置
                    If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数，例如 UiLauncherTransparent|400")
-                    Settings.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected)
-                    If Args.Length = 2 Then Hint($"已写入设置：{Args(0)} → {Args(1)}", HintType.Green)
+                    Settings.SetSafe(Arg0, Arg1, Instance:=McInstanceSelected)
+                    If Args.Length = 2 Then Hint($"已写入设置：{Arg0} → {Arg1}", 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)
+                    Try
+                        RegistryUtils.Write($"HKEY_CURRENT_USER\Software\{RegFolder}", $"CustomEvent{Arg0}", Arg1)
+                        If Args.Length = 2 Then Hint($"已写入变量：{Arg0} → {Arg1}", HintType.Green)
+                    Catch ex As Exception
+                        Logger.Warn(ex, $"写入变量失败：{Arg0} → {Arg1}", LogBehavior.Toast)
+                    End Try

                Case EventType.加入房间
                    RunInUi(
@@ -799,26 +799,16 @@ NextFile:
    ''' 如果失败，则抛出异常。
    ''' </summary>
    Public Sub SetGPUPreference(Executeable As String)
-        Const REG_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
+        Const REG_KEY As String = "HKEY_CURRENT_USER\Software\Microsoft\DirectX\UserGpuPreferences"
        Const REG_VALUE As String = "GpuPreference=2;"
        '查看现有设置
-        Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
-            If ReadOnlyKey IsNot Nothing Then
-                If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
-                    Logger.Info($"无需调整显卡设置：{Executeable}")
-                    Return
-                End If
-            Else
-                '创建父级键
-                Logger.Info($"需要创建显卡设置的父级键")
-                My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
-            End If
-        End Using
+        If RegistryUtils.Read(REG_KEY, Executeable).result?.ToString() = REG_VALUE Then
+            Logger.Info($"无需调整显卡设置：{Executeable}")
+            Return
+        End If
        '写入新设置
-        Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
-            WriteKey.SetValue(Executeable, REG_VALUE)
-            Logger.Info($"已调整显卡设置：{Executeable}")
-        End Using
+        RegistryUtils.Write(REG_KEY, Executeable, REG_VALUE)
+        Logger.Info($"已调整显卡设置：{Executeable}")
    End Sub

    ''' <summary>
@@ -867,11 +857,19 @@ NextFile:
            Else
                Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
            End If
+            Text = Text.Replace("{forge}", Replacer(If(McInstanceSelected.Version.HasForge, McInstanceSelected.Version.Forge, "")))
+            Text = Text.Replace("{fabric}", Replacer(If(McInstanceSelected.Version.HasFabric, McInstanceSelected.Version.Fabric, "")))
+            Text = Text.Replace("{neoforge}", Replacer(If(McInstanceSelected.Version.HasNeoForge, McInstanceSelected.Version.NeoForge, "")))
+            Text = Text.Replace("{liteloader}", Replacer(If(McInstanceSelected.Version.HasLiteLoader, "true", "")))
        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))
+            Text = Text.Replace("{forge}", Replacer(Nothing))
+            Text = Text.Replace("{fabric}", Replacer(Nothing))
+            Text = Text.Replace("{neoforge}", Replacer(Nothing))
+            Text = Text.Replace("{liteloader}", Replacer(Nothing))
        End If
        '登录信息
        If McLoginLoader.State = LoadState.Finished Then
@@ -896,8 +894,8 @@ NextFile:
        Text = Text.RegexReplace("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
        Text = Text.RegexReplace("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
        Text = Text.RegexReplace("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
-        Text = Text.RegexReplace("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
-        Text = Text.RegexReplace("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
+        Text = Text.RegexReplace("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(RegistryUtils.TryRead($"HKEY_CURRENT_USER\Software\{RegFolder}", $"CustomEvent{m.Groups(1).Value}", m.Groups(2).Value)))
+        Text = Text.RegexReplace("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(RegistryUtils.TryRead($"HKEY_CURRENT_USER\Software\{RegFolder}", $"CustomEvent{m.Groups(1).Value}", m.Groups(2).Value)))
        Return Text
    End Function

@@ -502,7 +502,6 @@ Public Class ResourceProject
        '获取 Mod 加载器描述
        Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
        Dim ModLoadersForDesc = ModLoaders.Flags().ToList()
-        If Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaders.Quilt)
        Select Case ModLoadersForDesc.Count
            Case 0
                If ModLoadersForDesc.IsSingle Then
@@ -519,8 +518,7 @@ Public Class ResourceProject
                Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999)
                If ModLoadersForDesc.Contains(ModLoaders.Forge) AndAlso
                   (NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Fabric)) AndAlso
-                   (NewestDrop < 200 OrElse ModLoadersForDesc.Contains(ModLoaders.NeoForge)) AndAlso
-                   (NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Quilt) OrElse Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt")) Then
+                   (NewestDrop < 200 OrElse ModLoadersForDesc.Contains(ModLoaders.NeoForge)) Then
                    ModLoaderDescriptionFull = "任意"
                    ModLoaderDescriptionPart = ""
                Else
@@ -179,11 +179,6 @@ Public Class ResourceSearcher
            End If
        End If

-        '拒绝 1.13- Quilt（这个版本根本没有 Quilt）
-        If Request.ModLoaders = ModLoaders.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
-            Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
-        End If
-
 #End Region

 #Region "中文搜索"
@@ -348,7 +348,7 @@ Public Class ResourceVersion
                .Height = 42
                .Type = MyListItem.CheckType.Clickable
                .Tag = Me
-                .Title = If(IsBadDisplay, FileName, Display)
+                .Title = If(IsBadDisplay, FileName, Display).BeforeLastOfAny({".zip", ".jar", ".mrpack", ".litemod"}, True)
                .Logo = $"{PathImage}ReleaseTypes/{ReleaseType}.png"
                AddHandler .Click, ClickHandler
                '描述