2.9.1

2025-02-22 01:20:08 +08:00
parent 1a0c7b0520
commit 503244a0de
62 changed files with 3399 additions and 1875 deletions
@@ -360,7 +360,7 @@
                    'Tags & ModLoaders
                    Tags = New List(Of String)
                    ModLoaders = New List(Of CompModLoaderType)
-                    If Data?("loaders") IsNot Nothing Then
+                    If Data.ContainsKey("loaders") Then
                        For Each Category In Data("loaders").Select(Function(t) t.ToString)
                            Select Case Category
                                Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
@@ -402,7 +402,7 @@
                            Case "technology" : Tags.Add("科技")
                            Case "magic" : Tags.Add("魔法")
                            Case "adventure" : Tags.Add("冒险")
-                            Case "kitchen-sink" : Tags.Add("大杂烩")
+                            Case "kitchen-sink" : Tags.Add("水槽包/大杂烩")
                            Case "lightweight" : Tags.Add("轻量")
                                'FUTURE: Res
                        End Select
@@ -1274,10 +1274,7 @@ Retry:
                    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, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
-                    DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
-                                       Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
-                                       Url.Replace("://edge", "://media"),
-                                       Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
+                    DownloadUrls = HandleCurseForgeDownloadUrls(Url) '对脑残 CurseForge 的下载地址进行多种修正
                    DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源，这个写法是为了让镜像源排在后面
                    DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
                    'Dependencies
@@ -1352,6 +1349,19 @@ Retry:
                End If
            End If
        End Sub
+
+        ''' <summary>
+        ''' 重新整理 CurseForge 的下载地址。
+        ''' </summary>
+        Public Shared Function HandleCurseForgeDownloadUrls(Url As String) As List(Of String)
+            Return {
+                Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
+                Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
+                Url.Replace("://edge", "://media"),
+                Url
+            }.Distinct.ToList
+        End Function
+
        ''' <summary>
        ''' 将当前实例转为可用于保存缓存的 Json。
        ''' </summary>
@@ -1,24 +1,10 @@
 Public Class CrashAnalyzer
-    Private Shared IsAnalyzeCacheCleared As Boolean = False
-    Private Shared IsAnalyzeCacheClearedLock As New Object

    '构造函数
    Private TempFolder As String
    Public Sub New(UUID As Integer)
-        '清理缓存
-        SyncLock IsAnalyzeCacheClearedLock
-            If Not IsAnalyzeCacheCleared Then
-                Try
-                    DeleteDirectory(PathTemp & "CrashAnalyzer\")
-                Catch ex As Exception
-                    Log(ex, "清理崩溃分析缓存失败")
-                End Try
-                IsAnalyzeCacheCleared = True
-            End If
-        End SyncLock
        '构建文件结构
-        TempFolder = PathTemp & "CrashAnalyzer\" & UUID & RandomInteger(0, 99999999) & "\"
-        DeleteDirectory(TempFolder)
+        TempFolder = RequestTaskTempFolder()
        Directory.CreateDirectory(TempFolder & "Temp\")
        Directory.CreateDirectory(TempFolder & "Report\")
        Log("[Crash] 崩溃分析暂存文件夹：" & TempFolder)
@@ -873,7 +859,7 @@ NextStack:
            Sub()
                '弹窗选择：查看日志
                If File.Exists(DirectFile.Value.Key) Then
-                    ShellOnly("notepad", DirectFile.Value.Key)
+                    ShellOnly(DirectFile.Value.Key)
                Else
                    Dim FilePath As String = PathTemp & "Crash.txt"
                    WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
@@ -885,7 +871,7 @@ NextStack:
                Dim FileAddress As String = Nothing
                Try
                    '获取文件路径
-                    RunInUiWait(Sub() FileAddress = SelectAs("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
+                    RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
                    If String.IsNullOrEmpty(FileAddress) Then Exit Sub
                    Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
                    If File.Exists(FileAddress) Then File.Delete(FileAddress)
@@ -923,7 +909,7 @@ NextStack:
                    Log(ex, "导出错误报告失败", LogLevel.Feedback)
                    Exit Sub
                End Try
-                OpenExplorer("/select,""" & FileAddress & """")
+                OpenExplorer(FileAddress)
        End Select
    End Sub
    ''' <summary>
@@ -622,7 +622,7 @@
    Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
        Dim Result As String
        Try
-            Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
+            Result = NetGetCodeByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
                                          Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057
                                          ".html", UseBrowserUserAgent:=True)
        Catch ex As Exception
@@ -829,8 +829,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 = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
-        Dim ResultLegacy As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
+        Dim ResultLatest As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
+        Dim ResultLegacy As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
        If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足（" & ResultLatest & "）")
        '解析
        Try
@@ -847,8 +847,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 = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
-        Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
+        Dim ResultLatest As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
+        Dim ResultLegacy As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
        If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足（" & ResultLatest & "）")
        '解析
        Try
@@ -1095,12 +1095,12 @@

    ''' <summary>
    ''' 对可能涉及 Mod 镜像源的请求进行处理，返回字符串或 JObject。
-    ''' 调用 NetGetCodeByRequest。
+    ''' 调用 NetGetCodeByRequest，会进行重试。
    ''' </summary>
    Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
        Dim Urls As New List(Of KeyValuePair(Of String, Integer))
        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
+        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
        'Dim McimUrl As String = DlSourceModGet(Url)
        'If McimUrl <> Url Then
        '    Select Case Setup.Get("ToolDownloadMod")
@@ -1132,12 +1132,12 @@

    ''' <summary>
    ''' 对可能涉及 Mod 镜像源的请求进行处理。
-    ''' 调用 NetRequest。
+    ''' 调用 NetRequest，会进行重试。
    ''' </summary>
    Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
        Dim Urls As New List(Of KeyValuePair(Of String, Integer))
        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
+        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
        'Dim McimUrl As String = DlSourceModGet(Url)
        'If McimUrl <> Url Then
        '   Select Case Setup.Get("ToolDownloadMod")
@@ -653,7 +653,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(OriginalPath), Results, Source, IsFullSearch)
+            JavaSearchFolder(New DirectoryInfo(ShortenPath(OriginalPath)), Results, Source, IsFullSearch)
        Catch ex As UnauthorizedAccessException
            Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath)
        Catch ex As Exception
@@ -741,7 +741,7 @@ Wait:
    Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java
    Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
        Log("[Java] 开始获取 Java 下载信息")
-        Dim IndexFileStr As String = NetGetCodeByDownload(
+        Dim IndexFileStr As String = NetGetCodeByLoader(
            {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
             "https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
        IsJson:=True)
@@ -753,7 +753,7 @@ Wait:
        Dim Address As String = TargetEntry.Value("manifest")("url")
        Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}（{TargetEntry.Key}）：{Address}")
        '获取文件列表
-        Dim ListFileStr As String = NetGetCodeByDownload({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
+        Dim ListFileStr As String = NetGetCodeByLoader({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
        LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
        Dim Results As New List(Of NetFile)
        For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
@@ -574,7 +574,7 @@ SkipLogin:
    End Sub
    Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
        Dim Input As McLoginServer = Data.Input
-        Dim NeedRefresh As Boolean = False
+        Dim NeedRefresh As Boolean = False, WasRefreshed As Boolean = False
        Dim LogUsername As String = Input.UserName
        If LogUsername.Contains("@") AndAlso Setup.Get("UiLauncherEmail") Then
            LogUsername = AccountFilter(LogUsername)
@@ -595,7 +595,7 @@ SkipLogin:
                McLoginRequestValidate(Data)
                GoTo LoginFinish
            Catch ex As Exception
-                Dim AllMessage = GetExceptionSummary(ex)
+                Dim AllMessage = GetExceptionDetail(ex)
                McLaunchLog("验证登录失败：" & AllMessage)
                If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
                    McLaunchLog("已触发超时登录失败")
@@ -610,7 +610,8 @@ Refresh:
                McLoginRequestRefresh(Data, NeedRefresh)
                GoTo LoginFinish
            Catch ex As Exception
-                McLaunchLog("刷新登录失败：" & GetExceptionSummary(ex))
+                McLaunchLog("刷新登录失败：" & GetExceptionDetail(ex))
+                If WasRefreshed Then Throw New Exception("二轮刷新登录失败", ex)
            End Try
            Data.Progress = If(NeedRefresh, 0.85, 0.45)
        End If
@@ -619,10 +620,12 @@ Refresh:
            If Data.IsAborted Then Throw New ThreadInterruptedException
            NeedRefresh = McLoginRequestLogin(Data)
        Catch ex As Exception
-            McLaunchLog("登录失败：" & GetExceptionSummary(ex))
+            McLaunchLog("登录失败：" & GetExceptionDetail(ex))
            Throw
        End Try
        If NeedRefresh Then
+            McLaunchLog("重新进行刷新登录")
+            WasRefreshed = True
            Data.Progress = 0.65
            GoTo Refresh
        End If
@@ -699,19 +702,17 @@ LoginFinish:
    End Sub
    Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
        McLaunchLog("刷新登录开始（Refresh, " & Data.Input.Token & "）")
-        
-        Dim RefreshInfo As JObject = New JObject
-        Dim SelectProfile As JObject = New JObject()
-        SelectProfile.Add(New JProperty("name", Setup.Get("Cache" & Data.Input.Token & "Name")))
-        SelectProfile.Add(New JProperty("id", Setup.Get("Cache" & Data.Input.Token & "Uuid")))
-        RefreshInfo.Add("selectedProfile", SelectProfile)
-        RefreshInfo.Add(New JProperty("accessToken", Setup.Get("Cache" & Data.Input.Token & "Access")))
-        RefreshInfo.Add(New JProperty("requestUser", True))
-
        Dim LoginJson As JObject = GetJson(NetRequestRetry(
               Url:=Data.Input.BaseUrl & "/refresh",
               Method:="POST",
-               Data:=RefreshInfo.ToString(0),
+               Data:=New JObject(
+                   New JProperty("selectedProfile", New JObject(
+                       New JProperty("name", Setup.Get($"Cache{Data.Input.Token}Name")),
+                       New JProperty("id", Setup.Get($"Cache{Data.Input.Token}Uuid"))
+                   )),
+                   New JProperty("accessToken", Setup.Get($"Cache{Data.Input.Token}Access")),
+                   New JProperty("requestUser", True)
+               ).ToString(Newtonsoft.Json.Formatting.None),
               Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh-CN"}},
               ContentType:="application/json; charset=utf-8"))
        '将登录结果输出
@@ -768,17 +769,18 @@ LoginFinish:
                '缓存无效，要求玩家选择
                If SelectedName Is Nothing Then
                    McLaunchLog("要求玩家选择角色")
-                    RunInUiWait(Sub()
-                                    Dim SelectionControl As New List(Of IMyRadio)
-                                    Dim SelectionJson As New List(Of JToken)
-                                    For Each Profile In LoginJson("availableProfiles")
-                                        SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString})
-                                        SelectionJson.Add(Profile)
-                                    Next
-                                    Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色")
-                                    SelectedName = SelectionJson(SelectedIndex)("name").ToString
-                                    SelectedId = SelectionJson(SelectedIndex)("id").ToString
-                                End Sub)
+                    RunInUiWait(
+                    Sub()
+                        Dim SelectionControl As New List(Of IMyRadio)
+                        Dim SelectionJson As New List(Of JToken)
+                        For Each Profile In LoginJson("availableProfiles")
+                            SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString})
+                            SelectionJson.Add(Profile)
+                        Next
+                        Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色")
+                        SelectedName = SelectionJson(SelectedIndex)("name").ToString
+                        SelectedId = SelectionJson(SelectedIndex)("id").ToString
+                    End Sub)
                    McLaunchLog("玩家选择的角色：" & SelectedName)
                End If
            Else
@@ -1072,7 +1074,8 @@ Retry:
            Case 3
                '使用正版用户名
                Try
-                    If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项（#3746）
+                    If SkinName <> "" AndAlso
+                        McVersionCurrent IsNot Nothing AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项（#3746）
                        Log("[Skin] 由于离线皮肤设置，使用正版 UUID：" & SkinName)
                        Uuid = McLoginMojangUuid(SkinName, False)
                    End If
@@ -1629,16 +1632,16 @@ NextVersion:

        '基础参数
        GameArguments.Add("${classpath_separator}", ";")
-        GameArguments.Add("${natives_directory}", GetNativesFolder())
-        GameArguments.Add("${library_directory}", PathMcFolder & "libraries")
-        GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries")
+        GameArguments.Add("${natives_directory}", ShortenPath(GetNativesFolder()))
+        GameArguments.Add("${library_directory}", ShortenPath(PathMcFolder & "libraries"))
+        GameArguments.Add("${libraries_directory}", ShortenPath(PathMcFolder & "libraries"))
        GameArguments.Add("${launcher_name}", "PCL")
        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("${game_directory}", Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1))
-        GameArguments.Add("${assets_root}", PathMcFolder & "assets")
+        GameArguments.Add("${game_directory}", ShortenPath(Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1)))
+        GameArguments.Add("${assets_root}", ShortenPath(PathMcFolder & "assets"))
        GameArguments.Add("${user_properties}", "{}")
        GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name)
        GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid)
@@ -1672,7 +1675,7 @@ NextVersion:
        GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))

        'Assets 相关参数
-        GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
+        GameArguments.Add("${game_assets}", ShortenPath(PathMcFolder & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
        GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))

        '支持库参数
@@ -1689,7 +1692,7 @@ NextVersion:
            End If
        Next
        If OptiFineCp IsNot Nothing Then CpStrings.Insert(CpStrings.Count - 2, OptiFineCp)
-        GameArguments.Add("${classpath}", Join(CpStrings, ";"))
+        GameArguments.Add("${classpath}", Join(CpStrings.Select(Function(c) ShortenPath(c)), ";"))

        Return GameArguments
    End Function
@@ -2050,8 +2053,8 @@ IgnoreCustomSkin:
                "@echo off" & vbCrLf &
                "title 启动 - " & McVersionCurrent.Name & vbCrLf &
                "echo 游戏正在启动，请稍候。" & vbCrLf &
-                "set APPDATA=""" & McVersionCurrent.PathIndie & """" & vbCrLf &
-                "cd /D """ & McVersionCurrent.PathIndie & """" & vbCrLf &
+                "set APPDATA=""" & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf &
+                "cd /D """ & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf &
                CustomCommandGlobal & vbCrLf &
                CustomCommandVersion & vbCrLf &
                """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
@@ -2062,7 +2065,7 @@ IgnoreCustomSkin:
            If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
                McLaunchLog("导出启动脚本完成，强制结束启动过程")
                AbortHint = "导出启动脚本成功！"
-                OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """")
+                OpenExplorer(CurrentLaunchOptions.SaveBatch)
                Loader.Parent.Abort()
                Exit Sub '导出脚本完成
            End If
@@ -2078,7 +2081,7 @@ IgnoreCustomSkin:
            Try
                CustomProcess.StartInfo.FileName = "cmd.exe"
                CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandGlobal & """"
-                CustomProcess.StartInfo.WorkingDirectory = PathMcFolder
+                CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
                CustomProcess.StartInfo.UseShellExecute = False
                CustomProcess.StartInfo.CreateNoWindow = True
                CustomProcess.Start()
@@ -2102,7 +2105,7 @@ IgnoreCustomSkin:
            Try
                CustomProcess.StartInfo.FileName = "cmd.exe"
                CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandVersion & """"
-                CustomProcess.StartInfo.WorkingDirectory = PathMcFolder
+                CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
                CustomProcess.StartInfo.UseShellExecute = False
                CustomProcess.StartInfo.CreateNoWindow = True
                CustomProcess.Start()
@@ -2130,18 +2133,18 @@ IgnoreCustomSkin:

        '设置环境变量
        If StartInfo.EnvironmentVariables.ContainsKey("appdata") Then
-            StartInfo.EnvironmentVariables("appdata") = PathMcFolder
+            StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
        Else
-            StartInfo.EnvironmentVariables.Add("appdata", PathMcFolder)
+            StartInfo.EnvironmentVariables.Add("appdata", ShortenPath(PathMcFolder))
        End If
        Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
-        Paths.Add(McLaunchJavaSelected.PathFolder)
+        Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
        StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")

        '设置其他参数
        StartInfo.StandardErrorEncoding = Encoding.UTF8
        StartInfo.StandardOutputEncoding = Encoding.UTF8
-        StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
+        StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie)
        StartInfo.UseShellExecute = False
        StartInfo.RedirectStandardOutput = True
        StartInfo.RedirectStandardError = True
@@ -73,7 +73,8 @@ Public Module ModMinecraft
                End If
                Dim Name As String = Folder.Split(">")(0)
                Dim Path As String = Folder.Split(">")(1)
-                If CheckPermission(Path) Then
+                Try
+                    CheckPermissionWithException(Path)
                    '若已有该文件夹，则直接重命名；没有则添加
                    Dim Renamed As Boolean = False
                    For Each OriginalFolder As McFolder In CacheMcFolderList
@@ -84,9 +85,10 @@ Public Module ModMinecraft
                        End If
                    Next
                    If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
-                Else
-                    Hint("无法访问 Minecraft 文件夹：" & Path, HintType.Critical)
-                End If
+                Catch ex As Exception
+                    MyMsgBox("失效的 Minecraft 文件夹：" & vbCrLf & Path & vbCrLf & vbCrLf & GetExceptionSummary(ex), "Minecraft 文件夹失效", IsWarn:=True)
+                    Log(ex, $"无法访问 Minecraft 文件夹 {Path}")
+                End Try
            Next

            '将自定义文件夹情况同步到设置
@@ -482,17 +484,27 @@ VersionSearchFinish:
                    Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}")
                End Function
                If _JsonText Is Nothing Then
-                    If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件：{Path}{Name}.json")
-                    _JsonText = ReadFile(Path & Name & ".json")
+                    Dim JsonPath As String = Path & Name & ".json"
+                    If Not File.Exists(JsonPath) Then
+                        '如果文件夹下只有一个 JSON 文件，则将其作为版本 JSON
+                        Dim JsonFiles As String() = Directory.GetFiles(Path, "*.json")
+                        If JsonFiles.Count = 1 Then
+                            JsonPath = JsonFiles(0)
+                            Log("[Minecraft] 未找到同名版本 JSON，自动换用 " & JsonPath, LogLevel.Debug)
+                        Else
+                            Throw New Exception($"未找到版本 JSON 文件：{Path}{Name}.json")
+                        End If
+                    End If
+                    _JsonText = ReadFile(JsonPath)
                    '如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试
                    If Not FastJsonCheck(_JsonText) Then
                        If RunInUi() Then
                            Log("[Minecraft] 版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试", LogLevel.Debug)
                            GetJson(_JsonText) '触发异常
                        Else
-                            Log("[Minecraft] 版本 JSON 文件为空或有误，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug)
+                            Log($"[Minecraft] 版本 JSON 文件为空或有误，将在 2s 后重试读取（{JsonPath}）", LogLevel.Debug)
                            Thread.Sleep(2000)
-                            _JsonText = ReadFile(Path & Name & ".json")
+                            _JsonText = ReadFile(JsonPath)
                            If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
                        End If
                    End If
@@ -779,37 +791,7 @@ ExitDataLoad:
                End If
                '确定版本描述
                Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo")
-                If CustomInfo = "" Then
-                    Select Case State
-                        Case McVersionState.Snapshot
-                            If Version.McName.ContainsF("pre", True) Then
-                                Info = "预发布版 " & Version.McName
-                            ElseIf Version.McName.ContainsF("rc", True) Then
-                                Info = "发布候选 " & Version.McName
-                            ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
-                                Info = "实验性快照"
-                            Else
-                                Info = "快照 " & Version.McName
-                            End If
-                        Case McVersionState.Old
-                            Info = "远古版本"
-                        Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
-                            Info = Version.ToString
-                        Case McVersionState.Fool
-                            Info = GetMcFoolName(Version.McName)
-                        Case McVersionState.Error
-                            '已有错误信息
-                        Case Else
-                            Info = "发生了未知错误，请向作者反馈此问题"
-                    End Select
-                    If Not State = McVersionState.Error Then
-                        If HasJumpLoader Then Info += ", JumpLoader"
-                        If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
-                        If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
-                    End If
-                Else
-                    Info = CustomInfo
-                End If
+                Info = If(CustomInfo <> "", CustomInfo, GetDefaultDescription())
                '确定版本收藏状态
                IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False)
                '确定版本显示种类
@@ -842,6 +824,41 @@ ExitDataLoad:
            End Try
            Return Me
        End Function
+        ''' <summary>
+        ''' 获取版本的默认描述。
+        ''' </summary>
+        Public Function GetDefaultDescription() As String
+            Dim Info As String = ""
+            Select Case State
+                Case McVersionState.Snapshot
+                    If Version.McName.ContainsF("pre", True) Then
+                        Info = "预发布版 " & Version.McName
+                    ElseIf Version.McName.ContainsF("rc", True) Then
+                        Info = "发布候选 " & Version.McName
+                    ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
+                        Info = "实验性快照"
+                    Else
+                        Info = "快照 " & Version.McName
+                    End If
+                Case McVersionState.Old
+                    Info = "远古版本"
+                Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
+                    Info = Version.ToString
+                Case McVersionState.Fool
+                    Info = GetMcFoolName(Version.McName)
+                Case McVersionState.Error
+                    Return Me.Info '已有错误信息
+                Case Else
+                    Info = "发生了未知错误，请向作者反馈此问题"
+            End Select
+            If Not State = McVersionState.Error Then
+                If HasJumpLoader Then Info += ", JumpLoader"
+                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 Overrides Function Equals(obj As Object) As Boolean
@@ -1123,10 +1140,10 @@ Reload:
                McVersionList = McVersionListLoadNoCache(Path)
            End If
            IsFirstMcVersionListLoad = False
-            If Loader.IsAborted Then Exit Sub

            '改变当前选择的版本
 OnLoaded:
+            If Loader.IsAborted Then Exit Sub
            If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then
                '尝试读取已储存的选择
                Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version")
@@ -1619,7 +1636,7 @@ OnLoaded:
        Dim FileAddress As String = PathTemp & "Cache\Skin\" & GetHash(Address) & ".png"
        SyncLock McSkinDownloadLock
            If Not File.Exists(FileAddress) Then
-                NetDownload(Address, FileAddress & NetDownloadEnd)
+                NetDownloadByClient(Address, FileAddress & NetDownloadEnd)
                File.Delete(FileAddress)
                FileSystem.Rename(FileAddress & NetDownloadEnd, FileAddress)
                Log("[Minecraft] 皮肤下载成功：" & FileAddress)
@@ -1962,7 +1979,7 @@ OnLoaded:
            Try
                Log("[Minecraft] 开始获取统一通行证下载信息")
                '测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
-                DownloadInfo = GetJson(NetGetCodeByDownload({
+                DownloadInfo = GetJson(NetGetCodeByLoader({
                        "https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True))
            Catch ex As Exception
                Log(ex, "获取统一通行证下载信息失败")
@@ -1985,7 +2002,7 @@ OnLoaded:
            '获取下载信息
            Try
                Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
-                DownloadInfo = GetJson(NetGetCodeByDownload({
+                DownloadInfo = GetJson(NetGetCodeByLoader({
                        "https://authlib-injector.yushi.moe/artifact/latest.json",
                        "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
                    }, IsJson:=True))
@@ -2085,8 +2102,8 @@ OnLoaded:
                   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))
-            Dim MinorVersion As Integer = If(Splited(2).Split(".").Count > 1, Val(Splited(2).Split(".")(2).BeforeFirst("_")), 0)
+            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 文件")
@@ -1,9 +1,7 @@
-Imports System.IO.Compression
-Imports System.Linq.Expressions
+Imports System.IO.Compression

 Public Module ModModpack

-#Region "安装"
    '触发整合包安装的外部接口
    ''' <summary>
    ''' 弹窗要求选择一个整合包文件并进行安装。
@@ -31,6 +29,9 @@ Public Module ModModpack
        Dim Archive As ZipArchive = Nothing
        Dim ArchiveBaseFolder As String = ""
        Try
+            '字符校验
+            Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
+            If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Critical) : Throw New CancelledException
            '获取整合包种类与关键 Json
            Dim PackType As Integer = -1
            Try
@@ -108,29 +109,7 @@ Public Module ModModpack
        End Try
    End Function

-    '整合包缓存清理
-    Private IsInstallCacheCleared As Boolean = False
-    Private IsInstallCacheClearing As Boolean = False
    Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
-        '清理缓存文件夹
-        If Not IsInstallCacheCleared Then
-            IsInstallCacheCleared = True
-            IsInstallCacheClearing = True
-            Try
-                Log("[ModPack] 开始清理整合包安装缓存")
-                DeleteDirectory(PathTemp & "PackInstall\")
-                Log("[ModPack] 已清理整合包安装缓存")
-            Catch ex As Exception
-                Log(ex, "清理整合包安装缓存失败")
-            Finally
-                IsInstallCacheClearing = False
-            End Try
-        ElseIf IsInstallCacheClearing Then
-            '等待另一个整合包安装的清理步骤完成
-            Do While IsInstallCacheClearing
-                Thread.Sleep(1)
-            Loop
-        End If
        '解压文件
        Dim RetryCount As Integer = 1
        Dim Encode = Encoding.GetEncoding("GB18030")
@@ -204,7 +183,7 @@ Retry:
            End If
        Next
        '解压与配置文件
-        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
+        Dim InstallTemp As String = RequestTaskTempFolder()
        Dim InstallLoaders As New List(Of LoaderBase)
        Dim OverrideHome As String = If(Json("overrides"), "")
        If OverrideHome <> "" Then
@@ -212,13 +191,15 @@ Retry:
            Sub(Task As LoaderTask(Of String, Integer))
                ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
                Task.Progress = 0.6
-                Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome
                '复制结果
-                If Directory.Exists(OverridePath) Then
-                    CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
-                    Log($"[ModPack] 整合包 override 复制：{OverridePath} -> {PathMcFolder & "versions\" & VersionName}")
+                Log("[ModPack] 整合包 override 目标：" & OverrideHome)
+                Dim OverrideRoot = InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome) '#5613
+                If Directory.Exists(OverrideRoot) Then
+                    Dim CopyTarget = $"{PathMcFolder}versions\{VersionName}"
+                    CopyDirectory(OverrideRoot, CopyTarget, Sub(Delta) Task.Progress += Delta * 0.35)
+                    Log($"[ModPack] 整合包 override 复制：{OverrideRoot} -> {CopyTarget}")
                Else
-                    Log($"[ModPack] 整合包中未找到 override 文件夹：{OverridePath}")
+                    Log($"[ModPack] 整合包中未找到 override 文件夹：{OverrideRoot}")
                End If
                Task.Progress = 0.95
                '开启版本隔离
@@ -314,7 +295,7 @@ Retry:
        Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
        Sub(Task As LoaderTask(Of String, String))
            '设置图标
-            Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
+            Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
            If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
                File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
                WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -328,6 +309,10 @@ Retry:
                    File.Delete(Target)
                End If
            Next
+            If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
+                Log("[ModPack] 删除安装整合包文件：" & FileAddress)
+                File.Delete(FileAddress)
+            End If
        End Sub) With {.ProgressWeight = 0.1, .Show = False})

        '重复任务检查
@@ -392,7 +377,7 @@ Retry:
            If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
        End If
        '解压和配置文件
-        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
+        Dim InstallTemp As String = RequestTaskTempFolder()
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
        Sub(Task As LoaderTask(Of String, Integer))
@@ -421,7 +406,7 @@ Retry:
            If File("env") IsNot Nothing Then
                Select Case File("env")("client").ToString
                    Case "optional"
-                        If MyMsgBox("是否要下载整合包中的可选文件 " & GetFileNameFromPath(File("path").ToString) & "？",
+                        If MyMsgBox("是否要下载可选文件 " & GetFileNameFromPath(File("path").ToString) & "？",
                                    "下载可选文件", "是", "否") = 2 Then
                            Continue For
                        End If
@@ -476,10 +461,14 @@ Retry:
                    File.Delete(Target)
                End If
            Next
+            If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
+                Log("[ModPack] 删除安装整合包文件：" & FileAddress)
+                File.Delete(FileAddress)
+            End If
        End Sub) With {.ProgressWeight = 0.1, .Show = False})

        '重复任务检查
-        Dim LoaderName As String = "Modrinth 整合包安装：" & VersionName & " "
+        Dim LoaderName As String = $"Modrinth 整合包安装：{VersionName} "
        If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
            Hint("该整合包正在安装中！", HintType.Critical)
            Throw New CancelledException
@@ -510,7 +499,7 @@ Retry:
        If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
        If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
        '解压与配置文件
-        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
+        Dim InstallTemp As String = RequestTaskTempFolder()
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
        Sub(Task As LoaderTask(Of String, Integer))
@@ -593,7 +582,7 @@ Retry:
        If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
        If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
        '解压、配置设置文件
-        Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
+        Dim InstallTemp As String = RequestTaskTempFolder()
        Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
@@ -613,21 +602,14 @@ Retry:
            Try
                Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
                If File.Exists(MMCSetupFile) Then
-                    '部分等号替换为冒号，以符合 ini 文件格式
-                    '为JvmArgs添加排除项，防止参数中的等号被错误的替换
-                    Dim MMCSetupFileLines() As String = File.ReadAllLines(MMCSetupFile)
-                    For i As Integer = 0 To MMCSetupFileLines.Length - 1
-                        '按行读取，检查开头是否为"JvmArgs="
-                        If MMCSetupFileLines(i).StartsWith("JvmArgs=") Then
-                            '有则只替换这个等号，忽略参数部分
-                            MMCSetupFileLines(i) = "JvmArgs:" & MMCSetupFileLines(i).Substring("JvmArgs=".Length)
-                        Else
-                            '无则全部替换
-                            MMCSetupFileLines(i) = MMCSetupFileLines(i).Replace("=", ":")
-                        End If
+                    '将其中的等号替换为冒号，以符合 ini 文件格式
+                    Dim Lines As New List(Of String)
+                    For Each Line In ReadFile(MMCSetupFile).Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
+                        If Not Line.Contains("=") Then Continue For
+                        Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
                    Next
-                    '修改后写回文件
-                    File.WriteAllLines(MMCSetupFile, MMCSetupFileLines)
+                    WriteFile(MMCSetupFile, Join(Lines, vbCrLf))
+                    '读取文件
                    If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
                        Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
                        If PreLaunchCommand <> "" Then
@@ -656,16 +638,17 @@ Retry:
                        CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
                        Log($"[ModPack] 迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
                    End If
-                    'JvmArgs参数
+                    'JVM 参数
                    Dim JvmArgs As String = ReadIni(MMCSetupFile, "JvmArgs", "")
                    If JvmArgs <> "" Then
-                        WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
-                        Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数：" & JvmArgs)
-                    End If
-                    '这段我看参数有就给加上了...
-                    If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
-                        WriteIni(SetupFile, "VersionAdvanceJavaArgs", True)
-                        Log("[ModPack] 迁移 MultiMC 版本独立设置：覆盖 JavaArgs")
+                        If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
+                            WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
+                            Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：" & JvmArgs)
+                        Else
+                            JvmArgs += " " & Setup.Get("LaunchAdvanceJvm")
+                            WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
+                            Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（追加）：" & JvmArgs)
+                        End If
                    End If
                End If
            Catch ex As Exception
@@ -740,7 +723,7 @@ Retry:
            If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
        End If
        '解压与配置文件
-        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
+        Dim InstallTemp As String = RequestTaskTempFolder()
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
        Sub(Task As LoaderTask(Of String, Integer))
@@ -811,7 +794,6 @@ 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
        '解压
        Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
@@ -839,8 +821,9 @@ Retry:
                '尝试使用附带的启动器打开
                If Launcher IsNot Nothing Then
                    Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
-                    If MyMsgBox($"整合包中似乎自带了启动器，是否换用它继续安装？{vbCrLf}通常推荐这样做，以获得最佳体验。{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "继续", "取消") = 1 Then
-                        ShellOnly(Launcher, "--wait")
+                    If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
+                        OpenExplorer(TargetFolder)
+                        ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
                        Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
                        FrmMain.EndProgram(False)
                        Return
@@ -848,15 +831,17 @@ Retry:
                Else
                    Log("[Modpack] 未找到压缩包中附带的启动器")
                End If
+                OpenExplorer(TargetFolder)
                '加入文件夹列表
                Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
+                Directory.CreateDirectory(TargetFolder & ".minecraft\")
                PageSelectLeft.AddFolder(
-                    TargetFolder & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
+                    TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
                    VersionName, False)
                '调用 modpack 文件进行安装
                Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
                Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile)
-                ModpackInstall(ModpackFile, VersionName)
+                ModpackInstall(ModpackFile)
            End Sub)
        })
        Loader.Start(TargetFolder)
@@ -906,340 +891,6 @@ Retry:
        Return Loader
    End Function

-#End Region
-#End Region
-
-#Region "导出"
-    Private ExpTempDir As String = PathTemp & "PackExport\"
-    ''' <summary>
-    ''' 整合包类型。
-    ''' </summary>
-    Public Enum ModpackType
-        Modrinth
-    End Enum
-    ''' <summary>
-    ''' 导出整合包的选项。
-    ''' </summary>
-    Public Class ExportOptions
-        ''' <summary>
-        ''' 要导出的版本。
-        ''' </summary>
-        Public Version As McVersion
-        ''' <summary>
-        ''' 要保存整合包的位置。
-        ''' </summary>
-        Public Dest As String
-        ''' <summary>
-        ''' 是否包括 PCL 文件。
-        ''' </summary>
-        Public IncludePCL As Boolean
-        ''' <summary>
-        ''' 整合包类型。
-        ''' </summary>
-        Public Type As ModpackType
-        ''' <summary>
-        ''' 要保留到整合包的文件。
-        ''' </summary>
-        Public Additional As String()
-        ''' <summary>
-        ''' 是否需要保留 PCL 全局设置。仅在包括 PCL 时有效。
-        ''' </summary>
-        Public PCLSetupGlobal As Boolean = True
-        ''' <summary>
-        ''' 整合包名称。
-        ''' </summary>
-        Public Name As String = ""
-        ''' <summary>
-        ''' 整合包描述。
-        ''' </summary>
-        Public Desc As String = ""
-        ''' <summary>
-        ''' 版本号。
-        ''' </summary>
-        Public VerID As String = ""
-        Public Sub New(Version As McVersion,
-                       Dest As String,
-                       IncludePCL As Boolean,
-                       Additional As String(),
-                       Optional PCLSetupGlobal As Boolean = True,
-                       Optional Name As String = "",
-                       Optional Desc As String = "",
-                       Optional VerID As String = "")
-            Me.Version = Version
-            Me.Dest = Dest
-            Me.IncludePCL = IncludePCL
-            Me.Additional = Additional
-            Me.PCLSetupGlobal = PCLSetupGlobal
-            Me.Name = Name
-            Me.Desc = Desc
-            Me.VerID = VerID
-        End Sub
-    End Class
-    ''' <summary>
-    ''' 导出整合包，返回是否成功。
-    ''' </summary>
-    Public Function ModpackExport(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean
-        If Task.Input.IncludePCL Then Return ExportCompressed(Task)
-        Return ExportModrinth(Task)
-    End Function
-
-#Region "冗余"
-    Private VersionRedundant As String() = {"^screenshots", "^backups", "^command_history\.txt$", '个人文件
-        "^.*-natives", "^server-resource-packs", "^user.*cache\.json$", "^\.optifine", "^\.fabric", "^\.mixin\.out", '缓存
-        "^.*\.jar$", "^downloads", "^realms_persistence.json$", "^\$\{natives_directory\}", "^essential", '可联网更新
-        "^logs", "^crash-reports", ".*\.log$", "^debug", '日志
-        ".*\.dat_old$", ".*\.old$", '备份
-        "^\$\{quickPlayPath\}", '服务器
-        "^\.replay_cache", "^replay_recordings", "^replay_videos", 'ReplayMod
-        "^irisUpdateInfo\.json$", 'Iris
-        "^modernfix", 'ModernFix 模组
-        "^modtranslations", 'Mod 翻译
-        "^schematics", 'schematics 模组
-        "^journeymap\\data", 'JourneyMap 模组
-        "^mods\\\.connector", '信雅互联
-        "^.*\.BakaCoreInfo$", 'BakaXL 配置
-        "^hmclversion\.cfg$", "^log4j2\.xml$", 'HMCL 配置
-        "^assets$", "^libraries$", "^\$natives$", "^launcher_profiles\.json$", "^versions$" '开启版本隔离时排除的文件
-    }
-    Public Function IsVerRedundant(FilePath As String, PathIndie As String) As Boolean
-        FilePath = FilePath.Replace("/", "\")
-        For Each regex In VersionRedundant
-            If RegexCheck(FilePath.Replace(PathIndie, ""), regex, RegularExpressions.RegexOptions.IgnoreCase) Then Return True
-        Next
-        Return False
-    End Function
-    Private MustExport As String() = {
-        "mods", "PCL", ".*\.json"
-    }
-    Public Function IsMustExport(FilePath As String, PathIndie As String) As Boolean
-        For Each regex In MustExport
-            If RegexCheck(FilePath.Replace(PathIndie, ""), regex, RegularExpressions.RegexOptions.IgnoreCase) AndAlso Not (FilePath.EndsWithF(".zip") OrElse FilePath.EndsWithF("\")) Then Return True
-        Next
-        Return False
-    End Function
-
-#End Region
-
-#Region "不同类型整合包的导出方法"
-    Private Function ExportModrinth(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean
-        Try
-            Dim Version = Task.Input.Version
-            Dim DestPath = Task.Input.Dest
-            Dim Additional = Task.Input.Additional
-            Dim Name = Task.Input.Name
-            Dim Description = Task.Input.Desc
-            Dim VerID = Task.Input.VerID
-            Log($"[Export] 导出整合包（Modrinth）：{Version.Path} -> {DestPath}，额外版本文件 {Additional.Count} 个")
-            Dim tempDir As String = $"{ExpTempDir}{GetUuid()}\"
-            Log($"[Export] 缓存文件夹：{tempDir}")
-            DeleteDirectory(tempDir)
-            Directory.CreateDirectory(tempDir)
-
-#Region "0.04-0.40：从 Modrinth 获取 Mod 工程信息，得到 URL"
-            Dim Mods As New Dictionary(Of String, McMod)
-            If Directory.Exists(Version.Path & "mods\") Then
-                For Each m In Directory.EnumerateFiles(Version.Path & "mods\")
-                    If m.EndsWithF(".jar") Then Mods.Add(GetFileNameFromPath(m), New McMod(m))
-                Next
-            End If
-
-            '从 Modrinth 获取信息
-            Dim ModrinthMapping As New Dictionary(Of String, JObject) 'Modrinth 获取到的 Mod
-            Dim CurseForgeMapping As New Dictionary(Of String, JObject) 'CurseForge 获取到的 Mod
-            Dim Failed = Mods.ToArray().ToDictionary(Function(a) a.Key, Function(a) a.Value) '获取失败的 Mod
-            Dim ModrinthHashes = Mods.Select(Function(m) m.Value.ModrinthHash).ToList()
-            If Mods.Count = 0 Then GoTo JumpMod
-            Dim ModrinthRaw = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
-    $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
-            Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地 Mod 的对应信息")
-            Task.Progress = 0.35
-
-            For Each Entry In Mods
-                If (Not ModrinthRaw.ContainsKey(Entry.Value.ModrinthHash)) OrElse
-                   (ModrinthRaw(Entry.Value.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.Value.ModrinthHash) Then
-                    Continue For
-                End If
-                Failed.Remove(Entry.Key)
-                ModrinthMapping.Add(Entry.Key, ModrinthRaw(Entry.Value.ModrinthHash)("files")(0))
-            Next
-            Task.Progress = 0.4
-#End Region
-
-#Region "0.40-0.80：从 CurseForge 继续获取"
-            Dim CurseForgeHashes = Mods.Select(Function(m) m.Value.CurseForgeHash).ToList()
-            Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
-                                    $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
-            Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
-            Task.Progress = 0.7
-
-            For Each m In CurseForgeRaw
-                Dim hash As String = ""
-                For Each h In m("file")("hashes") '获取 Modrinth Hash
-                    If h("algo").ToString = 1 Then
-                        hash = h("value")
-                        Exit For
-                    End If
-                Next
-                If String.IsNullOrEmpty(hash) OrElse String.IsNullOrEmpty(m("file")("downloadUrl")) Then Continue For
-
-                m("file")("ModrinthHash") = hash
-                Dim f = Mods.ToArray()
-                For Each file In f
-                    If file.Value.ModrinthHash = hash Then
-                        CurseForgeMapping.Add(file.Key, m("file"))
-                        Failed.Remove(file.Key)
-                        Exit For
-                    End If
-                Next
-            Next
-            Task.Progress = 0.8
-#End Region
-
-JumpMod:
-#Region "0.80-0.90：合并下载链接，复制 Logo，写入 Json 文件"
-            '获取作为检查目标的加载器和版本
-            Dim ModLoaders = GetTargetModLoaders()
-            Dim McVersion = Version.Version.McName
-            Log($"[Export] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}")
-
-            '合并下载链接
-            Dim BothUrls As New Dictionary(Of String, String()) '两个下载源都有 URL 的 Mod
-            For Each modrinth In ModrinthMapping
-                Dim curseforge As New JObject
-                If CurseForgeMapping.TryGetValue(modrinth.Key, curseforge) Then
-                    BothUrls.Add(modrinth.Key, {modrinth.Value("url"), curseforge("downloadUrl")})
-                End If
-            Next
-            Task.Progress = 0.83
-
-            Dim files As New JArray
-            For Each m In ModrinthMapping
-                files.Add(New JObject From {
-                    {"path", $"mods/{m.Key}"},
-                    {"hashes", m.Value("hashes")},
-                    {"env", New JObject From {{"client", "required"}, {"server", "required"}}},
-                    {"downloads", If(BothUrls.ContainsKey(m.Key), JArray.FromObject(BothUrls(m.Key)), New JArray From {m.Value("url")})},
-                    {"fileSize", m.Value("size")}
-                })
-            Next
-            For Each m In CurseForgeMapping
-                If Not BothUrls.ContainsKey(m.Key) Then
-                    files.Add(New JObject From {
-                        {"path", $"mods/{m.Key}"},
-                        {"hashes", New JObject From {{"sha1", m.Value("ModrinthHash").ToString}}},
-                        {"env", New JObject From {{"client", "required"}, {"server", "required"}}},
-                        {"downloads", New JArray From {m.Value("downloadUrl")}},
-                        {"fileSize", m.Value("fileLength")}
-                    })
-                End If
-            Next
-            Task.Progress = 0.86
-            'If Not String.IsNullOrEmpty(Logo) Then
-            '    Dim LogoObj As New MyBitmap(Logo)
-            '    LogoObj.Save(tempDir & "Logo.png")
-            'End If
-            'Task.Progress = 0.88
-
-            Dim depend As New JObject From {{"minecraft", McVersion}}
-            If Version.Version.HasForge Then depend.Add("forge", Version.Version.ForgeVersion)
-            If Version.Version.HasFabric Then depend.Add("fabric-loader", Version.Version.FabricVersion)
-            If Version.Version.HasNeoForge Then depend.Add("neoforge", Version.Version.NeoForgeVersion)
-
-            Dim json As New JObject From {
-                {"game", "minecraft"},
-                {"formatVersion", 1},
-                {"versionId", VerID},
-                {"name", If(String.IsNullOrEmpty(Name), Version.Name, Name)},
-                {"summary", Description},
-                {"files", files},
-                {"dependencies", depend}
-            }
-            'If Not String.IsNullOrEmpty(Logo) Then json.Add("logo", tempDir & "Logo.png")
-
-            File.WriteAllText(tempDir & "modrinth.index.json", json.ToString)
-            Task.Progress = 0.9
-#End Region
-
-#Region "0.90-0.99：将其余文件保存到 overrides 目录"
-            For Each m In Failed
-                CopyFile(m.Value.Path, tempDir & "overrides\mods\" & m.Value.FileName)
-            Next
-            Task.Progress = 0.92
-
-            '额外文件
-            For Each p In Additional
-                If String.IsNullOrWhiteSpace(p) Then Continue For '传空字串进去会直接把整个版本文件夹拷过去
-                If Not p.StartsWithF(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), IgnoreCase:=True) Then Continue For
-                Dim relative As String = p.Replace(Version.Path, "").Replace(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), "")
-                If File.Exists(p) AndAlso Not IsVerRedundant(p, Version.PathIndie) Then
-                    CopyFile(p, $"{tempDir}overrides\{relative}")
-                End If
-            Next
-            Task.Progress = 0.96
-
-            '如果 resourcepacks shaderpacks 文件夹中有文件夹格式的包，则先将文件夹压缩成 Zip 文件后再打包入对应位置
-            '这可以避免安装时出现路径长度限制而出错
-            If Directory.Exists($"{tempDir}overrides\resourcepacks\") Then
-                For Each d In Directory.EnumerateDirectories($"{tempDir}overrides\resourcepacks\")
-                    If Not File.Exists(d + ".zip") Then ZipFile.CreateFromDirectory(d, d + ".zip")
-                    DeleteDirectory(d)
-                Next
-            End If
-            If Directory.Exists($"{tempDir}overrides\shaderpacks\") Then
-                For Each d In Directory.EnumerateDirectories($"{tempDir}overrides\shaderpacks\")
-                    If Not File.Exists(d + ".zip") Then ZipFile.CreateFromDirectory(d, d + ".zip")
-                    DeleteDirectory(d)
-                Next
-            End If
-#End Region
-
-            If File.Exists(DestPath) Then File.Delete(DestPath) '选择文件的时候已经确认了要替换
-            ZipFile.CreateFromDirectory(tempDir, DestPath)
-            DeleteDirectory(tempDir)
-            Return True
-        Catch ex As Exception
-            Log(ex, "导出整合包失败", LogLevel.Msgbox)
-            Return False
-        End Try
-    End Function
-    Private Function ExportCompressed(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean
-        Try
-            Dim Version = Task.Input.Version
-            Dim DestPath = Task.Input.Dest
-            Dim Additional = Task.Input.Additional
-            Dim Name = Task.Input.Name
-            Dim VerID = Task.Input.VerID
-            Dim PCLSetupGlobal = Task.Input.PCLSetupGlobal
-            Log($"[Export] 导出整合包（含启动器）：{Version.Path} -> {DestPath}，额外版本文件 {Additional.Count} 个，全局设置 {If(PCLSetupGlobal, "导出", "不导出")}")
-            Dim tempDir As String = $"{ExpTempDir}{GetUuid()}\"
-            Log($"[Export] 最终压缩包的缓存文件夹：{tempDir}")
-            Directory.CreateDirectory(tempDir)
-
-            Task.Progress = 0.04
-
-            Log("[Export] 开始导出 Modrinth 整合包")
-            Task.Input.Dest = $"{tempDir}modpack.mrpack"
-            ExportModrinth(Task)
-
-            Log($"[Export] 正在复制 PCL 本体")
-            CopyFile(PathWithName, tempDir & GetFileNameFromPath(PathWithName))
-
-            If PCLSetupGlobal Then
-                Log($"[Export] 正在复制 PCL 全局配置")
-                CopyFile(Path & "PCL\Setup.ini", tempDir & "PCL\Setup.ini")
-            End If
-
-            If File.Exists(DestPath) Then File.Delete(DestPath) '选择文件的时候已经确认了要替换
-            ZipFile.CreateFromDirectory(tempDir, DestPath)
-            DeleteDirectory(tempDir)
-            Return True
-        Catch ex As Exception
-            Log(ex, "导出整合包失败", LogLevel.Msgbox)
-            Return False
-        End Try
-    End Function
-#End Region
-
 #End Region

 End Module