2.9.1

2025-02-22 01:20:08 +08:00
parent 1a0c7b0520
commit 503244a0de
62 changed files with 3399 additions and 1875 deletions
@@ -12,13 +12,13 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.8.13" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.8.13." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.9.1" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.9.1." & VersionBranchCode '标准格式的四段式版本号
    Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
-    Public Const VersionCode As Integer = 347 'Release
+    Public Const VersionCode As Integer = 352 'Release
 #Else
-    Public Const VersionCode As Integer = 348 'Snapshot
+    Public Const VersionCode As Integer = 351 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -180,10 +180,6 @@ Public Module ModBase
        ''' </summary>
        Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z"
        ''' <summary>
-        ''' 图标，向右箭头，1x
-        ''' </summary>
-        Public Const IconButtonRight As String = "M757.792745 435.407215L419.597482 96.904967c-40.010393-40.010393-104.886579-40.010393-144.896972 0-40.010393 40.010393-40.010393 104.988908 0 144.9993L540.344959 507.855701 274.70051 773.807135c-40.010393 40.112721-40.010393 104.988908 0 144.9993 40.010393 40.010393 104.886579 40.010393 144.896972 0l338.092935-338.39992c40.112721-40.010393 40.112721-104.988908 0.102328-144.9993z"
-        ''' <summary>
        ''' 图标，音符，1x
        ''' </summary>
        Public Const IconMusic As String = "M348.293565 716.53287V254.797913c0-41.672348 28.004174-78.358261 68.919652-90.37913L815.994435 40.826435c62.775652-18.610087 125.907478 26.579478 125.907478 89.933913v539.158261c8.013913 42.25113-8.94887 89.177043-47.014956 127.109565a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c21.014261 1.024 40.514783 5.164522 57.878261 12.065391V233.338435c0-12.109913-10.551652-20.034783-20.569044-20.034783a24.620522 24.620522 0 0 0-5.787826 0.934957L439.785739 338.18713a19.545043 19.545043 0 0 0-14.825739 19.144348v438.984348H423.846957c11.53113 43.987478-5.164522 94.208-45.412174 134.322087a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c20.791652 1.024 40.069565 5.075478 57.299478 11.842783z"
@@ -961,17 +957,17 @@ Public Module ModBase
    ''' <param name="FileFilter">要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
    ''' <param name="Title">弹窗的标题。</param>
    ''' <param name="FileName">默认的文件名。</param>
-    Public Function SelectAs(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional DefaultDir As String = Nothing) As String
+    Public Function SelectSaveFile(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional InitialDirectory As String = Nothing) As String
        Using fileDialog As New Forms.SaveFileDialog
            fileDialog.AddExtension = True
            fileDialog.AutoUpgradeEnabled = True
            fileDialog.Title = Title
            fileDialog.FileName = FileName
            If FileFilter IsNot Nothing Then fileDialog.Filter = FileFilter
-            If DefaultDir IsNot Nothing Then fileDialog.InitialDirectory = DefaultDir
+            If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
            fileDialog.ShowDialog()
-            SelectAs = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
-            Log("[UI] 选择文件返回：" & SelectAs)
+            SelectSaveFile = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
+            Log("[UI] 选择文件返回：" & SelectSaveFile)
        End Using
    End Function
    ''' <summary>
@@ -979,7 +975,7 @@ Public Module ModBase
    ''' </summary>
    ''' <param name="FileFilter">要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
    ''' <param name="Title">弹窗的标题。</param>
-    Public Function SelectFile(FileFilter As String, Title As String) As String
+    Public Function SelectFile(FileFilter As String, Title As String, Optional InitialDirectory As String = Nothing) As String
        Using fileDialog As New Forms.OpenFileDialog
            fileDialog.AddExtension = True
            fileDialog.AutoUpgradeEnabled = True
@@ -988,6 +984,7 @@ Public Module ModBase
            fileDialog.Multiselect = False
            fileDialog.Title = Title
            fileDialog.ValidateNames = True
+            If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
            fileDialog.ShowDialog()
            Log("[UI] 选择单个文件返回：" & fileDialog.FileName)
            Return fileDialog.FileName
@@ -1084,6 +1081,37 @@ Re:
        End Try
    End Function
    ''' <summary>
+    ''' 获取文件 SHA512，若失败则返回空字符串。
+    ''' </summary>
+    Public Function GetFileSHA512(FilePath As String) As String
+        Dim Retry As Boolean = False
+Re:
+        Try
+            ''检测该文件是否在下载中，若在下载则放弃检测
+            'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
+            '获取 SHA512
+            Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
+            Dim sha512 As SHA512 = New SHA512CryptoServiceProvider()
+            Dim retval As Byte() = sha512.ComputeHash(file)
+            file.Close()
+            Dim Result As New StringBuilder()
+            For i As Integer = 0 To retval.Length - 1
+                Result.Append(retval(i).ToString("x2"))
+            Next
+            Return Result.ToString
+        Catch ex As Exception
+            If Retry OrElse TypeOf ex Is FileNotFoundException Then
+                Log(ex, "获取文件 SHA512 失败：" & FilePath)
+                Return ""
+            Else
+                Retry = True
+                Log(ex, "获取文件 SHA512 可重试失败：" & FilePath, LogLevel.Normal)
+                Thread.Sleep(RandomInteger(200, 500))
+                GoTo Re
+            End If
+        End Try
+    End Function
+    ''' <summary>
    ''' 获取文件 SHA256，若失败则返回空字符串。
    ''' </summary>
    Public Function GetFileSHA256(FilePath As String) As String
@@ -1094,8 +1122,8 @@ Re:
            'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
            '获取 SHA256
            Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
-            Dim sha1 As SHA256 = New SHA256CryptoServiceProvider()
-            Dim retval As Byte() = sha1.ComputeHash(file)
+            Dim sha256 As SHA256 = New SHA256CryptoServiceProvider()
+            Dim retval As Byte() = sha256.ComputeHash(file)
            file.Close()
            Dim Result As New StringBuilder()
            For i As Integer = 0 To retval.Length - 1
@@ -1144,7 +1172,7 @@ Re:
        End Try
    End Function
    ''' <summary>
-    ''' 获取流 SHA1，若失败则返回空字符串。
+    ''' 获取流的 SHA1，若失败则返回空字符串。
    ''' </summary>
    Public Function GetAuthSHA1(Stream As Stream) As String
        Try
@@ -1336,11 +1364,22 @@ RetryDir:
    ''' 遍历文件夹中的所有文件。
    ''' </summary>
    Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
-        Dim Info As New DirectoryInfo(Directory)
+        Dim Info As New DirectoryInfo(ShortenPath(Directory))
        If Not Info.Exists Then Return New List(Of FileInfo)
        Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
    End Function

+    ''' <summary>
+    ''' 若路径长度大于指定值，则将长路径转换为短路径。
+    ''' </summary>
+    Public Function ShortenPath(LongPath As String, Optional ShortenThreshold As Integer = 247) As String
+        If LongPath.Length <= ShortenThreshold Then Return LongPath
+        Dim ShortPath As New StringBuilder(260)
+        GetShortPathName(LongPath, ShortPath, 260)
+        Return ShortPath.ToString
+    End Function
+    Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As StringBuilder, ByVal cchBuffer As Integer) As Integer
+
 #End Region

 #Region "文本"
@@ -1350,8 +1389,8 @@ RetryDir:
    ''' <summary>
    ''' 提取 Exception 的具体描述与堆栈。
    ''' </summary>
-    ''' <param name="ShowAllTrace">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
-    Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllTrace As Boolean = False) As String
+    ''' <param name="ShowAllStacks">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
+    Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
        If Ex Is Nothing Then Return "无可用错误信息！"

        '获取最底层的异常
@@ -1362,19 +1401,20 @@ RetryDir:

        '获取各级错误的描述与堆栈信息
        Dim DescList As New List(Of String)
-        Dim StackList As New List(Of String)
+        Dim IsInner As Boolean = False
        Do Until Ex Is Nothing
-            DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
+            DescList.Add(If(IsInner, "→ ", "") & Ex.Message.Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
            If Ex.StackTrace IsNot Nothing Then
-                For Each St As String In Ex.StackTrace.Split(vbCrLf)
-                    If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then StackList.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
+                For Each Stack As String In Ex.StackTrace.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
+                    If ShowAllStacks OrElse Stack.ContainsF("pcl", True) Then
+                        DescList.Add(Stack.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
+                    End If
                Next
            End If
+            If Ex.GetType.FullName <> "System.Exception" Then DescList.Add("   错误类型：" & Ex.GetType.FullName)
            Ex = Ex.InnerException
+            IsInner = True
        Loop
-        DescList = DescList.Distinct.ToList
-        Dim Desc As String = Join(DescList, vbCrLf & "→ ")
-        Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "")

        '常见错误（记得同时修改下面的）
        Dim CommonReason As String = Nothing
@@ -1387,20 +1427,15 @@ RetryDir:
        ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
            CommonReason = "由于操作系统或显卡存在问题，导致出现错误。请尝试重启 PCL。"
        ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
-                "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
+                "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) DescList.Any(Function(l) l.Contains(s))) Then
            CommonReason = "你的网络环境不佳，导致难以连接到服务器。请检查网络，多重试几次，或尝试使用 VPN。"
        End If

-        '获取错误类型
-        Dim TypeDesc As String = If(InnerEx.GetType.FullName = "System.Exception", "", vbCrLf & "错误类型：" & InnerEx.GetType.FullName)
-
        '构造输出信息
        If CommonReason Is Nothing Then
-            Return Desc & Stack & TypeDesc
+            Return DescList.Join(vbCrLf)
        Else
-            Dim Result As String = CommonReason & vbCrLf & DescList.First & vbCrLf & "————————————" & vbCrLf
-            DescList(0) = "详细错误信息："
-            Return Result & Join(DescList, vbCrLf & "→ ") & Stack & TypeDesc
+            Return CommonReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息：" & vbCrLf & DescList.Join(vbCrLf)
        End If
    End Function
    ''' <summary>
@@ -1444,7 +1479,7 @@ RetryDir:
            Return CommonReason & "详细错误：" & DescList.First
        Else
            DescList.Reverse() '让最深层错误在最左边
-            Return Join(DescList, " → ")
+            Return Join(DescList, " ← ")
        End If
    End Function

@@ -1722,6 +1757,21 @@ RetryDir:
            Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
            Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
    End Function
+    ''' <summary>
+    ''' 为字符串进行 Like 关键字转义。
+    ''' </summary>
+    Public Function EscapeLikePattern(input As String) As String
+        Dim sb As New StringBuilder()
+        For Each c As Char In input
+            Select Case c
+                Case "["c, "]"c, "*"c, "?"c, "#"c
+                    sb.Append("["c).Append(c).Append("]"c)
+                Case Else
+                    sb.Append(c)
+            End Select
+        Next
+        Return sb.ToString()
+    End Function

    '正则
    ''' <summary>
@@ -2134,6 +2184,7 @@ NextElement:
    ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
    ''' <param name="Arguments">运行参数。</param>
    Public Sub ShellOnly(FileName As String, Optional Arguments As String = "")
+        FileName = ShortenPath(FileName)
        Using Program As New Process
            Program.StartInfo.Arguments = Arguments
            Program.StartInfo.FileName = FileName
@@ -2179,7 +2230,7 @@ NextElement:
            .CreateNoWindow = True,
            .RedirectStandardError = True,
            .RedirectStandardOutput = True,
-            .WorkingDirectory = If(WorkingDirectory, Path.TrimEnd("\"c))
+            .WorkingDirectory = ShortenPath(If(WorkingDirectory, Path.TrimEnd("\"c)))
        }
        If WorkingDirectory IsNot Nothing Then
            If Info.EnvironmentVariables.ContainsKey("appdata") Then
@@ -2288,6 +2339,27 @@ NextElement:
        Return New List(Of T)(list)
    End Function

+    ''' <summary>
+    ''' 尝试从字典中获取某项，如果该项不存在，则返回默认值。
+    ''' </summary>
+    <Extension> Public Function GetOrDefault(Of TKey, TValue)(Dict As Dictionary(Of TKey, TValue), Key As TKey, Optional DefaultValue As TValue = Nothing) As TValue
+        If Dict.ContainsKey(Key) Then
+            Return Dict(Key)
+        Else
+            Return DefaultValue
+        End If
+    End Function
+    ''' <summary>
+    ''' 将某项添加到以列表作为值的字典中。
+    ''' </summary>
+    <Extension> Public Sub AddToList(Of TKey, TValue)(Dict As Dictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue)
+        If Dict.ContainsKey(Key) Then
+            Dict(Key).Add(Value)
+        Else
+            Dict.Add(Key, New List(Of TValue) From {Value})
+        End If
+    End Sub
+
    ''' <summary>
    ''' 获取程序启动参数。
    ''' </summary>
@@ -2337,11 +2409,18 @@ NextElement:
        End Try
    End Sub
    ''' <summary>
-    ''' 打开 explorer。注意参数中的路径要尽量加上双引号！
+    ''' 打开 explorer。
+    ''' 若不以 \ 结尾，则将视作文件路径，打开并选中此文件。
    ''' </summary>
-    Public Sub OpenExplorer(Argument As String)
+    Public Sub OpenExplorer(Location As String)
        Try
-            ShellOnly("explorer.exe", Argument)
+            Location = ShortenPath(Location.Replace("/", "\").Trim(" "c, """"c))
+            Log("[System] 正在打开资源管理器：" & Location)
+            If Location.EndsWith("\") Then
+                ShellOnly(Location)
+            Else
+                ShellOnly("explorer", $"/select,""{Location}""")
+            End If
        Catch ex As Exception
            Log(ex, "打开资源管理器失败，请尝试关闭安全软件（如 360 安全卫士）", LogLevel.Msgbox)
        End Try
@@ -2792,7 +2871,7 @@ Retry:
        On Error Resume Next
        FeedbackInfo()
        If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
-            OpenExplorer("""" & Path & "PCL\""")
+            OpenExplorer(Path & "PCL\Log1.txt")
        End If
        OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
    End Sub
@@ -2868,4 +2947,88 @@ Retry:

 #End Region

-End Module
+End Module
+
+#Region "WPF"
+
+''' <summary>
+''' 对数据绑定进行加法运算，使用参数决定加数。
+''' </summary>
+Public Class AdditionConverter
+    Implements IValueConverter
+    Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
+        If value Is Nothing Then Return 0
+        Dim before As Double
+        If Not Double.TryParse(value.ToString(), before) Then Return 0
+        Dim scale As Double = 1
+        If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
+        Return before + scale
+    End Function
+    Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
+        If value Is Nothing Then Return Binding.DoNothing
+        Dim before As Double
+        If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
+        Dim scale As Double = 1
+        If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
+        If scale = 0 Then Return Binding.DoNothing
+        Return before - scale
+    End Function
+End Class
+
+''' <summary>
+''' 对数据绑定进行乘法运算，使用参数决定乘数。
+''' </summary>
+Public Class MultiplicationConverter
+    Implements IValueConverter
+    Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
+        If value Is Nothing Then Return 0
+        Dim before As Double
+        If Not Double.TryParse(value.ToString(), before) Then Return 0
+        Dim scale As Double = 1
+        If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
+        Return before * scale
+    End Function
+    Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
+        If value Is Nothing Then Return Binding.DoNothing
+        Dim before As Double
+        If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
+        Dim scale As Double = 1
+        If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
+        If scale = 0 Then Return Binding.DoNothing
+        Return before / scale
+    End Function
+End Class
+
+''' <summary>
+''' 将取反的 Boolean 绑定到 Visibility。
+''' </summary>
+Public Class InverseBooleanToVisibilityConverter
+    Implements IValueConverter
+    Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
+        If value Is Nothing Then Return Visibility.Visible
+        Dim boolValue As Boolean
+        Return If(Boolean.TryParse(value.ToString(), boolValue), If(boolValue, Visibility.Collapsed, Visibility.Visible), Visibility.Visible)
+    End Function
+    Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
+        If value Is Nothing Then Return False
+        Return If(TypeOf value Is Visibility, value <> Visibility.Visible, False)
+    End Function
+End Class
+
+''' <summary>
+''' 将 Boolean 取反。
+''' </summary>
+Public Class InverseBooleanConverter
+    Implements IValueConverter
+    Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
+        If value Is Nothing Then Return False
+        Dim boolValue As Boolean
+        Return If(Boolean.TryParse(value.ToString(), boolValue), Not boolValue, False)
+    End Function
+    Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
+        If value Is Nothing Then Return False
+        Return If(Boolean.TryParse(value.ToString(), value), Not value, False)
+    End Function
+End Class
+
+#End Region
@@ -315,23 +315,26 @@
                Sub()
                    Try
                        IsForceRestarting = IsForceRestart
-                        If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已" & If(IsForceRestarting, "强制", "") & "启动")
+                        If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
                        LoadDelegate(Me)
                        If IsAborted Then
-                            Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束，输出被弃用（最新线程：" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & "）", LogLevel.Developer)
+                            Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）", LogLevel.Developer)
                        Else
                            RaisePreviewFinish()
                            State = LoadState.Finished
                            LastFinishedTime = GetTimeTick() '未中断，本次输出有效
                        End If
+                    Catch ex As CancelledException
+                        If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
+                        If Not IsAborted Then State = LoadState.Aborted
                    Catch ex As ThreadInterruptedException
-                        If ModeDebug Then Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已触发线程中断")
+                        If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%")
                        '如果线程是因为判断到 IsAborted 而提前中止，则代表已有新线程被重启，此时不应当改为 Aborted
                        '如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Aborted
                        If Not IsAborted Then State = LoadState.Aborted
                    Catch ex As Exception
                        If IsAborted Then Exit Sub
-                        Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 发生运行时错误", LogLevel.Developer)
+                        Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
                        [Error] = ex
                        State = LoadState.Failed
                    End Try
@@ -347,7 +350,7 @@
        End Sub
        Private Sub TriggerThreadAbort()
            If LastRunningThread Is Nothing Then Exit Sub
-            If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & LastRunningThread.ManagedThreadId & ") 已中断")
+            If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
            If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
            LastRunningThread = Nothing
        End Sub
@@ -220,12 +220,12 @@ RequestFinished:
    ''' 以多线程下载网页文件的方式获取网页源代码。
    ''' </summary>
    ''' <param name="Url">网页的 Url。</param>
-    Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
+    Public Function NetGetCodeByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
        Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid()
        Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
        Try
            NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（" & Url & "）")
-            NetGetCodeByDownload = ReadFile(Temp)
+            NetGetCodeByLoader = ReadFile(Temp)
            File.Delete(Temp)
        Finally
            NewTask.Abort()
@@ -235,12 +235,12 @@ RequestFinished:
    ''' 以多线程下载网页文件的方式获取网页源代码。
    ''' </summary>
    ''' <param name="Urls">网页的 Url 列表。</param>
-    Public Function NetGetCodeByDownload(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
+    Public Function NetGetCodeByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
        Dim Temp As String = PathTemp & "Cache\Code\" & Urls.First.GetHashCode() & "_" & GetUuid()
        Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
        Try
            NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）")
-            NetGetCodeByDownload = ReadFile(Temp)
+            NetGetCodeByLoader = ReadFile(Temp)
            File.Delete(Temp)
        Finally
            NewTask.Abort()
@@ -248,13 +248,12 @@ RequestFinished:
    End Function

    ''' <summary>
-    ''' 从网络中直接下载文件。这不能下载 CDN 中的文件。
+    ''' 使用 WebClient 从网络中下载文件。这不能下载 CDN 中的文件。
    ''' </summary>
    ''' <param name="Url">网络 Url。</param>
    ''' <param name="LocalFile">下载的本地地址。</param>
-    Public Sub NetDownload(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False)
+    Public Sub NetDownloadByClient(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False)
        Log("[Net] 直接下载文件：" & Url)
-
        '初始化
        Try
            '建立目录
@@ -262,9 +261,8 @@ RequestFinished:
            '尝试删除原文件
            File.Delete(LocalFile)
        Catch ex As Exception
-            Throw New WebException("预处理下载文件路径失败（" & LocalFile & "）。", ex)
+            Throw New WebException($"预处理下载文件路径失败（{LocalFile}）", ex)
        End Try
-
        '下载
        Using Client As New WebClient
            Try
@@ -272,10 +270,41 @@ RequestFinished:
                Client.DownloadFile(Url, LocalFile)
            Catch ex As Exception
                File.Delete(LocalFile)
-                Throw New WebException("直接下载文件失败（" & Url & "）。", ex)
+                Throw New WebException($"直接下载文件失败（{Url}）", ex)
            End Try
        End Using
+    End Sub

+    ''' <summary>
+    ''' 简单的多线程下载文件。可以下载 CDN 中的文件。
+    ''' </summary>
+    ''' <param name="Url">文件的 Url。</param>
+    ''' <param name="LocalFile">下载的本地地址。</param>
+    Public Sub NetDownloadByLoader(Url As String, LocalFile As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
+        Dim NewTask As New LoaderDownload("文件下载 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, LocalFile, Check, UseBrowserUserAgent)})
+        Try
+            NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
+        Catch ex As Exception
+            Throw New WebException($"多线程直接下载文件失败（{Url}）", ex)
+        Finally
+            NewTask.Abort()
+        End Try
+    End Sub
+
+    ''' <summary>
+    ''' 简单的多线程下载文件。可以下载 CDN 中的文件。
+    ''' </summary>
+    ''' <param name="Urls">文件的 Url 列表。</param>
+    ''' <param name="LocalFile">下载的本地地址。</param>
+    Public Sub NetDownloadByLoader(Urls As IEnumerable(Of String), LocalFile As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
+        Dim NewTask As New LoaderDownload("文件下载 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, LocalFile, Check, UseBrowserUserAgent)})
+        Try
+            NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
+        Catch ex As Exception
+            Throw New WebException($"多线程直接下载文件失败（第一下载源：" & Urls.First() & "）", ex)
+        Finally
+            NewTask.Abort()
+        End Try
    End Sub

    ''' <summary>
@@ -1885,7 +1914,7 @@ Retry:
                        For Each File As NetFile In WaitingFiles
                            If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
                            Dim NewThread = File.TryBeginThread()
-                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(100) '减少 BMCLAPI 请求频率，避免 Too Many Requests
+                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率（目前每分钟限制 4000 次）
                        Next
                        '为进行中的文件追加线程
                        If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增
@@ -1905,7 +1934,7 @@ Retry:
                            '新增线程
                            If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程，不再新增
                            Dim NewThread = File.TryBeginThread()
-                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(100) '减少 BMCLAPI 请求频率，避免 Too Many Requests
+                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率（目前每分钟限制 4000 次）
                        Next
                    End While
                Catch ex As Exception
@@ -262,7 +262,6 @@ Public Class ValidateFileName
    Public Property IgnoreCase As Boolean = True
    Public Property ParentFolder As String = Nothing
    Public Property RequireParentFolderExists = True
-    Public Property AllowNull As Boolean = False
    Public Sub New()
    End Sub
    Public Sub New(Name As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
@@ -272,16 +271,14 @@ Public Class ValidateFileName
    End Sub
    Public Overrides Function Validate(Str As String) As String
        Try
-            If Not AllowNull Then
-                '检查是否为空
-                Dim NullCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
-                If Not NullCheck = "" Then Return NullCheck
-            End If
+            '检查是否为空
+            Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
+            If Not LengthCheck = "" Then Return LengthCheck
            '检查空格
            If Str.StartsWithF(" ") Then Return "文件名不能以空格开头！"
            If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾！"
            '检查长度
-            Dim LengthCheck = New ValidateLength(If(AllowNull, 0, 1), 253).Validate(Str & If(ParentFolder, ""))
+            LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
            If Not LengthCheck = "" Then Return LengthCheck
            '检查尾部小数点
            If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾！"
@@ -318,7 +315,6 @@ End Class
 Public Class ValidateFolderPath
    Inherits Validate
    Public Property UseMinecraftCharCheck As Boolean = True
-    Public Property AllowNull As Boolean = False
    Public Sub New()
    End Sub
    Public Sub New(UseMinecraftCharCheck As Boolean)
@@ -330,9 +326,9 @@ Public Class ValidateFolderPath
        If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
        '检查是否为空
        Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
-        If Not AllowNull AndAlso Not LengthCheck = "" Then Return LengthCheck
+        If Not LengthCheck = "" Then Return LengthCheck
        '检查长度
-        LengthCheck = New ValidateLength(If(AllowNull, 0, 1), 254).Validate(Str)
+        LengthCheck = New ValidateLength(1, 254).Validate(Str)
        If Not LengthCheck = "" Then Return LengthCheck
        '检查开头
        If Str.StartsWithF("\\Mac\") Then GoTo Fin
@@ -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
@@ -20,7 +20,7 @@
                    Hint("正在开启中，请稍候……")
                    OpenWebsite(Data(0))

-                Case "打开文件", "打开帮助"
+                Case "打开文件", "打开帮助", "执行命令"
                    RunInThread(
                    Sub()
                        Try
@@ -29,15 +29,25 @@
                            Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
                            Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
                            '执行
-                            If Type = "打开文件" Then
+                            If Type = "打开帮助" Then
+                                PageOtherHelp.EnterHelpPage(Location)
+                            Else
+                                If Not Setup.Get("HintCustomCommand") Then
+                                    Select Case MyMsgBox(
+                                    "即将执行：" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
+                                    "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
+                                        Case 2
+                                            Setup.Set("HintCustomCommand", True)
+                                        Case 3
+                                            Exit Sub
+                                    End Select
+                                End If
                                Dim Info As New ProcessStartInfo With {
                                    .Arguments = If(Data.Length >= 2, Data(1), ""),
                                    .FileName = Location,
-                                    .WorkingDirectory = WorkingDir
+                                    .WorkingDirectory = ShortenPath(WorkingDir)
                                }
                                Process.Start(Info)
-                            Else '打开帮助
-                                PageOtherHelp.EnterHelpPage(Location)
                            End If
                        Catch ex As Exception
                            Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
@@ -140,8 +150,8 @@
            Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml")
            Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp1)
            Try
-                NetDownload(RelativeUrl, LocalTemp1)
-                NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
+                NetDownloadByClient(RelativeUrl, LocalTemp1)
+                NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
            Catch ex As Exception
                Throw New Exception("下载指定的文件失败！" & vbCrLf &
                                    "注意，联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf &
@@ -174,7 +184,7 @@
            Location = PathTemp & "Help\" & RelativeUrl
            WorkingDir = PathTemp & "Help\"
            Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & "：" & Location)
-        ElseIf EventType = "打开文件" Then
+        ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
            '直接使用原有路径启动程序
            Location = RelativeUrl
            Log("[Control] 自定义事件中直接" & EventType & "：" & Location)
@@ -811,6 +811,54 @@ NextFile:
    Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean

+#End Region
+
+#Region "任务缓存"
+
+    Private IsTaskTempCleared As Boolean = False
+    Private IsTaskTempClearing As Boolean = False
+
+    ''' <summary>
+    ''' 尝试清理任务缓存文件夹。
+    ''' 在整次运行中只会实际清理一次。
+    ''' </summary>
+    Public Sub TryClearTaskTemp()
+        If Not IsTaskTempCleared Then
+            IsTaskTempCleared = True
+            IsTaskTempClearing = True
+            Try
+                Log("[System] 开始清理任务缓存文件夹")
+                DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\")
+                DeleteDirectory($"{PathTemp}TaskTemp\")
+                Log("[System] 已清理任务缓存文件夹")
+            Catch ex As Exception
+                Log(ex, "清理任务缓存文件夹失败")
+            Finally
+                IsTaskTempClearing = False
+            End Try
+        ElseIf IsTaskTempClearing Then
+            '等待另一个清理步骤完成
+            Do While IsTaskTempClearing
+                Thread.Sleep(1)
+            Loop
+        End If
+    End Sub
+
+    ''' <summary>
+    ''' 申请一个可用于任务缓存的临时文件夹，以 \ 结尾。
+    ''' 这些文件夹无需进行后续清理。
+    ''' </summary>
+    ''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
+    Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
+        TryClearTaskTemp()
+        If RequireNonSpace Then
+            RequestTaskTempFolder = $"{OsDrive}ProgramData\PCL\Install\{GetUuid()}-{RandomInteger(0, 1000000)}\"
+        Else
+            RequestTaskTempFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
+        End If
+        Directory.CreateDirectory(RequestTaskTempFolder)
+    End Function
+
 #End Region

    Public DragControl = Nothing
@@ -246,18 +246,18 @@ Friend Module ModSecret
            FrmMain.PanForm.Background.Freeze()
        End Sub)
    End Sub
-    Public Sub ThemeCheckAll(EffectSetup As Boolean)
+    Friend Sub ThemeCheckAll(EffectSetup As Boolean)
    End Sub
-    Public Function ThemeCheckOne(Id As Integer) As Boolean
+    Friend Function ThemeCheckOne(Id As Integer) As Boolean
        Return True
    End Function
    Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
        Return False
    End Function
-    Public Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
+    Friend Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
        Return False
    End Function
-    Public Function DonateCodeInput() As Boolean?
+    Friend Function DonateCodeInput() As Boolean?
        Return Nothing
    End Function

@@ -276,6 +276,13 @@ Friend Module ModSecret
    End Sub
    Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
    End Sub
+    ''' <summary>
+    ''' 确保 PathTemp 下的 Latest.exe 是最新正式版的 PCL，它会被用于整合包打包。
+    ''' 如果不是，则下载一个。
+    ''' </summary>
+    Friend Sub DownloadLatestPCL(Optional LoaderToSyncProgress As LoaderBase = Nothing)
+        '注意：如果要自行实现这个功能，请换用另一个文件路径，以免与官方版本冲突
+    End Sub

 #End Region