Merge branch 'Hex-Dragon:main' into issue3519

2024-08-18 07:18:59 +08:00
parent 0acd917e6b 62394e0052
commit 76549b4039
37 changed files with 2654 additions and 1565 deletions
@@ -278,7 +278,8 @@
                    End If
                    'Tags
                    Tags = New List(Of String)
-                    For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
+                    For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段：https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831
+                        Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
                        Select Case Category
                        'Mod
                            Case 406 : Tags.Add("世界元素")
@@ -387,7 +388,7 @@
                            Case "adventure" : Tags.Add("冒险")
                            Case "kitchen-sink" : Tags.Add("大杂烩")
                            Case "lightweight" : Tags.Add("轻量")
-                            'FUTURE: Res
+                                'FUTURE: Res
                        End Select
                    Next
                    If Not Tags.Any() Then Tags.Add("杂项")
@@ -962,7 +963,7 @@ Retry:
                            Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
                        Catch ex As Exception
                            Log(ex, "从 CurseForge 获取工程列表失败")
-                            Storage.CurseForgeTotal = Storage.CurseForgeOffset
+                            Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
                            [Error] = ex
                            CurseForgeFailed = True
                        End Try
@@ -995,7 +996,7 @@ Retry:
                            Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
                        Catch ex As Exception
                            Log(ex, "从 Modrinth 获取工程列表失败")
-                            Storage.ModrinthTotal = Storage.ModrinthOffset
+                            Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
                            [Error] = ex
                            ModrinthFailed = True
                        End Try
@@ -1021,7 +1022,7 @@ Retry:
                    ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
                        Throw New Exception("Modrinth 不兼容所选的类型")
                    Else
-                        Throw New Exception("没有符合条件的结果")
+                        Throw New Exception("没有搜索结果")
                    End If
                End If
            ElseIf [Error] IsNot Nothing Then
@@ -1190,10 +1191,6 @@ Retry:
        ''' </summary>
        Public DownloadUrls As List(Of String)
        ''' <summary>
-        ''' 文件所有可能的镜像源。
-        ''' </summary>
-        Public MirrorUrls As List(Of String)
-        ''' <summary>
        ''' 文件的 SHA1 或 MD5。
        ''' </summary>
        Public ReadOnly Hash As String = Nothing
@@ -1211,9 +1208,7 @@ Retry:
        ''' </summary>
        ''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
        Public Function ToNetFile(LocalAddress As String) As NetFile
-            Dim urls As List(Of String) = DownloadUrls
-            urls.AddRange(MirrorUrls)
-            Return New NetFile(urls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
+            Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
        End Function

        '实例化
@@ -1259,7 +1254,9 @@ Retry:
                    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()
+                                       Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
+                    DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源，这个写法是为了让镜像源排在后面
+                    DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
                    'Dependencies
                    If Type = CompType.Mod Then
                        RawDependencies = Data("dependencies").
@@ -1293,11 +1290,10 @@ Retry:
                    ReleaseDate = Data("date_published")
                    Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
                    DownloadCount = Data("downloads")
-                    '可能为空
-                    If CType(Data("files"), JArray).Any() Then
+                    If CType(Data("files"), JArray).Any() Then '可能为空
                        Dim File As JToken = Data("files")(0)
                        FileName = File("filename")
-                        DownloadUrls = New List(Of String) From {File("url")}
+                        DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
                        Hash = File("hashes")("sha1")
                    End If
                    'Dependencies
@@ -1331,11 +1327,6 @@ Retry:
                    If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
 #End Region
                End If
-                '末尾添加备用镜像 URL
-                MirrorUrls = New List(Of String)
-                For Each u In DownloadUrls
-                    MirrorUrls.Add(DlSourceModGet(u))
-                Next
            End If
        End Sub
        ''' <summary>
@@ -1437,24 +1428,10 @@ Retry:
        Dim TargetProject As CompProject
        If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
            TargetProject = CompProjectCache(ProjectId)
-        Else
-            Dim retryCount As Integer = 0
-Retry:
-            Dim comp As Object
-            If FromCurseForge Then 'CurseForge
-                comp = DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)
-                TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
-            Else 'Modrinth
-                comp = DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True)
-                TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
-            End If
-            If comp Is Nothing Then '获取 ("data") 时会报值不能为 null
-                If retryCount > 2 Then Throw New Exception("工程对象获取失败，请等待一段时间后刷新再试！")
-                retryCount += 1
-                Thread.Sleep(1000)
-                GoTo Retry
-            End If
-            TargetProject = New CompProject(If(FromCurseForge, comp("data"), comp))
+        ElseIf FromCurseForge Then 'CurseForge
+            TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
+        Else 'Modrinth
+            TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
        End If
        '获取工程对象的文件列表
        Log("[Comp] 开始获取文件列表：" & ProjectId)
@@ -1464,11 +1441,11 @@ Retry:
            If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
                ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
            Else '否则使用全部文件
-                ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True, BackupUrl:=DlSourceModGet($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999"))("data")
+                ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
            End If
        Else
            'Modrinth
-            ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True, BackupUrl:=DlSourceModGet($"https://api.modrinth.com/v2/project/{ProjectId}/version"))
+            ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
        End If
        CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
            Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330）
@@ -1485,8 +1462,7 @@ Retry:
                Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
                    "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
            Else
-                Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]",
-                    Accept:="application/json", IsJson:=True)
+                Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
            End If
            For Each Project In Projects
                Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
@@ -881,7 +881,10 @@ NextStack:
                                FileName = "游戏崩溃前的输出.txt"
                        End Select
                        If File.Exists(OutputFile) Then
-                            WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
+                            Dim FileEncoding As Encoding = GetEncoding(OutputFile)
+                            WriteFile(TempFolder & "Report\" & FileName,
+                                      SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
+                                      Encoding:=FileEncoding)
                        End If
                    Next
                    '导出报告
@@ -1,6 +1,4 @@
-Imports Newtonsoft
-
-Public Module ModDownload
+Public Module ModDownload

 #Region "DlClient* | Minecraft 客户端"

@@ -838,8 +836,8 @@ Public Module ModDownload
    ''' <summary>
    ''' NeoForge 版本列表，BMCLAPI。
    ''' </summary>
-    Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeVersionBmclapiMain)
-    Public Sub DlNeoForgeVersionBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
+    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)
@@ -1085,12 +1083,17 @@ Public Module ModDownload

 #End Region

-#Region "DlMod* | Mod 列表 / 信息 / 下载"
-    Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As String
+#Region "DlMod | Mod 镜像源请求"
+
+    ''' <summary>
+    ''' 对可能涉及 Mod 镜像源的请求进行处理，返回字符串或 JObject。
+    ''' 调用 NetGetCodeByRequestOnce。
+    ''' </summary>
+    Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
        Dim McimUrl As String = DlSourceModGet(Url)
        Dim Urls As New List(Of KeyValuePair(Of String, Integer))
        If McimUrl <> Url Then
-            Select Case Setup.Get("ToolDownloadVersion")
+            Select Case Setup.Get("ToolDownloadMod")
                Case 0
                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
@@ -1102,14 +1105,27 @@ Public Module ModDownload
                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
            End Select
        End If
-        Return DlModRequest(Urls, IsJson:=IsJson)
+        Dim Exs As String = ""
+        For Each Source In Urls
+            Try
+                Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000,
+                                               IsJson:=IsJson, UseBrowserUserAgent:=True)
+            Catch ex As Exception
+                Exs += ex.Message + vbCrLf
+            End Try
+        Next
+        Throw New Exception(Exs)
    End Function
-    Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String,
-                                 Optional Headers As Dictionary(Of String, String) = Nothing) As String
+
+    ''' <summary>
+    ''' 对可能涉及 Mod 镜像源的请求进行处理。
+    ''' 调用 NetRequestOnce。
+    ''' </summary>
+    Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
        Dim McimUrl As String = DlSourceModGet(Url)
        Dim Urls As New List(Of KeyValuePair(Of String, Integer))
        If McimUrl <> Url Then
-            Select Case Setup.Get("ToolDownloadVersion")
+            Select Case Setup.Get("ToolDownloadMod")
                Case 0
                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
@@ -1121,66 +1137,66 @@ Public Module ModDownload
                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
            End Select
        End If
-        Return DlModRequest(Urls, Method, Data, ContentType, Headers:=Headers)
-    End Function
-    Private Function DlModRequest(Urls As List(Of KeyValuePair(Of String, Integer)), Optional IsJson As Boolean = False) As String
-        Dim exMessage As String = ""
-        For Each url In Urls
+        Dim Exs As String = ""
+        For Each Source In Urls
            Try
-                Return NetGetCodeByDownload(url.Key, Timeout:=url.Value, IsJson:=IsJson)
+                Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000, Headers:=Headers)
            Catch ex As Exception
-                exMessage += ex.Message + vbCrLf
+                Exs += ex.Message + vbCrLf
            End Try
        Next
-        Throw New Exception(exMessage)
-    End Function
-    Private Function DlModRequest(Urls As List(Of KeyValuePair(Of String, Integer)), Method As String, Data As String,
-                                  ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
-        Dim exMessage As String = ""
-        For Each url In Urls
-            Try
-                Return NetRequestOnce(url.Key, Method, Data, ContentType, Timeout:=url.Value, Headers:=Headers)
-            Catch ex As Exception
-                exMessage += ex.Message + vbCrLf
-            End Try
-        Next
-        Throw New Exception(exMessage)
+        Throw New Exception(Exs)
    End Function
+
 #End Region

 #Region "DlSource | 镜像下载源"

-    Public Function DlSourceResourceGet(MojangBase As String) As String()
-        MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
+    Public Function DlSourceResourceGet(Original As String) As String()
+        Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
        Return {
-            MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
-            MojangBase
+            Original.
+                Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
+                Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
+                Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
+            Original
        }
    End Function

-    Public Function DlSourceLibraryGet(MojangBase As String) As String()
+    Public Function DlSourceLibraryGet(Original As String) As String()
        Return {
-            MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
-            MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
-            MojangBase
+            Original.
+                Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
+                Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
+                Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
+            Original.
+                Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
+                Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
+                Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
+            Original
        }
    End Function
-    Public Function DlSourceModGet(CfMrBase As String) As String
-        'If CfMrBase Is Nothing Then Throw New Exception("无对应的 Mod 下载地址")
-        Return CfMrBase.Replace("api.modrinth.com/v2", "mod.mcmirror.top/modrinth") _
-            .Replace("staging-api.modrinth.com/v2", "mod.mcmirror.top/modrinth") _
-            .Replace("cdn.modrinth.com", "mod.mcimirror.top") _
-            .Replace("api.curseforge.com", "mod.mcimirror.top/curseforge") _
-            .Replace("edge.forgecdn.net", "mod.mcimirror.top") _
-            .Replace("mediafilez.forgecdn.net", "mod.mcimirror.top") _
-            .Replace("media.forgecdn.net", "mod.mcimirror.top")
+
+    Public Function DlSourceModGet(Original As String) As String
+        Return Original.
+            Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
+            Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
+            Replace("cdn.modrinth.com", "mod.mcimirror.top").
+            Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
+            Replace("edge.forgecdn.net", "mod.mcimirror.top").
+            Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
+            Replace("media.forgecdn.net", "mod.mcimirror.top")
    End Function

-    Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
-        If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
+    Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
+        If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
        Return {
-            MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
-            MojangBase
+            Original.
+                Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
+                Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
+                Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
+                Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
+            Original
        }
    End Function

@@ -1,5 +1,5 @@
 Public Module ModJava
-    Public JavaListCacheVersion As Integer = 6
+    Public JavaListCacheVersion As Integer = 7

    ''' <summary>
    ''' 目前所有可用的 Java。
@@ -220,6 +220,8 @@
                JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录的话）
            End If
            JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
+            JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
+                ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java（#4286）
            If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
            Dim TargetJavaList As New List(Of JavaEntry)
            For Each Entry In JavaPreList
@@ -550,7 +552,7 @@ NoUserJava:
            '若不全为特殊引用，则清除特殊引用的地址
            Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
            For Each Pair In JavaPreList
-                If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
+                If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
                    Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
                Else
                    Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
@@ -226,7 +226,7 @@ NextInner:
                                               "如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
                                               "毕竟一个人开发也不容易（悲）……",
                                               "求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then
-                                       OpenWebsite("https://afdian.net/a/LTCat")
+                                       OpenWebsite("https://afdian.com/a/LTCat")
                                   End If
                           End Select
                       End Sub, "Donate")
@@ -511,6 +511,7 @@ NextInner:
            '无 RefreshToken
 Relogin:
            Dim OAuthCode As String = MsLoginStep1(Data)
+            If OAuthCode = "Cancel" Then Exit Sub
            If Data.IsAborted Then Throw New ThreadInterruptedException
            Data.Progress = 0.2
            OAuthTokens = MsLoginStep2(OAuthCode, False)
@@ -519,6 +520,7 @@ Relogin:
            OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True)
        End If
        '要求重新打开登录网页认证
+        If OAuthTokens(0) = "Cancel" Then Exit Sub
        If OAuthTokens(0) = "Relogin" Then GoTo Relogin
        Data.Progress = 0.35
        If Data.IsAborted Then Throw New ThreadInterruptedException
@@ -826,62 +828,18 @@ LoginFinish:
    '微软登录步骤 1：打开网页认证，获取 OAuth Code
    Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
        McLaunchLog("开始微软登录步骤 1")
-        If True OrElse OsVersion <= New Version(10, 0, 17763, 0) Then '由于 #3849，WebBrowser 已经无法正常加载微软登录网页了
-SystemBrowser:
-            'Windows 7 或老版 Windows 10 登录
-            OpenWebsite(FormLoginOAuth.LoginUrl1)
-            Dim Result As String =
-                MyMsgBoxInput("等待网页登录",
-                              "登录完成后，网页会变得完全空白，把那个空白网页的网址复制到下面的框中就行了！" & vbCrLf &
-                              "如果网络环境不佳，它可能一直加载不出来，那就只能试试用 VPN 或加速器了。",
-                              ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
-                              HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
-            If Result Is Nothing Then
-                McLaunchLog("微软登录已在步骤 1 被取消")
-                Throw New ThreadInterruptedException("$$")
-            Else
-                Return RegexSeek(Result, "(?<=code\=)[^&]+")
-            End If
-            Hint("网页登录成功，你可以关闭浏览器啦！", HintType.Finish)
+        OpenWebsite(FormLoginOAuth.LoginUrl1)
+        Dim Result As String =
+            MyMsgBoxInput("等待网页登录",
+                          "登录完成后，网页会变得完全空白。把那个空白网页的网址复制到下面的框中就行！" & vbCrLf &
+                          "如果网络环境不佳，它可能一直加载不出来，那就只能试试用 VPN 或加速器了。",
+                          ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
+                          HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
+        If Result Is Nothing Then
+            McLaunchLog("微软登录已在步骤 1 被取消")
+            Throw New ThreadInterruptedException("$$")
        Else
-            'Windows 10 登录
-            Dim ReturnCode As String = Nothing
-            Dim ReturnEx As Exception = Nothing
-            Dim IsFinished As LoadState = LoadState.Loading
-            Dim LoginForm As FormLoginOAuth = Nothing
-            Dim IsSwitchToSystemBrowser As Boolean = False
-            RunInUi(Sub()
-                        Try
-                            LoginForm = New FormLoginOAuth
-                            LoginForm.Show()
-                            AddHandler LoginForm.OnLoginSuccess, Sub(Code As String)
-                                                                     ReturnCode = Code
-                                                                     IsFinished = LoadState.Finished
-                                                                 End Sub
-                            AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean)
-                                                                      IsFinished = LoadState.Aborted
-                                                                      IsSwitchToSystemBrowser = IsSwitch
-                                                                  End Sub
-                        Catch ex As Exception
-                            ReturnEx = ex
-                            IsFinished = LoadState.Failed
-                        End Try
-                    End Sub)
-            Do While IsFinished = LoadState.Loading AndAlso Not Data.IsAborted
-                Thread.Sleep(20)
-            Loop
-            RunInUi(Sub() If LoginForm IsNot Nothing Then LoginForm.Close())
-            If IsFinished = LoadState.Finished Then
-                Return ReturnCode
-            ElseIf IsFinished = LoadState.Failed Then
-                Throw ReturnEx
-            ElseIf IsSwitchToSystemBrowser Then
-                McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
-                GoTo SystemBrowser
-            Else
-                McLaunchLog("微软登录已在步骤 1 被取消")
-                Throw New ThreadInterruptedException("$$")
-            End If
+            Return RegexSeek(Result, "(?<=code\=)[^&]+")
        End If
    End Function
    '微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
@@ -918,19 +876,112 @@ SystemBrowser:
        Dim RefreshToken As String = ResultJson("refresh_token").ToString
        Return {AccessToken, RefreshToken}
    End Function
+
+    ''微软登录步骤 1：获取 DeviceCode 并显示验证提示
+    ''https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
+    'Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
+    '    McLaunchLog("开始微软登录步骤 1：获取验证信息")
+    '    Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
+    '        $"client_id={OAuthClientId}&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
+
+    '    '从这里开始直到步骤 2 结束都没有 Review
+    '    '参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
+    '    If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码（会自动复制到剪贴板）。" & vbCrLf &
+    '                            "设备代码有时效性，若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") <> 1 Then
+    '        Return "Cancel"
+    '    End If
+
+    '    Dim DeviceCode As String = PrepareJson("device_code")
+    '    Dim UserCode As String = PrepareJson("user_code")
+    '    Dim VerifyUri As String = PrepareJson("verification_uri")
+    '    'ResultJson("expires_in")
+    '    ClipboardSet(UserCode)
+    '    OpenWebsite(VerifyUri)
+
+    '    Dim MsgBoxValue As String = ""
+    '    While MsgBoxValue IsNot "1"
+    '        MsgBoxValue = MyMsgBox("本次验证的设备代码为：" & UserCode & vbCrLf & vbCrLf & "你也可以在任意设备上打开下列网址进行验证：" & vbCrLf & VerifyUri & vbCrLf & vbCrLf & "在验证完成后，你可以直接关闭这个弹窗，PCL2 会自动完成接下来的流程。", "正版验证", "关闭", "复制网址", "复制设备代码").ToString
+    '        If MsgBoxValue = "2" Then
+    '            ClipboardSet(VerifyUri)
+    '            Continue While
+    '        ElseIf MsgBoxValue = "3" Then
+    '            ClipboardSet(UserCode)
+    '            Continue While
+    '        ElseIf MsgBoxValue = "1" Then
+    '            Exit While
+    '        End If
+    '    End While
+
+    '    Return DeviceCode
+    'End Function
+
+    ''微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
+    'Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, Optional ExpiresIn As String = "900") As String()
+    '    McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）")
+
+    '    Dim Request As String
+    '    If IsRefresh Then
+    '        Request = "grant_type=refresh_token" & "&" &
+    '                  "client_id=" & OAuthClientId & "&" &
+    '                  "device_code=" & Code & "&" &
+    '                  "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
+    '                  "scope=XboxLive.signin%20offline_access"
+    '    Else
+    '        Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
+    '                  "client_id=" & OAuthClientId & "&" &
+    '                  "device_code=" & Code & "&" &
+    '                  "scope=XboxLive.signin%20offline_access"
+    '    End If
+    '    Dim Result As String
+    '    Dim stopwatch As Stopwatch = Stopwatch.StartNew()
+
+    '    While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
+    '        Try
+    '            Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
+    '        Catch ex As Exception
+    '            If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
+    '                Return {"Relogin", ""}
+    '            ElseIf ex.Message.Contains("authorization_declined") Then
+    '                Hint("你拒绝了 PCL2 的访问权限申请，验证过程被中断！")
+    '                Return {"Cancel", ""}
+    '            ElseIf ex.Message.Contains("expired_token") Then
+    '                Hint("Token 已过期，请尝试重新验证！")
+    '                Exit While
+    '            ElseIf ex.Message.Contains("AADSTS70016") Then
+    '                Continue While
+    '            Else
+    '                Throw
+    '            End If
+    '        End Try
+
+    '        If Result IsNot Nothing Then
+    '            Dim ResultJson As JObject = GetJson(Result)
+    '            Dim AccessToken As String = ResultJson("access_token").ToString
+    '            Dim RefreshToken As String = ResultJson("refresh_token").ToString
+    '            Return {AccessToken, RefreshToken}
+    '        End If
+
+    '        Thread.Sleep(1000)
+    '    End While
+
+    '    Hint("验证超时，请尝试重新验证！")
+    '    Return {"Cancel", ""}
+
+    'End Function
+
    '微软登录步骤 3：从 OAuth AccessToken 获取 XBLToken
    Private Function MsLoginStep3(AccessToken As String) As String
        McLaunchLog("开始微软登录步骤 3")

        Dim Request As String = "{
-                                    ""Properties"": {
-                                        ""AuthMethod"": ""RPS"",
-                                        ""SiteName"": ""user.auth.xboxlive.com"",
-                                        ""RpsTicket"": """ & AccessToken & """
-                                    },
-                                    ""RelyingParty"": ""http://auth.xboxlive.com"",
-                                    ""TokenType"": ""JWT""
-                                 }"
+           ""Properties"": {
+               ""AuthMethod"": ""RPS"",
+               ""SiteName"": ""user.auth.xboxlive.com"",
+               ""RpsTicket"": """ & AccessToken & """
+           },
+           ""RelyingParty"": ""http://auth.xboxlive.com"",
+           ""TokenType"": ""JWT""
+        }" 'TODO: 新版登录改为 ""RpsTicket"": ""d=" & AccessToken & """
        Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)

        Dim ResultJson As JObject = GetJson(Result)
@@ -1087,7 +1138,7 @@ SystemBrowser:
            Case 3
                '使用正版用户名
                Try
-                    If Not SkinName = "" Then
+                    If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项（#3746）
                        Log("[Skin] 由于离线皮肤设置，使用正版 UUID：" & SkinName)
                        Uuid = McLoginMojangUuid(SkinName, False)
                    End If
@@ -1217,7 +1268,7 @@ SystemBrowser:
        '统一通行证检测
        If Setup.Get("LoginType") = McLoginType.Nide Then
            '至少 Java 8u101
-            MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer)
+            MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
        End If

        SyncLock JavaLock
@@ -1244,12 +1295,12 @@ SystemBrowser:
            ElseIf MaxVer < New Version(1, 8, 0, 0) Then
                JavaCode = 7
                If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
-            ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
-                JavaCode = "8u101"
-                If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$")
-            ElseIf MinVer > New Version(1, 8, 0, 100) Then
-                JavaCode = "8u101"
-                If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$")
+            ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
+                JavaCode = "8u141"
+                If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
+            ElseIf MinVer > New Version(1, 8, 0, 140) Then
+                JavaCode = "8u141"
+                If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$")
            ElseIf MaxVer < New Version(1, 8, 0, 321) Then
                JavaCode = 8
                If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
@@ -1803,7 +1854,6 @@ NextVersion:
            {
              ""authenticationDatabase"": {
                ""00000111112222233333444445555566"": {
-                  ""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
                  ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
                  ""profiles"": {
                    ""66666555554444433333222221111100"": {
@@ -1834,7 +1884,6 @@ NextVersion:
                    {
                      ""authenticationDatabase"": {
                        ""00000111112222233333444445555566"": {
-                          ""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
                          ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
                          ""profiles"": {
                            ""66666555554444433333222221111100"": {
@@ -1910,16 +1959,12 @@ NextVersion:
        End Try

        '离线皮肤 Alex 警告
-        Try
-            If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2
+        If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7
               McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
               (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
               (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
-                Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Critical)
-            End If
-        Catch ex As Exception
-            Log(ex, "检查离线皮肤失效失败")
-        End Try
+            Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Critical)
+        End If

        '离线皮肤资源包
        Try
@@ -565,6 +565,7 @@ Recheck:
                            Log(ex, "合并版本依赖项 json 失败（" & If(InheritVersion, "null").ToString & "）")
                        End Try
                    Catch ex As Exception
+                        Log($"[Minecraft] 传入的版本 json 文件内容（共 {Text.Length} 字符，最多输出前 5000 字符）：{vbCrLf}{Text.Substring(0, 5000)}")
                        Throw New Exception("版本 json 不规范（" & If(Name, "null") & "）", ex)
                    End Try
                    Try
@@ -665,7 +666,7 @@ Recheck:
            Try
                Dim JsonObjCheck = JsonObject
            Catch ex As Exception
-                Log(ex, "版本 json 可用性检查失败（" & Path & "）")
+                Log(ex, "版本 JSON 可用性检查失败（" & Path & "）")
                JsonText = ""
                JsonObject = Nothing
                Info = ex.Message
@@ -2026,8 +2027,9 @@ OnLoaded:
            If Token.Url IsNot Nothing Then
                '获取 Url 的真实地址
                Urls.Add(Token.Url)
-                If Token.Url.Contains("launcher.mojang.com/v1/objects") Then
-                    Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
+                If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
+                   Token.Url.Contains(".tsrg") Then
+                    Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings（#4425）
                End If
                If Token.Url.Contains("maven") Then
                    Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").
@@ -2049,7 +2051,7 @@ OnLoaded:
                '普通文件
                Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
            End If
-            Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker))
+            Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
        Next
        '去重并返回
        Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
@@ -924,7 +924,7 @@ Finished:
        End Try
    End Sub
    '联网加载 Mod 详情
-    Private Const LocalModCacheVersion As Integer = 5
+    Private Const LocalModCacheVersion As Integer = 6
    Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
    Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
        Dim Mods As List(Of McMod) = Loader.Input.Key
@@ -973,7 +973,7 @@ Finished:
                Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
                '步骤 3：获取工程信息
                If Not ModrinthMapping.Any() Then Exit Sub
-                Dim ModrinthProject = CType(GetJson(NetRequestRetry(
+                Dim ModrinthProject = CType(GetJson(DlModRequest(
                    $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
                    "GET", "", "application/json")), JArray)
                For Each ProjectJson In ModrinthProject
@@ -1022,7 +1022,7 @@ Finished:
                    CurseForgeHashes.Add(Entry.CurseForgeHash)
                    If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
                Next
-                Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", "POST",
+                Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
                                    $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
                Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
                '步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
@@ -1050,7 +1050,7 @@ Finished:
                Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
                Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
                For Each ProjectJson In CurseForgeProject
-                    If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
+                    If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
                    '设置 Entry 中的工程信息
                    Dim Project As New CompProject(ProjectJson)
                    For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
@@ -1066,7 +1066,8 @@ Finished:
                        Dim NewestVersion As String = Nothing
                        Dim NewestFileIds As New List(Of Integer)
                        For Each IndexEntry In ProjectJson("latestFilesIndexes")
-                            If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
+                            If IndexEntry("modLoader") Is Nothing OrElse Not IndexEntry("modLoader").HasValues OrElse '镜像源会返回一个值为 null 的键
+                            ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
                            Dim IndexVersion As String = IndexEntry("gameVersion")
                            If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
                            '由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件
@@ -1134,6 +1135,8 @@ Finished:
            Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
        Next
        WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
+        '刷新下边栏（#4377）
+        RunInUi(Sub() FrmVersionMod?.RefreshBottomBar())
    End Sub
    Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
        Dim ModLoaders As New List(Of CompModLoaderType)
@@ -1275,4 +1278,4 @@ Finished:
    End Function
 #End If

-End Module
+End Module
@@ -12,9 +12,10 @@ Public Module ModModpack
        RunInThread(Sub() ModpackInstall(File))
    End Sub
    ''' <summary>
-    ''' 安装一个给定的整合包文件，返回是否安装成功。必须在工作线程执行。
+    ''' 安装一个给定的整合包文件，返回启动的安装加载器，如果未成功启动则返回 Nothing。
+    ''' 必须在工作线程执行。
    ''' </summary>
-    Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean
+    Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As LoaderCombo(Of String)
        Log("[ModPack] 整合包安装请求：" & If(File, "null"))
        Dim Archive As ZipArchive = Nothing
        Dim ArchiveBaseFolder As String = ""
@@ -45,6 +46,7 @@ Public Module ModModpack
                    If FullNames.Count <> 2 Then Continue For
                    '判断是否为关键文件
                    If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
+                    If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
                    If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
                    If FullNames(1) = "manifest.json" Then
                        Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
@@ -55,54 +57,52 @@ Public Module ModModpack
                        End If
                    End If
                    If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
-                    If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
                Next
            Catch ex As Exception
                If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
                    Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
-                    Return False
+                    Return Nothing
                ElseIf File.EndsWithF(".rar", True) Then
                    Log(ex, "PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
-                    Return False
+                    Return Nothing
                Else
                    Log(ex, "打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
-                    Return False
+                    Return Nothing
                End If
            End Try
            '执行对应的安装方法
            Select Case PackType
                Case 0
                    Log("[ModPack] 整合包种类：CurseForge")
-                    InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
+                    Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
                Case 1
                    Log("[ModPack] 整合包种类：HMCL")
-                    InstallPackHMCL(File, Archive, ArchiveBaseFolder)
+                    Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
                Case 2
                    Log("[ModPack] 整合包种类：MMC")
-                    InstallPackMMC(File, Archive, ArchiveBaseFolder)
+                    Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
                Case 3
                    Log("[ModPack] 整合包种类：MCBBS")
-                    InstallPackMCBBS(File, Archive, ArchiveBaseFolder)
+                    Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
                Case 4
                    Log("[ModPack] 整合包种类：Modrinth")
-                    InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
+                    Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
                Case 9
                    Log("[ModPack] 整合包种类：压缩包")
                    Archive.Dispose()
                    Archive = Nothing
-                    InstallPackCompress(File, ArchiveBaseFolder)
+                    Return InstallPackCompress(File, ArchiveBaseFolder)
                Case Else
                    If ShowHint Then
                        Hint("未能识别该整合包的种类，无法安装！", HintType.Critical)
                    Else
                        Log("[ModPack] 未能识别该整合包的种类，无法安装！")
                    End If
-                    Return False
+                    Return Nothing
            End Select
-            Return True
        Catch ex As Exception
            Log(ex, "准备安装整合包失败", LogLevel.Feedback)
-            Return False
+            Return Nothing
        Finally
            If Archive IsNot Nothing Then Archive.Dispose()
        End Try
@@ -159,7 +159,8 @@ Retry:
 #Region "不同类型整合包的安装方法"

    'CurseForge
-    Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
+    Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
+                                           Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)

        '读取 Json 文件
        Dim Json As JObject
@@ -167,18 +168,18 @@ Retry:
            Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
            If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
        Catch ex As Exception
-            Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
-            Exit Sub
+            Log(ex, "CurseForge 整合包安装信息存在问题", LogLevel.Hint)
+            Return Nothing
        End Try

        '获取版本名
        Dim ShowRibble As Boolean = VersionName Is Nothing
        If VersionName Is Nothing Then
-            Dim PackName As String = If(Json("name"), "")
+            VersionName = If(Json("name"), "")
            Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
-            If Validate.Validate(PackName) <> "" Then PackName = ""
-            VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
-            If String.IsNullOrEmpty(VersionName) Then Exit Sub
+            If Validate.Validate(VersionName) <> "" Then VersionName = ""
+            If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+            If String.IsNullOrEmpty(VersionName) Then Return Nothing
        End If

        '获取 Mod API 版本信息
@@ -191,7 +192,7 @@ Retry:
                'Forge 指定
                If Id.Contains("recommended") Then
                    Log("[ModPack] 该整合包版本过老，已不支持进行安装！", LogLevel.Hint)
-                    Exit Sub
+                    Return Nothing
                End If
                Try
                    Log("[ModPack] 整合包 Forge 版本：" & Id)
@@ -319,7 +320,7 @@ Retry:
            .FabricVersion = FabricVersion
        }
        Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
-        If MergeLoaders Is Nothing Then Exit Sub
+        If MergeLoaders Is Nothing Then Return Nothing
        '构造 Libraries 加载器
        Dim LoadersLib As New List(Of LoaderBase)
        LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -350,14 +351,10 @@ Retry:

        '重复任务检查
        Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " "
-        SyncLock LoaderTaskbarLock
-            For i = 0 To LoaderTaskbar.Count - 1
-                If LoaderTaskbar(i).Name = LoaderName Then
-                    Hint("该整合包正在安装中！", HintType.Critical)
-                    Exit Sub
-                End If
-            Next
-        End SyncLock
+        If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
+            Hint("该整合包正在安装中！", HintType.Critical)
+            Return Nothing
+        End If

        '启动
        Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -365,11 +362,11 @@ Retry:
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
        If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
-
-    End Sub
+        Return Loader
+    End Function

    'Modrinth
-    Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
+    Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)

        '读取 Json 文件
        Dim Json As JObject
@@ -378,7 +375,7 @@ Retry:
            If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
        Catch ex As Exception
            Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
-            Exit Sub
+            Return Nothing
        End Try
        '获取 Mod API 版本信息
        Dim MinecraftVersion As String = Nothing
@@ -400,42 +397,42 @@ Retry:
                    Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion)
                Case "quilt-loader" 'eg. 1.0.0
                    Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
-                    Exit Sub
+                    Return Nothing
                Case Else
                    Hint($"无法安装整合包，其中出现了未知的 Mod 加载器 {Entry.Value}！", HintType.Critical)
-                    Exit Sub
+                    Return Nothing
            End Select
        Next
        '获取版本名
        Dim ShowRibble As Boolean = VersionName Is Nothing
        If VersionName Is Nothing Then
-            Dim PackName As String = If(Json("name"), "")
+            VersionName = If(Json("name"), "")
            Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
-            If Validate.Validate(PackName) <> "" Then PackName = ""
-            VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
-            If String.IsNullOrEmpty(VersionName) Then Exit Sub
+            If Validate.Validate(VersionName) <> "" Then VersionName = ""
+            If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+            If String.IsNullOrEmpty(VersionName) Then Return Nothing
        End If
        '解压和配置文件
        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
-            Sub(Task As LoaderTask(Of String, Integer))
-                UnpackFiles(InstallTemp, FileAddress, Task)
-                Task.Progress = 0.5
-                '复制 overrides 文件夹和 client-overrides 文件夹
-                If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
-                    CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
-                Else
-                    Log("[ModPack] 整合包中未找到 override 目录，已跳过")
-                End If
-                Task.Progress = 0.8
-                If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
-                    CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
-                End If
-                Task.Progress = 0.9
-                '开启版本隔离
-                WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
-            End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
+        Sub(Task As LoaderTask(Of String, Integer))
+            UnpackFiles(InstallTemp, FileAddress, Task)
+            Task.Progress = 0.5
+            '复制 overrides 文件夹和 client-overrides 文件夹
+            If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
+                CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
+            Else
+                Log("[ModPack] 整合包中未找到 override 目录，已跳过")
+            End If
+            Task.Progress = 0.8
+            If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
+                CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
+            End If
+            Task.Progress = 0.9
+            '开启版本隔离
+            WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+        End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
        '获取下载文件列表
        Dim FileList As New List(Of NetFile)
        For Each File In If(Json("files"), {})
@@ -452,8 +449,10 @@ Retry:
                End Select
            End If
            '添加下载文件
-            FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
-                PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
+            Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
+            Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
+            Urls = Urls.Distinct.ToList()
+            FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
                New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
        Next
        If FileList.Any Then
@@ -470,7 +469,7 @@ Retry:
            .FabricVersion = FabricVersion
        }
        Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
-        If MergeLoaders Is Nothing Then Exit Sub
+        If MergeLoaders Is Nothing Then Return Nothing
        '构造 Libraries 加载器
        Dim LoadersLib As New List(Of LoaderBase)
        LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -501,14 +500,10 @@ Retry:

        '重复任务检查
        Dim LoaderName As String = "Modrinth 整合包安装：" & VersionName & " "
-        SyncLock LoaderTaskbarLock
-            For i = 0 To LoaderTaskbar.Count - 1
-                If LoaderTaskbar(i).Name = LoaderName Then
-                    Hint("该整合包正在安装中！", HintType.Critical)
-                    Exit Sub
-                End If
-            Next
-        End SyncLock
+        If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
+            Hint("该整合包正在安装中！", HintType.Critical)
+            Return Nothing
+        End If

        '启动
        Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -516,25 +511,26 @@ Retry:
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
        If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
+        Return Loader

-    End Sub
+    End Function

    'HMCL
-    Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
+    Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
        '读取 Json 文件
        Dim Json As JObject
        Try
            Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
        Catch ex As Exception
            Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
-            Exit Sub
+            Return Nothing
        End Try
        '获取版本名
-        Dim PackName As String = If(Json("name"), "")
+        Dim VersionName As String = If(Json("name"), "")
        Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
-        If Validate.Validate(PackName) <> "" Then PackName = ""
-        Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
-        If VersionName Is Nothing Then Exit Sub
+        If Validate.Validate(VersionName) <> "" Then VersionName = ""
+        If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+        If String.IsNullOrEmpty(VersionName) Then Return Nothing
        '解压与配置文件
        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
        Dim InstallLoaders As New List(Of LoaderBase)
@@ -555,7 +551,7 @@ Retry:
        '构造加载器
        If Json("gameVersion") Is Nothing Then
            Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
-            Exit Sub
+            Return Nothing
        End If
        Dim Request As New McInstallRequest With {
            .TargetVersionName = VersionName,
@@ -563,7 +559,7 @@ Retry:
            .MinecraftName = Json("gameVersion").ToString
        }
        Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
-        If MergeLoaders Is Nothing Then Exit Sub
+        If MergeLoaders Is Nothing Then Return Nothing
        '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
        Dim LoadersLib As New List(Of LoaderBase)
        LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）",
@@ -591,14 +587,10 @@ Retry:

        '重复任务检查
        Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
-        SyncLock LoaderTaskbarLock
-            For i = 0 To LoaderTaskbar.Count - 1
-                If LoaderTaskbar(i).Name = LoaderName Then
-                    Hint("该整合包正在安装中！", HintType.Critical)
-                    Exit Sub
-                End If
-            Next
-        End SyncLock
+        If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
+            Hint("该整合包正在安装中！", HintType.Critical)
+            Return Nothing
+        End If

        '启动
        Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -607,10 +599,11 @@ Retry:
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
        FrmMain.BtnExtraDownload.Ribble()
-    End Sub
+        Return Loader
+    End Function

    'MMC
-    Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
+    Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
        '读取 Json 文件
        Dim PackJson As JObject, PackInstance As String
        Try
@@ -618,14 +611,14 @@ Retry:
            PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
        Catch ex As Exception
            Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
-            Exit Sub
+            Return Nothing
        End Try
        '获取版本名
-        Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
+        Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
        Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
-        If Validate.Validate(PackName) <> "" Then PackName = ""
-        Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
-        If VersionName Is Nothing Then Exit Sub
+        If Validate.Validate(VersionName) <> "" Then VersionName = ""
+        If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+        If String.IsNullOrEmpty(VersionName) Then Return Nothing
        '解压、配置设置文件
        Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
        Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
@@ -685,7 +678,7 @@ Retry:
        '构造版本安装请求
        If PackJson("components") Is Nothing Then
            Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
-            Exit Sub
+            Return Nothing
        End If
        Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
        For Each Component In PackJson("components")
@@ -702,12 +695,12 @@ Retry:
                    Request.FabricVersion = Component("version")
                Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
                    Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
-                    Exit Sub
+                    Return Nothing
            End Select
        Next
        '构造加载器
        Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
-        If MergeLoaders Is Nothing Then Exit Sub
+        If MergeLoaders Is Nothing Then Return Nothing
        '构造 Libraries 加载器
        Dim LoadersLib As New List(Of LoaderBase)
        LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -720,14 +713,10 @@ Retry:

        '重复任务检查
        Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
-        SyncLock LoaderTaskbarLock
-            For i = 0 To LoaderTaskbar.Count - 1
-                If LoaderTaskbar(i).Name = LoaderName Then
-                    Hint("该整合包正在安装中！", HintType.Critical)
-                    Exit Sub
-                End If
-            Next
-        End SyncLock
+        If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
+            Hint("该整合包正在安装中！", HintType.Critical)
+            Return Nothing
+        End If

        '启动
        Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -735,10 +724,12 @@ Retry:
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
        FrmMain.BtnExtraDownload.Ribble()
-    End Sub
+        Return Loader
+    End Function

    'MCBBS
-    Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
+    Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
+                                      Optional VersionName As String = Nothing) As LoaderCombo(Of String)
        '读取 Json 文件
        Dim Json As JObject
        Try
@@ -746,14 +737,17 @@ Retry:
            Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
        Catch ex As Exception
            Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
-            Exit Sub
+            Return Nothing
        End Try
        '获取版本名
-        Dim PackName As String = If(Json("name"), "")
-        Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
-        If Validate.Validate(PackName) <> "" Then PackName = ""
-        Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
-        If VersionName Is Nothing Then Exit Sub
+        Dim ShowRibble As Boolean = VersionName Is Nothing
+        If VersionName Is Nothing Then
+            VersionName = If(Json("name"), "")
+            Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
+            If Validate.Validate(VersionName) <> "" Then VersionName = ""
+            If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+            If String.IsNullOrEmpty(VersionName) Then Return Nothing
+        End If
        '解压与配置文件
        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
        Dim InstallLoaders As New List(Of LoaderBase)
@@ -774,7 +768,7 @@ Retry:
        '构造加载器
        If Json("addons") Is Nothing Then
            Hint("该整合包未提供游戏版本附加信息，无法安装！", HintType.Critical)
-            Exit Sub
+            Return Nothing
        End If
        Dim Addons As New Dictionary(Of String, String)
        For Each Entry In Json("addons")
@@ -782,11 +776,11 @@ Retry:
        Next
        If Not Addons.ContainsKey("game") Then
            Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
-            Exit Sub
+            Return Nothing
        End If
        If Addons.ContainsKey("quilt") Then
            Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
-            Exit Sub
+            Return Nothing
        End If
        Dim Request As New McInstallRequest With {
            .TargetVersionName = VersionName,
@@ -798,7 +792,7 @@ Retry:
            .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
        }
        Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
-        If MergeLoaders Is Nothing Then Exit Sub
+        If MergeLoaders Is Nothing Then Return Nothing
        '构造 Libraries 加载器
        Dim LoadersLib As New List(Of LoaderBase)
        LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -811,14 +805,10 @@ Retry:

        '重复任务检查
        Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
-        SyncLock LoaderTaskbarLock
-            For i = 0 To LoaderTaskbar.Count - 1
-                If LoaderTaskbar(i).Name = LoaderName Then
-                    Hint("该整合包正在安装中！", HintType.Critical)
-                    Exit Sub
-                End If
-            Next
-        End SyncLock
+        If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
+            Hint("该整合包正在安装中！", HintType.Critical)
+            Return Nothing
+        End If

        '启动
        Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -826,28 +816,36 @@ Retry:
        Loader.Start(Request.TargetVersionFolder)
        LoaderTaskbarAdd(Loader)
        FrmMain.BtnExtraDownload.ShowRefresh()
-        FrmMain.BtnExtraDownload.Ribble()
-    End Sub
+        If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
+        Return Loader
+    End Function

    '普通压缩包
-    Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String)
+    Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String)
        MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹，它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
        '获取解压路径
        Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
-        If String.IsNullOrEmpty(TargetFolder) Then Exit Sub
-        If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Exit Sub
-        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Exit Sub
+        If String.IsNullOrEmpty(TargetFolder) Then Return Nothing
+        If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Return Nothing
+        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Return Nothing
        '要求显示名称
        Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
                                              New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
-        If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
+        If String.IsNullOrWhiteSpace(NewName) Then Return Nothing
        '解压
-        Hint("正在解压压缩包……")
-        UnpackFiles(TargetFolder, FileAddress, Nothing)
-        '加入文件夹列表
-        PageSelectLeft.AddFolder(TargetFolder, NewName, False)
-        Hint("已加入游戏文件夹列表：" & NewName, HintType.Finish)
-    End Sub
+        Dim Loader As New LoaderCombo(Of String)("安装压缩包", {
+             New LoaderTask(Of String, Integer)("安装压缩包",
+             Sub()
+                 UnpackFiles(TargetFolder, FileAddress, Nothing)
+                 PageSelectLeft.AddFolder(TargetFolder, NewName, False) '加入文件夹列表
+             End Sub)
+        })
+        Loader.Start()
+        LoaderTaskbarAdd(Loader)
+        FrmMain.BtnExtraDownload.ShowRefresh()
+        FrmMain.BtnExtraDownload.Ribble()
+        Return Loader
+    End Function

 #End Region