2.9.2

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

@@ -1,4 +1,4 @@
-Imports System.Globalization
+Imports System.Globalization
 Imports System.IO.Compression
 Imports System.Runtime.CompilerServices
 Imports System.Security.Cryptography
@@ -12,13 +12,13 @@ Public Module ModBase
 #Region "声明"
 
     '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.9.1" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.9.1." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.9.2" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.9.2." & VersionBranchCode '标准格式的四段式版本号
     Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
     Public Const VersionCode As Integer = 352 'Release
 #Else
-    Public Const VersionCode As Integer = 351 'Snapshot
+    Public Const VersionCode As Integer = 353 'Snapshot
 #End If
     '自动生成的版本信息
     Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -420,7 +420,7 @@ Public Module ModBase
     ''' <summary>
     ''' 执行返回值。
     ''' </summary>
-    Public Enum Result
+    Public Enum ProcessReturnValues
         ''' <summary>
         ''' 执行成功，或进程被中断。
         ''' </summary>
@@ -432,19 +432,23 @@ Public Module ModBase
         ''' <summary>
         ''' 执行失败。
         ''' </summary>
-        Fail
+        Fail = 1
         ''' <summary>
         ''' 执行时出现未经处理的异常。
         ''' </summary>
-        Exception
+        Exception = 2
         ''' <summary>
         ''' 执行超时。
         ''' </summary>
-        Timeout
+        Timeout = 3
         ''' <summary>
         ''' 取消执行。可能是由于不满足执行的前置条件。
         ''' </summary>
-        Cancel
+        Cancel = 4
+        ''' <summary>
+        ''' 任务成功完成。
+        ''' </summary>
+        TaskDone = 5
     End Enum
 
     ''' <summary>
@@ -573,62 +577,59 @@ Public Module ModBase
 
 #Region "文件"
 
-    '注册表
+    '=============================
+    '  注册表
+    '=============================
+
     ''' <summary>
-    ''' 重命名一个注册表子键。不可用于包含子键的子键。
-    ''' </summary>
-    Public Sub RenameReg(parentKey As Microsoft.Win32.RegistryKey, subKeyName As String, newSubKeyName As String)
-        If parentKey.GetSubKeyNames().Contains(newSubKeyName) Then parentKey.DeleteSubKeyTree(newSubKeyName, False)
-        Dim SourceKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(subKeyName)
-        If IsNothing(SourceKey) Then Exit Sub '没有目标项
-        Dim NewKey As Microsoft.Win32.RegistryKey = parentKey.CreateSubKey(newSubKeyName)
-        If SourceKey.GetSubKeyNames().Length > 0 Then Throw New NotSupportedException("不支持对包含子键的子键进行重命名：" & SourceKey.GetSubKeyNames()(0) & "。")
-        For Each valueName As String In SourceKey.GetValueNames()
-            Dim objValue As Object = SourceKey.GetValue(valueName)
-            Dim valKind As Microsoft.Win32.RegistryValueKind = SourceKey.GetValueKind(valueName)
-            NewKey.SetValue(valueName, objValue, valKind)
-        Next
-        parentKey.DeleteSubKeyTree(subKeyName, False)
-    End Sub
-    ''' <summary>
-    ''' 读取程序所属注册表。
+    ''' 读取注册表键。如果失败则返回默认值。
     ''' </summary>
     Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
         Try
-            Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey
-            parentKey = My.Computer.Registry.CurrentUser
-            softKey = parentKey.OpenSubKey("Software\" & RegFolder, True)
-            If softKey Is Nothing Then
-                ReadReg = DefaultValue '不存在则返回默认值
-            Else
-                Dim readValue As New Text.StringBuilder
-                readValue.AppendLine(softKey.GetValue(Key))
-                Dim value = readValue.ToString.Replace(vbCrLf, "") '去除莫名的回车
-                Return If(value = "", DefaultValue, value) '错误则返回默认值
-            End If
+            Dim SubKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False)
+            Return If(SubKey?.GetValue(Key), DefaultValue)
         Catch ex As Exception
             Log(ex, "读取注册表出错：" & Key, LogLevel.Hint)
             Return DefaultValue
         End Try
     End Function
     ''' <summary>
-    ''' 写入程序所属注册表。
+    ''' 写入注册表键。
     ''' </summary>
-    Public Sub WriteReg(Key As String, Value As String, Optional ShowException As Boolean = False)
+    Public Sub WriteReg(Key As String, Value As String, Optional ThrowException As Boolean = False)
         Try
-            Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey
-            parentKey = My.Computer.Registry.CurrentUser
-            softKey = parentKey.OpenSubKey("Software\" & RegFolder, True)
-            If softKey Is Nothing Then softKey = parentKey.CreateSubKey("Software\" & RegFolder) '如果不存在就创建  
-            softKey.SetValue(Key, Value)
+            Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
+            If SubKey Is Nothing Then SubKey = My.Computer.Registry.CurrentUser.CreateSubKey("Software\" & RegFolder) '如果不存在就创建  
+            SubKey.SetValue(Key, Value)
         Catch ex As Exception
-            Log(ex, "写入注册表出错：" & Key, If(ShowException, LogLevel.Hint, LogLevel.Developer))
-            If ShowException Then Throw '如果显示错误就丢一个
+            Log(ex, "写入注册表出错：" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer))
+            If ThrowException Then Throw
+        End Try
+    End Sub
+    ''' <summary>
+    ''' 是否存在某个注册表键。
+    ''' </summary>
+    Public Function HasReg(Key As String) As Boolean
+        Return ReadReg(Key, Nothing) IsNot Nothing
+    End Function
+    ''' <summary>
+    ''' 删除注册表键。
+    ''' </summary>
+    Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False)
+        Try
+            Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
+            SubKey?.DeleteValue(Key)
+        Catch ex As Exception
+            Log(ex, "删除注册表出错：" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer))
+            If ThrowException Then Throw
         End Try
     End Sub
 
-    'Ini 文件
-    Private ReadOnly IniCache As New Dictionary(Of String, Dictionary(Of String, String))
+    '=============================
+    '  ini
+    '=============================
+
+    Private ReadOnly IniCache As New SafeDictionary(Of String, SafeDictionary(Of String, String))
     ''' <summary>
     ''' 清除某 ini 文件的运行时缓存。
     ''' </summary>
@@ -642,7 +643,7 @@ Public Module ModBase
     ''' 在文件不存在或读取失败时返回 Nothing。
     ''' </summary>
     ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
-    Private Function IniGetContent(FileName As String) As Dictionary(Of String, String)
+    Private Function IniGetContent(FileName As String) As SafeDictionary(Of String, String)
         Try
             '还原文件路径
             If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
@@ -650,7 +651,7 @@ Public Module ModBase
             If IniCache.ContainsKey(FileName) Then Return IniCache(FileName)
             '读取文件
             If Not File.Exists(FileName) Then Return Nothing
-            Dim Ini As New Dictionary(Of String, String)
+            Dim Ini As New SafeDictionary(Of String, String)
             For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
                 Dim Index As Integer = Line.IndexOfF(":")
                 If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键，见 #3616
@@ -674,7 +675,21 @@ Public Module ModBase
         Return Content(Key)
     End Function
     ''' <summary>
+    ''' 判断 ini 文件中是否包含某个键。这可能会使用到缓存。
+    ''' </summary>
+    Public Function HasIniKey(FileName As String, Key As String) As Boolean
+        Dim Content = IniGetContent(FileName)
+        Return Content IsNot Nothing AndAlso Content.ContainsKey(Key)
+    End Function
+    ''' <summary>
+    ''' 从 ini 文件中移除某个键。这会更新缓存。
+    ''' </summary>
+    Public Sub DeleteIniKey(FileName As String, Key As String)
+        WriteIni(FileName, Key, Nothing)
+    End Sub
+    ''' <summary>
     ''' 写入 ini 文件，这会更新缓存。
+    ''' 若 Value 为 Nothing，则删除该键。
     ''' </summary>
     ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
     ''' <param name="Key">键。</param>
@@ -683,28 +698,38 @@ Public Module ModBase
     Public Sub WriteIni(FileName As String, Key As String, Value As String)
         Try
             '预处理
-            Key = Key.Replace(vbCr, "").Replace(vbLf, "").Replace(":", "")
-            Value = Value.Replace(vbCr, "").Replace(vbLf, "") '允许 Value 中包含冒号
-            '获取目前文件
-            Dim Content As Dictionary(Of String, String) = IniGetContent(FileName)
-            If Content Is Nothing Then Content = New Dictionary(Of String, String)
-            If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Exit Sub '如果值一样就不处理
-            '更新缓存
-            Content(Key) = Value
-            '写入文件
-            Dim FileContent As New StringBuilder
-            For Each Pair In Content
-                FileContent.Append(Pair.Key)
-                FileContent.Append(":")
-                FileContent.Append(Pair.Value)
-                FileContent.Append(vbCrLf)
-            Next
-            If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
-            WriteFile(FileName, FileContent.ToString)
+            If Key.Contains(":") Then Throw New Exception($"尝试写入 ini 文件 {FileName} 的键名中包含了冒号：{Key}")
+            Key = Key.Replace(vbCr, "").Replace(vbLf, "")
+            Value = Value?.Replace(vbCr, "").Replace(vbLf, "")
+            '防止争用
+            SyncLock WriteIniLock
+                '获取目前文件
+                Dim Content As SafeDictionary(Of String, String) = IniGetContent(FileName)
+                If Content Is Nothing Then Content = New SafeDictionary(Of String, String)
+                '更新值
+                If Value Is Nothing Then
+                    If Not Content.ContainsKey(Key) Then Return '无需处理
+                    Content.Remove(Key)
+                Else
+                    If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Return '无需处理
+                    Content(Key) = Value
+                End If
+                '写入文件
+                Dim FileContent As New StringBuilder
+                For Each Pair In Content
+                    FileContent.Append(Pair.Key)
+                    FileContent.Append(":")
+                    FileContent.Append(Pair.Value)
+                    FileContent.Append(vbCrLf)
+                Next
+                If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
+                WriteFile(FileName, FileContent.ToString)
+            End SyncLock
         Catch ex As Exception
             Log(ex, $"写入文件失败（{FileName} → {Key}:{Value}）", LogLevel.Hint)
         End Try
     End Sub
+    Private WriteIniLock As New Object
 
     '路径处理
     ''' <summary>
@@ -833,7 +858,7 @@ Public Module ModBase
     ''' <param name="Text">文件内容。</param>
     ''' <param name="Append">是否将文件内容追加到当前文件，而不是覆盖它。</param>
     Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
-        '还原文件路径
+        '处理相对路径
         If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
         '确保目录存在
         Directory.CreateDirectory(GetPathFromFullPath(FilePath))
@@ -846,8 +871,8 @@ Public Module ModBase
                 writer.Close()
             End Using
         Else
-            '直接写入字节集
-            File.WriteAllBytes(FilePath, If(Encoding Is Nothing, Encoding.UTF8.GetBytes(Text), Encoding.GetBytes(Text)))
+            '直接写入字节
+            File.WriteAllBytes(FilePath, If(Encoding Is Nothing, New UTF8Encoding(False).GetBytes(Text), Encoding.GetBytes(Text)))
         End If
     End Sub
     ''' <summary>
@@ -858,7 +883,7 @@ Public Module ModBase
     ''' <param name="Content">文件内容。</param>
     ''' <param name="Append">是否将文件内容追加到当前文件，而不是覆盖它。</param>
     Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
-        '还原文件路径
+        '处理相对路径
         If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
         '确保目录存在
         Directory.CreateDirectory(GetPathFromFullPath(FilePath))
@@ -1227,8 +1252,14 @@ Re:
                 Dim Info As New FileInfo(LocalPath)
                 If Not Info.Exists Then Return "文件不存在：" & LocalPath
                 Dim FileSize As Long = Info.Length
-                If ActualSize >= 0 AndAlso ActualSize <> FileSize Then Return "文件大小应为 " & ActualSize & " B，实际为 " & FileSize & " B"
-                If MinSize >= 0 AndAlso MinSize > FileSize Then Return "文件大小应大于 " & MinSize & " B，实际为 " & FileSize & " B"
+                If ActualSize >= 0 AndAlso ActualSize <> FileSize Then
+                    Return $"文件大小应为 {ActualSize} B，实际为 {FileSize} B" &
+                        If(FileSize < 2000, "，内容为：" & ReadFile(LocalPath), "")
+                End If
+                If MinSize >= 0 AndAlso MinSize > FileSize Then
+                    Return $"文件大小应大于 {MinSize} B，实际为 {FileSize} B" &
+                        If(FileSize < 2000, "，内容为：" & ReadFile(LocalPath), "")
+                End If
                 If Not String.IsNullOrEmpty(Hash) Then
                     If Hash.Length < 35 Then 'MD5
                         If Hash.ToLowerInvariant <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & "，实际为 " & GetFileMD5(LocalPath)
@@ -1777,7 +1808,7 @@ RetryDir:
     ''' <summary>
     ''' 搜索字符串中的所有正则匹配项。
     ''' </summary>
-    Public Function RegexSearch(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As List(Of String)
+    <Extension> Public Function RegexSearch(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As List(Of String)
         Try
             RegexSearch = New List(Of String)
             Dim RegexSearchRes = New Regex(regex, options).Matches(str)
@@ -1793,7 +1824,7 @@ RetryDir:
     ''' <summary>
     ''' 获取字符串中的第一个正则匹配项，若无匹配则返回 Nothing。
     ''' </summary>
-    Public Function RegexSeek(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
+    <Extension> Public Function RegexSeek(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As String
         Try
             Dim Result = RegularExpressions.Regex.Match(str, regex, options).Value
             Return If(Result = "", Nothing, Result)
@@ -1805,7 +1836,7 @@ RetryDir:
     ''' <summary>
     ''' 检查字符串是否匹配某正则模式。
     ''' </summary>
-    Public Function RegexCheck(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As Boolean
+    <Extension> Public Function RegexCheck(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As Boolean
         Try
             Return RegularExpressions.Regex.IsMatch(str, regex, options)
         Catch ex As Exception
@@ -1816,14 +1847,14 @@ RetryDir:
     ''' <summary>
     ''' 进行正则替换，会抛出错误。
     ''' </summary>
-    Public Function RegexReplace(Input As String, Replacement As String, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
-        Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options)
+    <Extension> Public Function RegexReplace(AllContents As String, SearchRegex As String, ReplaceTo As String, Optional options As RegexOptions = RegexOptions.None) As String
+        Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
     End Function
     ''' <summary>
     ''' 对每个正则匹配分别进行替换，会抛出错误。
     ''' </summary>
-    Public Function RegexReplaceEach(Input As String, Replacement As MatchEvaluator, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
-        Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options)
+    <Extension> Public Function RegexReplaceEach(AllContents As String, SearchRegex As String, ReplaceTo As MatchEvaluator, Optional options As RegexOptions = RegexOptions.None) As String
+        Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
     End Function
 
 #End Region
@@ -1922,7 +1953,7 @@ RetryDir:
                 Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True)))
         Next
         '按照相似度进行排序
-        Entries = Sort(Entries,
+        Entries = Entries.Sort(
         Function(Left, Right) As Boolean
             If Left.AbsoluteRight Xor Right.AbsoluteRight Then
                 Return Left.AbsoluteRight
@@ -1981,6 +2012,122 @@ RetryDir:
         End Function
     End Class
 
+    ''' <summary>
+    ''' 线程安全的，可以直接使用 For Each 的字典。
+    ''' 在使用 For Each 循环时，字典的结果可能并非最新，但不会抛出异常。
+    ''' </summary>
+    Public Class SafeDictionary(Of TKey, TValue)
+        Implements IDictionary(Of TKey, TValue)
+        Implements IEnumerable(Of KeyValuePair(Of TKey, TValue))
+
+        Private ReadOnly SyncRoot As New Object
+        Private ReadOnly _Dictionary As New Dictionary(Of TKey, TValue)
+
+        '构造函数
+        Public Sub New()
+        End Sub
+        Public Sub New(data As IEnumerable(Of KeyValuePair(Of TKey, TValue)))
+            For Each DataItem In data
+                _Dictionary.Add(DataItem.Key, DataItem.Value)
+            Next
+        End Sub
+
+        '线程安全的方法实现
+        Public Sub Add(key As TKey, value As TValue) Implements IDictionary(Of TKey, TValue).Add
+            SyncLock SyncRoot
+                _Dictionary.Add(key, value)
+            End SyncLock
+        End Sub
+        Public Function ContainsKey(key As TKey) As Boolean Implements IDictionary(Of TKey, TValue).ContainsKey
+            SyncLock SyncRoot
+                Return _Dictionary.ContainsKey(key)
+            End SyncLock
+        End Function
+        Public ReadOnly Property Keys As ICollection(Of TKey) Implements IDictionary(Of TKey, TValue).Keys
+            Get
+                SyncLock SyncRoot
+                    Return New List(Of TKey)(_Dictionary.Keys)
+                End SyncLock
+            End Get
+        End Property
+        Public Function Remove(key As TKey) As Boolean Implements IDictionary(Of TKey, TValue).Remove
+            SyncLock SyncRoot
+                Return _Dictionary.Remove(key)
+            End SyncLock
+        End Function
+        Public Function TryGetValue(key As TKey, ByRef value As TValue) As Boolean Implements IDictionary(Of TKey, TValue).TryGetValue
+            SyncLock SyncRoot
+                Return _Dictionary.TryGetValue(key, value)
+            End SyncLock
+        End Function
+        Public ReadOnly Property Values As ICollection(Of TValue) Implements IDictionary(Of TKey, TValue).Values
+            Get
+                SyncLock SyncRoot
+                    Return New List(Of TValue)(_Dictionary.Values)
+                End SyncLock
+            End Get
+        End Property
+        Default Public Property Item(key As TKey) As TValue Implements IDictionary(Of TKey, TValue).Item
+            Get
+                SyncLock SyncRoot
+                    Return _Dictionary(key)
+                End SyncLock
+            End Get
+            Set(value As TValue)
+                SyncLock SyncRoot
+                    _Dictionary(key) = value
+                End SyncLock
+            End Set
+        End Property
+        Public Sub Add(item As KeyValuePair(Of TKey, TValue)) Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Add
+            SyncLock SyncRoot
+                _Dictionary.Add(item.Key, item.Value)
+            End SyncLock
+        End Sub
+        Public Sub Clear() Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Clear
+            SyncLock SyncRoot
+                _Dictionary.Clear()
+            End SyncLock
+        End Sub
+        Public Function Contains(item As KeyValuePair(Of TKey, TValue)) As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Contains
+            SyncLock SyncRoot
+                Return DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).Contains(item)
+            End SyncLock
+        End Function
+        Public Sub CopyTo(array() As KeyValuePair(Of TKey, TValue), arrayIndex As Integer) Implements ICollection(Of KeyValuePair(Of TKey, TValue)).CopyTo
+            SyncLock SyncRoot
+                DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).CopyTo(array, arrayIndex)
+            End SyncLock
+        End Sub
+        Public ReadOnly Property Count As Integer Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Count
+            Get
+                SyncLock SyncRoot
+                    Return _Dictionary.Count
+                End SyncLock
+            End Get
+        End Property
+        Public ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).IsReadOnly
+            Get
+                Return False
+            End Get
+        End Property
+        Public Function Remove(item As KeyValuePair(Of TKey, TValue)) As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Remove
+            SyncLock SyncRoot
+                Return DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).Remove(item)
+            End SyncLock
+        End Function
+
+        '枚举器
+        Public Function GetEnumerator() As IEnumerator(Of KeyValuePair(Of TKey, TValue)) Implements IEnumerable(Of KeyValuePair(Of TKey, TValue)).GetEnumerator
+            SyncLock SyncRoot
+                Return New List(Of KeyValuePair(Of TKey, TValue))(_Dictionary).GetEnumerator()
+            End SyncLock
+        End Function
+        Private Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator
+            Return GetEnumerator()
+        End Function
+    End Class
+
     ''' <summary>
     ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
     ''' </summary>
@@ -2064,7 +2211,7 @@ RetryDir:
     ''' <summary>
     ''' 数组去重。
     ''' </summary>
-    <Extension> Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As CompareThreadStart(Of T)) As List(Of T)
+    <Extension> Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As ComparisonBoolean(Of T)) As List(Of T)
         Dim ResultArray As New List(Of T)
         For i = 0 To Arr.Count - 1
             For ii = i + 1 To Arr.Count - 1
@@ -2198,7 +2345,7 @@ NextElement:
     ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
     ''' <param name="Arguments">运行参数。</param>
     ''' <param name="Timeout">等待该程序结束的最长时间（毫秒）。超时会返回 Result.Timeout。</param>
-    Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000) As Result
+    Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000) As ProcessReturnValues
         Try
             Using Program As New Process
                 Program.StartInfo.Arguments = Arguments
@@ -2208,12 +2355,12 @@ NextElement:
                 If Program.WaitForExit(Timeout) Then
                     Return Program.ExitCode
                 Else
-                    Return Result.Timeout
+                    Return ProcessReturnValues.Timeout
                 End If
             End Using
         Catch ex As Exception
             Log(ex, "执行命令失败：" & FileName, LogLevel.Msgbox)
-            Return Result.Fail
+            Return ProcessReturnValues.Fail
         End Try
     End Function
     ''' <summary>
@@ -2316,9 +2463,9 @@ NextElement:
 
     ''' <summary>
     ''' 按照既定的函数进行选择排序。
+    ''' 传入两个对象，若第一个对象应该排在前面，则返回 True。
     ''' </summary>
-    ''' <param name="SortRule">传入两个对象，若第一个对象应该排在前面，则返回 True。</param>
-    <Extension> Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T)
+    <Extension> Public Function Sort(Of T)(List As IList(Of T), SortRule As ComparisonBoolean(Of T)) As List(Of T)
         Dim NewList As New List(Of T)
         While List.Any
             Dim Highest = List(0)
@@ -2330,7 +2477,7 @@ NextElement:
         End While
         Return NewList
     End Function
-    Public Delegate Function CompareThreadStart(Of T)(Left As T, Right As T) As Boolean
+    Public Delegate Function ComparisonBoolean(Of T)(Left As T, Right As T) As Boolean
 
     ''' <summary>
     ''' 返回列表的浅表副本。
@@ -2637,6 +2784,17 @@ Retry:
         Return Control.DesiredSize.Width > Control.ActualWidth
     End Function
 
+    ''' <summary>
+    ''' 获取文本在被渲染后的宽度。
+    ''' </summary>
+    Public Function MeasureStringWidth(text As String, Optional fontSize As Double = 14, Optional fontFamily As FontFamily = Nothing) As Double
+        If fontFamily Is Nothing Then fontFamily = New FontFamily("微软雅黑")
+        Dim formattedText = New FormattedText(
+            text, CultureInfo.CurrentCulture, FlowDirection.LeftToRight, New Typeface(fontFamily, FontStyles.Normal, FontWeights.Normal, FontStretches.Normal),
+            fontSize, Brushes.Black, New NumberSubstitution(), TextFormattingMode.Display, New DpiScale(1, 1).PixelsPerDip)
+        Return formattedText.Width
+    End Function
+
 #End Region
 
 #Region "Debug"
@@ -2755,7 +2913,7 @@ Retry:
         If IsProgramEnded OrElse Level = LogLevel.Normal Then Exit Sub
 
         '去除前缀
-        Text = RegexReplace(Text, "", "\[[^\]]+?\] ")
+        Text = Text.RegexReplace("\[[^\]]+?\] ", "")
 
         '输出提示
         Select Case Level
@@ -2789,9 +2947,9 @@ Retry:
                 If GetTimeTick() - Time < 1500 Then
                     '弹窗无法保留
                     Log("[System] PCL 已崩溃：" & vbCrLf & Text)
-                    FormMain.EndProgramForce(Result.Exception)
+                    FormMain.EndProgramForce(ProcessReturnValues.Exception)
                 Else
-                    FormMain.EndProgramForce(Result.Fail)
+                    FormMain.EndProgramForce(ProcessReturnValues.Fail)
                 End If
         End Select
 
@@ -2858,9 +3016,9 @@ Retry:
                 If GetTimeTick() - Time < 1500 Then
                     '弹窗无法保留
                     Log("[System] PCL 已崩溃：" & vbCrLf & ExFull)
-                    FormMain.EndProgramForce(Result.Exception)
+                    FormMain.EndProgramForce(ProcessReturnValues.Exception)
                 Else
-                    FormMain.EndProgramForce(Result.Fail)
+                    FormMain.EndProgramForce(ProcessReturnValues.Fail)
                 End If
         End Select
 

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

@@ -1,6 +1,4 @@
-Imports System.Net
-
-Public Module ModNet
+Public Module ModNet
     Public Const NetDownloadEnd As String = ".PCLDownloading"
 
     ''' <summary>
@@ -146,14 +144,15 @@ Retry:
         Dim RequestEx As Exception = Nothing
         Dim FailCount As Integer = 0
         For i = 1 To 4
-            Dim th As New Thread(Sub()
-                                     Try
-                                         RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept)
-                                     Catch ex As Exception
-                                         FailCount += 1
-                                         RequestEx = ex
-                                     End Try
-                                 End Sub)
+            Dim th As New Thread(
+            Sub()
+                Try
+                    RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept)
+                Catch ex As Exception
+                    FailCount += 1
+                    RequestEx = ex
+                End Try
+            End Sub)
             th.Start()
             Threads.Add(th)
             Thread.Sleep(i * 250)
@@ -221,7 +220,7 @@ RequestFinished:
     ''' </summary>
     ''' <param name="Url">网页的 Url。</param>
     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 Temp As String = RequestTaskTempFolder() & "download.txt"
         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 & "）")
@@ -236,7 +235,7 @@ RequestFinished:
     ''' </summary>
     ''' <param name="Urls">网页的 Url 列表。</param>
     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 Temp As String = RequestTaskTempFolder() & "download.txt"
         Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
         Try
             NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）")
@@ -734,7 +733,7 @@ RequestFinished:
         ''' <summary>
         ''' 所有下载源。
         ''' </summary>
-        Public Sources As NetSource()
+        Public Sources As SafeList(Of NetSource)
         ''' <summary>
         ''' 用于在第一个线程出错时切换下载源。
         ''' </summary>
@@ -742,7 +741,7 @@ RequestFinished:
         ''' <summary>
         ''' 所有已经被标记为失败的，但未完整尝试过的，不允许断点续传的下载源。
         ''' </summary>
-        Public SourcesOnce As New List(Of NetSource)
+        Public SourcesOnce As New SafeList(Of NetSource)
         ''' <summary>
         ''' 获取从某个源开始，第一个可用的源。
         ''' </summary>
@@ -943,7 +942,7 @@ RequestFinished:
                 Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing})
                 Count += 1
             Next
-            Me.Sources = Sources.ToArray
+            Me.Sources = Sources
             Me.LocalPath = LocalPath
             Me.Check = Check
             Me.UseBrowserUserAgent = UseBrowserUserAgent
@@ -1003,7 +1002,7 @@ Capture:
                     Next
                     '是否禁用多线程，以及规定碎片大小
                     Dim TargetUrl As String = GetSource().Url
-                    If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("mcimirror") OrElse TargetUrl.Contains("github.com") OrElse
+                    If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse
                        TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
                     '寻找最大碎片
                     'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程
@@ -1151,7 +1150,7 @@ NotSupportRange:
                         Info.Temp = Nothing
                         SmailFileCache = New Queue(Of Byte)
                     Else
-                        Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp"
+                        Info.Temp = $"{PathTemp}Download\{Uuid}_{Info.Uuid}_{RandomInteger(0, 999999)}.tmp"
                         ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
                     End If
                     '开始下载
@@ -1567,9 +1566,8 @@ FinishExCatch:
                     TotalProgress += 1
                 End If
             Next
-            If TotalProgress > 0 Then NewProgress /= TotalProgress
+            If TotalProgress > 0 AndAlso Not Double.IsNaN(TotalProgress) Then NewProgress /= TotalProgress
             '刷新进度
-            If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x，模拟开头和结尾更慢的情况
             _Progress = NewProgress
         End Sub
 

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

@@ -1,4 +1,20 @@
 '提供不同的输入验证方法，名称以 Validate 开头
+Public Module ModValidate
+
+    ''' <summary>
+    ''' 进行输入验证，并返回错误原因。
+    ''' 如果没有错误则返回空字符串。
+    ''' </summary>
+    Public Function Validate(Text As String, ValidateRules As IEnumerable(Of Validate)) As String
+        Dim Result As String = ""
+        For Each ValidateRule As Validate In ValidateRules
+            Result = ValidateRule.Validate(Text)
+            If Result <> "" Then Return Result
+        Next
+        Return Result
+    End Function
+
+End Module
 
 ''' <summary>
 ''' 输入验证规则基类。要查看所有的输入验证规则，可在输入 Validate 后查看自动补全。

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

@@ -666,6 +666,9 @@ NoSubtitle:
             If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
             'MC 版本一致
             If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
+            '最近更新时间差距在一周以内
+            If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso
+               Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
             'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
             If TranslatedName = Project.TranslatedName OrElse
                RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -920,7 +923,7 @@ NoSubtitle:
         End If
 
         '驼峰英文请求关键字处理
-        Dim SpacedKeywords = RegexReplace(Task.Input.SearchText, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)")
+        Dim SpacedKeywords = Task.Input.SearchText.RegexReplace("([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)", "$& ")
         Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "")
         Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
 
@@ -1067,7 +1070,7 @@ Retry:
 #Region "提取非重复项，存储于 RealResults"
 
         '将 Modrinth 排在 CurseForge 的前面，避免加载结束顺序不同导致排名不同
-        '这样做的话，去重后将优先保留 CurseForge 内容（考虑到 CurseForge 热度更高）
+        '这样做的话，去重后将优先保留 CurseForge 内容
         RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
         'RawResults 去重
         RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
@@ -1100,7 +1103,7 @@ Retry:
         If String.IsNullOrEmpty(Task.Input.SearchText) Then
             '如果没有搜索文本，按下载量将结果排序
             For Each Result As CompProject In RealResults
-                Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10))
+                Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 5))
             Next
         Else
             '如果有搜索文本，按关联度将结果排序
@@ -1108,7 +1111,7 @@ Retry:
             Dim Entry As New List(Of SearchEntry(Of CompProject))
             For Each Result As CompProject In RealResults
                 Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
-                           Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9)
+                           Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 5)) / 9)
                 Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
                           New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
                           New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
@@ -1120,7 +1123,7 @@ Retry:
         End If
         '根据排序分得出结果并添加
         Storage.Results.AddRange(
-            Sort(Scores.ToList, Function(a, b) a.Value > b.Value).Select(Function(r) r.Key).ToList)
+            Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
 
 #End Region
 
@@ -1288,7 +1291,7 @@ Retry:
                     Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
                     GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
                     If GameVersions.Count > 1 Then
-                        GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
+                        GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
                         If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
                     ElseIf GameVersions.Count = 1 Then
                         GameVersions = GameVersions.ToList
@@ -1329,7 +1332,7 @@ Retry:
                     GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
                                                Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
                     If GameVersions.Count > 1 Then
-                        GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
+                        GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
                         If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
                     ElseIf GameVersions.Count = 1 Then
                         '无需处理
@@ -1468,11 +1471,14 @@ Retry:
             Dim ResultJsonArray As JArray
             If FromCurseForge Then
                 'CurseForge
-                If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
-                    ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
-                Else '否则使用全部文件
-                    ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
-                End If
+                'HMCL 一次性请求了 10000 个文件，虽然不知道会不会出问题但先这样吧……（#5522）
+                ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=10000", IsJson:=True)("data")
+                '之前只请求一部分文件的方法备份如下：
+                'If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
+                '    ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
+                'Else '否则使用全部文件
+                '    ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
+                'End If
             Else
                 'Modrinth
                 ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)

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

@@ -627,7 +627,7 @@
                                           ".html", UseBrowserUserAgent:=True)
         Catch ex As Exception
             If GetExceptionSummary(ex).Contains("(404)") Then
-                Throw New Exception("没有可用版本")
+                Throw New Exception("不可用")
             Else
                 Throw
             End If
@@ -685,7 +685,7 @@
         Catch ex As Exception
             Throw New Exception("Forge 官方源版本列表解析失败（" & Result & "）", ex)
         End Try
-        If Not Versions.Any() Then Throw New Exception("没有可用版本")
+        If Not Versions.Any() Then Throw New Exception("不可用")
         Loader.Output = Versions
     End Sub
 
@@ -740,7 +740,7 @@
         Catch ex As Exception
             Throw New Exception("Forge BMCLAPI 版本列表解析失败（" & Json.ToString & "）", ex)
         End Try
-        If Not Versions.Any() Then Throw New Exception("没有可用版本")
+        If Not Versions.Any() Then Throw New Exception("不可用")
         Loader.Output = Versions
     End Sub
 
@@ -865,7 +865,7 @@
         Dim Versions = VersionNames.
             Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载
             Select(Function(name) New DlNeoForgeListEntry(name)).ToList
-        If Not Versions.Any() Then Throw New Exception("没有可用版本")
+        If Not Versions.Any() Then Throw New Exception("不可用")
         Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
         Return Versions
     End Function
@@ -1276,7 +1276,7 @@
                     For ii = 0 To LoaderList.Count - 1
                         LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败
                         If LoaderList(ii).Key.Error IsNot Nothing Then
-                            If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then
+                            If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("不可用") Then
                                 ErrorInfo = LoaderList(ii).Key.Error
                             End If
                         End If

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

@@ -131,7 +131,7 @@
                     Version = New Version(1, Version.Major, Version.Build, Version.Revision)
                 End If
                 Is64Bit = Output.Contains("64-bit")
-                If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New ApplicationException("分析详细信息失败，获取的版本为 " & Version.ToString)
+                If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败，获取的版本为 " & Version.ToString)
                 '基于 #3649，在 64 位系统上禁用 32 位 Java
                 If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本，请安装 64 位的 Java")
                 '基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败，干脆禁用更多版本的 JRE
@@ -342,7 +342,7 @@ RetryGet:
                 Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
             End If
             Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
-            If Setup.Get("LaunchAdvanceJava") OrElse (RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion)) Then
+            If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then
                 '直接跳过弹窗
                 Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", LogLevel.Debug)
                 AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -382,7 +382,7 @@ ExitUserJavaCheck:
 UserPass:
 
             '对适合的 Java 进行排序
-            AllowedJavaList = Sort(AllowedJavaList, AddressOf JavaSorter)
+            AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter)
             Log($"[Java] 排序后的 Java 优先顺序：")
             For Each Java In AllowedJavaList
                 Log($"[Java]  - {Java}")
@@ -586,7 +586,7 @@ NoUserJava:
             For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
                 NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
             Next
-            NewJavaList = Sort(JavaCheckList(NewJavaList), AddressOf JavaSorter)
+            NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter)
 
             '修改设置项
             Dim AllList As New JArray
@@ -685,7 +685,7 @@ Wait:
                 If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
                 Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
                 If IsFullSearch OrElse
-                   FolderInfo.Parent.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
+                   OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
                     JavaSearchFolder(FolderInfo, Results, Source)
                 End If
             Next

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

@@ -128,10 +128,6 @@ Public Module ModLaunch
                     Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
                 Case 2 '关闭
             End Select
-            '显示设置
-            If Setup.Get("LaunchGraphicSetup") Then
-                Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("检查显示设置", AddressOf McLaunchCheckGraphicSettings) With {.ProgressWeight = 2})
-            End If
             Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
             If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
             '等待加载器执行并更新 UI
@@ -207,48 +203,6 @@ NextInner:
 
 #End Region
 
-#Region "显示设置"
-
-    Private Sub McLaunchCheckGraphicSettings(Loader As LoaderTask(Of Integer, Integer))
-        Const GPU_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
-        Const TARGET_SETUP As String = "GpuPreference=2;"
-        Dim javaPath As String = McLaunchJavaSelected.PathJavaw
-
-        McLaunchLog("显示设置开始")
-        '读取现行设置
-        Try
-            Dim parentKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser
-            Dim regKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(GPU_KEY, False)
-            If regKey IsNot Nothing Then
-                Dim currentSetting As Object = regKey.GetValue(javaPath)
-                If currentSetting IsNot Nothing And TARGET_SETUP.Equals(currentSetting.ToString()) Then
-                    McLaunchLog("不需要调整显示设置")
-                    Exit Sub
-                End If
-                regKey.Close()
-            End If
-        Catch ex As Exception
-            McLaunchLog("无法读取注册表，跳过显示设置")
-            Exit Sub
-        End Try
-        '更新设置
-        Try
-            If Not IsAdmin() Then RunAsAdmin("")
-            Dim parentKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser
-            Dim regKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(GPU_KEY, True)
-            If regKey Is Nothing Then
-                regKey = parentKey.CreateSubKey(GPU_KEY)
-            End If
-            regKey.SetValue(javaPath, TARGET_SETUP)
-        Catch ex As Exception
-            McLaunchLog("无法写入显示设置")
-            Exit Sub
-        End Try
-        McLaunchLog("已修改显示设置")
-    End Sub
-
-#End Region
-
 #Region "预检测"
 
     Private Sub McLaunchPrecheck()
@@ -939,7 +893,8 @@ Retry:
                 $"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
                 "application/x-www-form-urlencoded", 2)
         Catch ex As Exception
-            If ex.Message.Contains("must sign in again") OrElse (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269
+            If ex.Message.ContainsF("must sign in again", True) OrElse ex.Message.ContainsF("password expired", True) OrElse
+               (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269
                 Return {"Relogin", ""}
             Else
                 Throw
@@ -1196,6 +1151,11 @@ Retry:
             '1.5.2-：最高 Java 12
             MaxVer = New Version(1, 12, 999, 999)
         End If
+        If McVersionCurrent.JsonVersion?("java_version") IsNot Nothing Then
+            Dim RecommendedJava As Integer = McVersionCurrent.JsonVersion("java_version").ToObject(Of Integer)
+            McLaunchLog("Mojang 推荐使用 Java " & RecommendedJava)
+            If RecommendedJava >= 22 Then MinVer = New Version(1, RecommendedJava, 0, 0) '潜在的向后兼容
+        End If
 
         'OptiFine 检测
         If McVersionCurrent.Version.HasOptiFine Then
@@ -1269,7 +1229,10 @@ Retry:
             If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
             McLaunchLog("无合适的 Java，需要确认是否自动下载")
             Dim JavaCode As String
-            If MinVer >= New Version(1, 21, 0, 0) Then
+            If MinVer >= New Version(1, 22, 0, 0) Then '潜在的向后兼容
+                JavaCode = MinVer.Minor
+                If Not JavaDownloadConfirm("Java " & JavaCode) Then Throw New Exception("$$")
+            ElseIf MinVer >= New Version(1, 21, 0, 0) Then
                 JavaCode = 21
                 If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
             ElseIf MinVer >= New Version(1, 9, 0, 0) Then
@@ -1363,15 +1326,14 @@ Retry:
         McLaunchLog("开始获取 Minecraft 启动参数")
         '获取基准字符串与参数信息
         Dim Arguments As String
-        Arguments = If(McLaunchJavaSelected.VersionCode > 8, "-Dfile.encoding=UTF-8 -Dstdout.encoding=UTF-8 -Dstderr.encoding=UTF-8 ", Nothing) '#4700
         If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("jvm") IsNot Nothing Then
             McLaunchLog("获取新版 JVM 参数")
-            Arguments += McLaunchArgumentsJvmNew(McVersionCurrent)
+            Arguments = McLaunchArgumentsJvmNew(McVersionCurrent)
             McLaunchLog("新版 JVM 参数获取成功：")
             McLaunchLog(Arguments)
         Else
             McLaunchLog("获取旧版 JVM 参数")
-            Arguments += McLaunchArgumentsJvmOld(McVersionCurrent)
+            Arguments = McLaunchArgumentsJvmOld(McVersionCurrent)
             McLaunchLog("旧版 JVM 参数获取成功：")
             McLaunchLog(Arguments)
         End If
@@ -1455,7 +1417,7 @@ Retry:
         If McLoginLoader.Output.Type = "Auth" Then
             Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
                 "http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
-                Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
+                Setup.Get("VersionServerAuthServer", McVersionCurrent))
             Try
                 Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
                 DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1467,11 +1429,12 @@ Retry:
         End If
 
         '添加 Java Wrapper 作为主 Jar
-        If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
-        If Setup.Get("VersionAdvanceUseLaunchWrapperV2", Version) AndAlso Setup.Get("LaunchAdvanceUseLaunchWrapper") Then
+        If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then
+            If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
             DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
             DataList.Add("-jar """ & ExtractJavaWrapper() & """")
         End If
+
         '添加 MainClass
         If Version.JsonObject("mainClass") Is Nothing Then
             Throw New Exception("版本 json 中没有 mainClass 项！")
@@ -1535,11 +1498,12 @@ NextVersion:
         End If
 
         '添加 Java Wrapper 作为主 Jar
-        If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
-        If Setup.Get("VersionAdvanceUseLaunchWrapperV2", Version) AndAlso Setup.Get("LaunchAdvanceUseLaunchWrapper") Then
+        If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then
+            If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
             DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
             DataList.Add("-jar """ & ExtractJavaWrapper() & """")
         End If
+
         '将 "-XXX" 与后面 "XXX" 合并到一起
         '如果不合并，会导致 Forge 1.17 启动无效，它有两个 --add-exports，进一步导致其中一个在后面被去重
         Dim DeDuplicateDataList As New List(Of String)
@@ -1829,6 +1793,29 @@ NextVersion:
 
     Private Sub McLaunchPrerun()
 
+        '要求 Java 使用高性能显卡
+        If Setup.Get("LaunchAdvanceGraphicCard") Then
+            Try
+                SetGPUPreference(McLaunchJavaSelected.PathJavaw)
+                SetGPUPreference(PathWithName)
+            Catch ex As Exception
+                If IsAdmin() Then
+                    Log(ex, "直接调整显卡设置失败")
+                Else
+                    Log(ex, "直接调整显卡设置失败，将以管理员权限重启 PCL 再次尝试")
+                    Try
+                        If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJavaw}""") = ProcessReturnValues.TaskDone Then
+                            McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
+                        Else
+                            Throw New Exception("调整过程中出现异常")
+                        End If
+                    Catch exx As Exception
+                        Log(exx, "调整显卡设置失败，Minecraft 可能会使用默认显卡运行", LogLevel.Hint)
+                    End Try
+                End If
+            End Try
+        End If
+
         '更新 launcher_profiles.json
         Try
             '确保可用
@@ -2099,15 +2086,15 @@ IgnoreCustomSkin:
         '输出 bat
         Try
             Dim CmdString As String =
-                $"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, Nothing)}" &
+                $"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, "")}" &
                 "@echo off" & vbCrLf &
-                "title 启动 - " & McVersionCurrent.Name & vbCrLf &
+                $"title 启动 - {McVersionCurrent.Name}" & vbCrLf &
                 "echo 游戏正在启动，请稍候。" & vbCrLf &
-                "set APPDATA=""" & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf &
-                "cd /D """ & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf &
+                $"set APPDATA=""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf &
+                $"cd /D ""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf &
                 CustomCommandGlobal & vbCrLf &
                 CustomCommandVersion & vbCrLf &
-                """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
+                $"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
                 "echo 游戏已退出。" & vbCrLf &
                 "pause"
             WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
@@ -2182,14 +2169,10 @@ IgnoreCustomSkin:
         Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw)
 
         '设置环境变量
-        If StartInfo.EnvironmentVariables.ContainsKey("appdata") Then
-            StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
-        Else
-            StartInfo.EnvironmentVariables.Add("appdata", ShortenPath(PathMcFolder))
-        End If
         Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
         Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
         StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
+        StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
 
         '设置其他参数
         StartInfo.StandardErrorEncoding = If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Nothing)

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

@@ -214,45 +214,45 @@ Public Module ModMinecraft
         ''' 在不加载版本的情况下获取版本隔离目录。
         ''' </summary>
         Public Function GetPathIndie(Modable As Boolean) As String
-            Dim IndieType As Integer = Setup.Get("LaunchArgumentIndie")
-            Select Case Setup.Get("VersionArgumentIndie", Version:=Me)
-                Case -1
-                    '尚未判断
+            '决定版本隔离类型
+            If Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then
+                Dim ShouldBeIndie =
+                Function() As Boolean
+                    '从老的版本独立设置中迁移：-1 未决定，0 使用全局设置，1 手动开启，2 手动关闭
+                    If Not Setup.IsUnset("VersionArgumentIndie", Version:=Me) AndAlso Setup.Get("VersionArgumentIndie", Version:=Me) > 0 Then
+                        Log($"[Minecraft] 版本隔离初始化（{Name}）：从老的版本独立设置中迁移")
+                        Return Setup.Get("VersionArgumentIndie", Version:=Me) = 1
+                    End If
+                    '若版本文件夹下包含 mods 或 saves 文件夹，则自动开启版本隔离
                     Dim ModFolder As New DirectoryInfo(Path & "mods\")
                     Dim SaveFolder As New DirectoryInfo(Path & "saves\")
-                    If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse
-                       (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
-                        '自动开启
-                        Setup.Set("VersionArgumentIndie", 1, Version:=Me)
-                        Log("[Setup] 已自动开启单版本隔离：" & Name)
-                        IndieType = 4
-                    Else
-                        '使用全局设置
-                        Setup.Set("VersionArgumentIndie", 0, Version:=Me)
-                        Log("[Setup] 版本隔离使用全局设置：" & Name)
+                    If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
+                        Log($"[Minecraft] 版本隔离初始化（{Name}）：版本文件夹下存在 mods 或 saves 文件夹，自动开启")
+                        Return True
                     End If
-                Case 0
-                    '使用全局设置
-                Case 1
-                    '开启
-                    IndieType = 4
-                Case 2
-                    '关闭
-                    IndieType = 0
-            End Select
-            Select Case IndieType
-                Case 0 '关闭
-                Case 1 '仅隔离可安装 Mod 的版本
-                    If Modable Then Return Path
-                Case 2 '仅隔离非正式版
-                    If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path
-                Case 3 '隔离非正式版与可安装 Mod 的版本
-                    If Modable Then Return Path
-                    If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path
-                Case 4 '隔离所有版本
-                    Return Path
-            End Select
-            Return PathMcFolder
+                    '根据全局的默认设置决定是否隔离
+                    Log($"[Minecraft] 版本隔离初始化（{Name}）：从全局默认设置中（{Setup.Get("LaunchArgumentIndieV2")}）判断")
+                    Select Case Setup.Get("LaunchArgumentIndieV2")
+                        Case 0 '关闭
+                            Return False
+                        Case 1 '仅隔离可安装 Mod 的版本
+                            Return Modable
+                        Case 2 '仅隔离非正式版
+                            Return State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
+                        Case 3 '隔离非正式版与可安装 Mod 的版本
+                            Return Modable OrElse State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
+                        Case Else '隔离所有版本
+                            Return True
+                    End Select
+                End Function
+                Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me)
+            End If
+            '根据隔离类型决定路径
+            If Setup.Get("VersionArgumentIndieV2", Version:=Me) Then
+                Return Path
+            Else
+                Return PathMcFolder
+            End If
         End Function
 
         ''' <summary>
@@ -396,27 +396,13 @@ Public Module ModMinecraft
                             GoTo VersionSearchFinish
                         End If
                         '从 jar 文件的 version.json 中获取版本号
-                        If File.Exists(Path & Name & ".jar") Then
-                            Try
-                                Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
-                                    Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
-                                    If VersionJson IsNot Nothing Then
-                                        Using VersionJsonStream As New StreamReader(VersionJson.Open)
-                                            Dim VersionJsonObj As JObject = GetJson(VersionJsonStream.ReadToEnd)
-                                            If VersionJsonObj("id") IsNot Nothing Then
-                                                Dim VersionId As String = VersionJsonObj("id").ToString
-                                                If VersionId.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash，虽然我没发现
-                                                    _Version.McName = VersionId
-                                                    Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号：" & VersionId)
-                                                    GoTo VersionSearchFinish
-                                                End If
-                                            End If
-                                        End Using
-                                    End If
-                                End Using
-                            Catch ex As Exception
-                                Log(ex, "从版本 jar 中的 version.json 获取版本号失败")
-                            End Try
+                        If JsonVersion?("name") IsNot Nothing Then
+                            Dim JsonVerName As String = JsonVersion("name").ToString
+                            If JsonVerName.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash，虽然我没发现
+                                _Version.McName = JsonVerName
+                                Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号：" & JsonVerName)
+                                GoTo VersionSearchFinish
+                            End If
                         End If
                         '非准确的版本判断警告
                         Log("[Minecraft] 无法完全确认 MC 版本号的版本：" & Name)
@@ -536,9 +522,8 @@ VersionSearchFinish:
                             For Each Subjson As JObject In _JsonObject("patches")
                                 SubjsonList.Add(Subjson)
                             Next
-                            SubjsonList = Sort(SubjsonList, Function(Left As JObject, Right As JObject) As Boolean
-                                                                Return Val(If(Left("priority"), "0").ToString) < Val(If(Right("priority"), "0").ToString)
-                                                            End Function)
+                            SubjsonList = SubjsonList.Sort(
+                                Function(Left, Right) Val(If(Left("priority"), "0").ToString) < Val(If(Right("priority"), "0").ToString))
                             For Each Subjson As JObject In SubjsonList
                                 Dim Id As String = Subjson("id")
                                 If Id IsNot Nothing Then
@@ -628,6 +613,35 @@ Recheck:
         ''' </summary>
         Public Property HasJumpLoader As Boolean = False
 
+        ''' <summary>
+        ''' 版本 jar 中的 version.json 文件对象。
+        ''' 若没有则返回 Nothing。
+        ''' </summary>
+        Public ReadOnly Property JsonVersion As JObject
+            Get
+                If Not JsonVersionInited Then
+                    JsonVersionInited = True
+                    If File.Exists(Path & Name & ".jar") Then
+                        Try
+                            Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
+                                Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
+                                If VersionJson IsNot Nothing Then
+                                    Using VersionJsonStream As New StreamReader(VersionJson.Open)
+                                        _JsonVersion = GetJson(VersionJsonStream.ReadToEnd)
+                                    End Using
+                                End If
+                            End Using
+                        Catch ex As Exception
+                            Log(ex, "从版本 jar 中读取 version.json 失败")
+                        End Try
+                    End If
+                End If
+                Return _JsonVersion
+            End Get
+        End Property
+        Private JsonVersionInited As Boolean = False
+        Private _JsonVersion As JObject = Nothing
+
         ''' <summary>
         ''' 该版本的依赖版本。若无依赖版本则为空字符串。
         ''' </summary>
@@ -1116,7 +1130,7 @@ ExitDataLoad:
                     Throw New Exception("无法读取版本文件夹，可能是由于没有权限（" & Path & "versions）", ex)
                 End Try
             End If
-            '没有可用版本
+            '不可用
             If Not FolderList.Any() Then
                 WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存
                 GoTo OnLoaded
@@ -1427,7 +1441,7 @@ OnLoaded:
             Next
             If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot)
             '按版本号排序
-            Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left, Right) Left.Version.McCodeMain > Right.Version.McCodeMain)
+            Dim NewList As List(Of McVersion) = OldList.OrderByDescending(Function(v) v.Version.McCodeMain).ToList
             '回设
             If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot)
             ResultVersionList(McVersionCardType.OriginalLike) = NewList
@@ -1435,7 +1449,7 @@ OnLoaded:
 
         '不常用版本：按发布时间新旧排序，如果不可用则按名称排序
         If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then
-            ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish),
+            ResultVersionList(McVersionCardType.Rubbish) = ResultVersionList(McVersionCardType.Rubbish).Sort(
             Function(Left As McVersion, Right As McVersion)
                 Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
                 Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
@@ -1457,7 +1471,7 @@ OnLoaded:
 
         'API 版本：优先按版本排序，此后【先放 Fabric，再放 Neo/Forge（按版本号从高到低排序），最后放 LiteLoader（按名称排序）】
         If ResultVersionList.ContainsKey(McVersionCardType.API) Then
-            ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API),
+            ResultVersionList(McVersionCardType.API) = ResultVersionList(McVersionCardType.API).Sort(
             Function(Left As McVersion, Right As McVersion)
                 Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName)
                 If Basic <> 0 Then
@@ -2116,7 +2130,7 @@ OnLoaded:
     ''' 检查设置，是否应当忽略文件检查？
     ''' </summary>
     Public Function ShouldIgnoreFileCheck(Version As McVersion)
-        Return Setup.Get("LaunchAdvanceAssets") OrElse Setup.Get("VersionAdvanceAssetsV2", Version:=Version) OrElse (Setup.Get("VersionAdvanceAssets", Version:=Version) = 2)
+        Return Setup.Get("VersionAdvanceAssetsV2", Version:=Version) OrElse (Setup.Get("VersionAdvanceAssets", Version:=Version) = 2)
     End Function
 
 #End Region

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

@@ -902,7 +902,7 @@ Finished:
             Log($"[Mod] 共有 {ModList.Count} 个 Mod，其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息，{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
 
             '排序
-            ModList = Sort(ModList,
+            ModList = ModList.Sort(
             Function(Left As McMod, Right As McMod) As Boolean
                 If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
                     Return Left.State = McMod.McModState.Unavailable
@@ -932,18 +932,10 @@ Finished:
         Dim Mods As List(Of McMod) = Loader.Input.Key
         Dim Cache As JObject = Loader.Input.Value
         '获取作为检查目标的加载器和版本
+        '此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
         Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
         Dim ModLoaders = GetTargetModLoaders()
         Dim McVersion = TargetMcVersion.McName
-        '暂不向下扩展检查的 MC 小版本
-        '例如：Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
-        'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
-        '    McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
-        '    For i = 1 To TargetMcVersion.McCodeSub
-        '        McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
-        '    Next
-        'End If
-        'McVersions = McVersions.Distinct().ToList()
         '开始网络获取
         Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}")
         Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
@@ -1062,7 +1054,7 @@ Finished:
                         Entry.Comp = Project
                     Next
                     '查找或许版本更新的文件列表
-                    If ModLoaders.Count = 1 Then 'TODO: 结果有多个 ModLoader 时提示无法检测更新
+                    If ModLoaders.Count = 1 Then
                         Dim NewestVersion As String = Nothing
                         Dim NewestFileIds As New List(Of Integer)
                         For Each IndexEntry In ProjectJson("latestFilesIndexes")

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

@@ -203,7 +203,8 @@ Retry:
                 End If
                 Task.Progress = 0.95
                 '开启版本隔离
-                WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+                WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
+                WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
             End Sub) With {
             .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
         End If
@@ -397,7 +398,8 @@ Retry:
             End If
             Task.Progress = 0.95
             '开启版本隔离
-            WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+            WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
+            WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
         End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
         '获取下载文件列表
         Dim FileList As New List(Of NetFile)
@@ -513,7 +515,8 @@ Retry:
             End If
             Task.Progress = 0.95
             '开启版本隔离
-            WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+            WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
+            WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
         End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
         '构造加载器
         If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
@@ -598,6 +601,7 @@ Retry:
             Task.Progress = 0.95
             '开启版本隔离
             WriteIni(SetupFile, "VersionArgumentIndie", 1)
+            WriteIni(SetupFile, "VersionArgumentIndieV2", True)
             '读取 MMC 设置文件（#2655）
             Try
                 Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
@@ -738,7 +742,8 @@ Retry:
             End If
             Task.Progress = 0.95
             '开启版本隔离
-            WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+            WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
+            WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
         End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
         '构造加载器
         If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！")

Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb

@@ -172,7 +172,7 @@
     ''' <summary>
     ''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示：若关闭碰撞检测，则无法展开 Tooltip。
     ''' </summary>
-    Public CanInteraction As Boolean = True
+    Public Property CanInteraction As Boolean = True
     Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
         If Not CanInteraction Then Exit Sub
         '判断当前颜色

Plain Craft Launcher 2/Modules/ModEvent.vb

@@ -146,12 +146,11 @@
                                     " - https://www.baidu.com/test.xaml（同时也需要包含这个文件）", ex)
             End Try
             '下载文件
-            Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName
-            Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml")
-            Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp1)
+            Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
+            Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp)
             Try
-                NetDownloadByClient(RelativeUrl, LocalTemp1)
-                NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
+                NetDownloadByClient(RelativeUrl, LocalTemp)
+                NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
             Catch ex As Exception
                 Throw New Exception("下载指定的文件失败！" & vbCrLf &
                                     "注意，联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf &
@@ -159,7 +158,7 @@
                                     " - https://www.baidu.com/test.json（填写这个路径）" & vbCrLf &
                                     " - https://www.baidu.com/test.xaml（同时也需要包含这个文件）", ex)
             End Try
-            RelativeUrl = LocalTemp1
+            RelativeUrl = LocalTemp
         End If
         RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
 

Plain Craft Launcher 2/Modules/ModMain.vb

@@ -677,8 +677,8 @@ NextFile:
     ''' </summary>
     Public Function HelpArgumentReplace(Xaml As String) As String
         Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
-        Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomHint()), "\{hint\}")
-        Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomCave()), "\{cave\}")
+        Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
+        Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
         Return Result
     End Function
 
@@ -811,6 +811,34 @@ 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
 
+    ''' <summary>
+    ''' 将特定程序设置为使用高性能显卡启动。
+    ''' 如果失败，则抛出异常。
+    ''' </summary>
+    Public Sub SetGPUPreference(Executeable As String)
+        Const REG_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
+        Const REG_VALUE As String = "GpuPreference=2;"
+        '查看现有设置
+        Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
+            If ReadOnlyKey IsNot Nothing Then
+                Dim CurrentValue = ReadOnlyKey.GetValue(Executeable)
+                If REG_VALUE = CurrentValue?.ToString() Then
+                    Log($"[System] 无需调整显卡设置：{Executeable}")
+                    Return
+                End If
+            Else
+                '创建父级键
+                Log($"[System] 需要创建显卡设置的父级键")
+                My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
+            End If
+        End Using
+        '写入新设置
+        Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
+            WriteKey.SetValue(Executeable, REG_VALUE)
+            Log($"[System] 已调整显卡设置：{Executeable}")
+        End Using
+    End Sub
+
 #End Region
 
 #Region "任务缓存"
@@ -851,10 +879,9 @@ NextFile:
     ''' <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)}\"
+        RequestTaskTempFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
+        If RequireNonSpace AndAlso RequestTaskTempFolder.Contains(" ") Then
+            RequestTaskTempFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
         End If
         Directory.CreateDirectory(RequestTaskTempFolder)
     End Function

Plain Craft Launcher 2/Modules/ModMusic.vb

@@ -1,7 +1,4 @@
-Imports NAudio.CoreAudioApi
-Imports NAudio.CoreAudioApi.Interfaces
-
-Public Module ModMusic
+Public Module ModMusic
 
 #Region "播放列表"
 
@@ -69,44 +66,44 @@ Public Module ModMusic
     ''' </summary>
     Private Sub MusicRefreshUI()
         RunInUi(
-            Sub()
-                Try
+        Sub()
+            Try
 
-                    If Not MusicAllList.Any() Then
-                        '无背景音乐
-                        FrmMain.BtnExtraMusic.Show = False
-                    Else
-                        '有背景音乐
-                        FrmMain.BtnExtraMusic.Show = True
-                        Dim ToolTipText As String
-                        If MusicState = MusicStates.Pause Then
-                            FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
-                            FrmMain.BtnExtraMusic.LogoScale = 0.8
-                            ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
-                            If MusicAllList.Count > 1 Then
-                                ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
-                            Else
-                                ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。"
-                            End If
+                If Not MusicAllList.Any() Then
+                    '无背景音乐
+                    FrmMain.BtnExtraMusic.Show = False
+                Else
+                    '有背景音乐
+                    FrmMain.BtnExtraMusic.Show = True
+                    Dim ToolTipText As String
+                    If MusicState = MusicStates.Pause Then
+                        FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
+                        FrmMain.BtnExtraMusic.LogoScale = 0.8
+                        ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
+                        If MusicAllList.Count > 1 Then
+                            ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
                         Else
-                            FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
-                            FrmMain.BtnExtraMusic.LogoScale = 1
-                            ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
-                            If MusicAllList.Count > 1 Then
-                                ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
-                            Else
-                                ToolTipText += vbCrLf & "左键暂停，右键重新从头播放。"
-                            End If
+                            ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。"
+                        End If
+                    Else
+                        FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
+                        FrmMain.BtnExtraMusic.LogoScale = 1
+                        ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
+                        If MusicAllList.Count > 1 Then
+                            ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
+                        Else
+                            ToolTipText += vbCrLf & "左键暂停，右键重新从头播放。"
                         End If
-                        FrmMain.BtnExtraMusic.ToolTip = ToolTipText
-                        ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
                     End If
-                    If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
+                    FrmMain.BtnExtraMusic.ToolTip = ToolTipText
+                    ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
+                End If
+                If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
 
-                Catch ex As Exception
-                    Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
-                End Try
-            End Sub)
+            Catch ex As Exception
+                Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
+            End Try
+        End Sub)
     End Sub
 
     ''' <summary>
@@ -226,11 +223,11 @@ Public Module ModMusic
     Public Function MusicPause() As Boolean
         If MusicState = MusicStates.Play Then
             RunInThread(
-                Sub()
-                    Log("[Music] 已暂停播放")
-                    MusicNAudio?.Pause()
-                    MusicRefreshUI()
-                End Sub)
+            Sub()
+                Log("[Music] 已暂停播放")
+                MusicNAudio?.Pause()
+                MusicRefreshUI()
+            End Sub)
             Return True
         Else
             Log($"[Music] 无需暂停播放，当前状态为 {MusicState}")
@@ -246,11 +243,11 @@ Public Module ModMusic
             Return False
         Else
             RunInThread(
-                Sub()
-                    Log("[Music] 已恢复播放")
-                    MusicNAudio?.Play()
-                    MusicRefreshUI()
-                End Sub)
+            Sub()
+                Log("[Music] 已恢复播放")
+                MusicNAudio?.Play()
+                MusicRefreshUI()
+            End Sub)
             Return True
         End If
     End Function
@@ -276,7 +273,6 @@ Public Module ModMusic
             '开始播放
             CurrentWave = New NAudio.Wave.WaveOutEvent()
             MusicNAudio = CurrentWave
-            CurrentWave.DeviceNumber = -1
             Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
             CurrentWave.Init(Reader)
             CurrentWave.Play()
@@ -300,6 +296,10 @@ Public Module ModMusic
             If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
         Catch ex As Exception
             Log(ex, "播放音乐出现内部错误（" & MusicCurrent & "）", LogLevel.Developer)
+            If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
+                Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Critical)
+                Thread.Sleep(1000000000)
+            End If
             If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
                 Hint("由于音频设备变更，音乐播放功能在重启 PCL 后才能恢复！", HintType.Critical)
                 Thread.Sleep(1000000000)
@@ -307,7 +307,7 @@ Public Module ModMusic
             If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
                 Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
             ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
-                    ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
+                ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
                 Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
             Else
                 Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", LogLevel.Hint)