2.12.6.1

2026-04-02 17:48:49 +08:00
parent c850596cab
commit 36b5bcbef4
20 changed files with 215 additions and 25979 deletions
@@ -14,25 +14,24 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.12.6" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.12.6." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.12.6.1" '显示用版本名
    Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
-    Public Const VersionCode As Integer = 387 'Release
+    Public Const VersionCode As Integer = 389 '正式版
 #Else
-    Public Const VersionCode As Integer = 386 'Snapshot
+    Public Const VersionCode As Integer = 388 '快照版
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
 #If RELEASE Then
-    Public Const VersionBranchName As String = "Snapshot"
-    Public Const VersionBranchCode As String = "0"
+    Public Const VersionBranchName As String = "快照版"
+    Public Const VersionBranchCode As Integer = 0
 #ElseIf BETA Then
-    Public Const VersionBranchName As String = "Release"
-    Public Const VersionBranchCode As String = "50"
+    Public Const VersionBranchName As String = "正式版"
+    Public Const VersionBranchCode As Integer = 50
 #Else
-    Public Const VersionBranchName As String = "Debug"
-    Public Const VersionBranchCode As String = "100"
+    Public Const VersionBranchName As String = "开发版"
+    Public Const VersionBranchCode As Integer = 100
 #End If

    ''' <summary>
@@ -1270,6 +1269,7 @@ Re:
        End Function
    End Class

+    '压缩文件
    ''' <summary>
    ''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。
    ''' 会尝试创建，但不会清空目标文件夹。
@@ -1318,6 +1318,25 @@ Re:
            End Try
        End Try
    End Sub
+    ''' <summary>
+    ''' 将多个文件打包为一个压缩文件。
+    ''' 这些文件会被直接放在压缩包根目录下。
+    ''' </summary>
+    Public Sub CreateCompressedFile(OutputFullPath As String, SourceFiles As IEnumerable(Of String))
+        Dim DirectoryPath = IO.Path.GetDirectoryName(OutputFullPath)
+        If Not Directory.Exists(DirectoryPath) Then Directory.CreateDirectory(DirectoryPath)
+        Using ZipStream As New FileStream(OutputFullPath, FileMode.Create)
+            Using Archive As New ZipArchive(ZipStream, ZipArchiveMode.Create)
+                For Each FilePath In SourceFiles
+                    If Not File.Exists(FilePath) Then Return
+                    Using SourceStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.Read),
+                          EntryStream As Stream = Archive.CreateEntry(IO.Path.GetFileName(FilePath)).Open()
+                        SourceStream.CopyTo(EntryStream)
+                    End Using
+                Next
+            End Using
+        End Using
+    End Sub

    ''' <summary>
    ''' 删除文件夹，返回删除的文件个数。通过参数选择是否抛出异常。
@@ -3324,9 +3343,11 @@ Retry:

    '遥测
    Public Sub Telemetry([Event] As String, ParamArray Datas As String())
+#If Not RELEASE And Not BETA Then
+        Return '开发版不上传遥测
+#End If
        If Not Settings.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
        If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
-        If VersionBranchName = "Debug" Then Return '开发版本不上传遥测
        RunInNewThread(
        Sub()
            Try
@@ -1,4 +1,6 @@
-Public Module ModComp
+Imports System.IO.Compression
+
+Public Module ModComp

    <Flags> Public Enum CompType
        ''' <summary> 
@@ -58,37 +60,39 @@
            '初始化数据库
            _CompDatabase = New List(Of CompDatabaseEntry)
            Dim i As Integer = 0
-            For Each Line In DecodeBytes(GetResources("ModData")).Replace(vbCrLf, vbLf).Replace(vbCr, "").Split(vbLf)
-                i += 1
-                If Line = "" Then Continue For
-                For Each EntryData As String In Line.Split("¨")
-                    Dim Entry = New CompDatabaseEntry
-                    Dim Splited = EntryData.Split("|")
-                    Entry.Popularity = Val(Splited(0))
-                    If Splited(1).StartsWithF("@") Then
-                        Entry.CurseForgeSlug = Nothing
-                        Entry.ModrinthSlug = Splited(1).Replace("@", "")
-                    ElseIf Splited(1).EndsWithF("@") Then
-                        Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
-                        Entry.ModrinthSlug = Entry.CurseForgeSlug
-                    ElseIf Splited(1).Contains("@") Then
-                        Entry.CurseForgeSlug = Splited(1).Split("@")(0)
-                        Entry.ModrinthSlug = Splited(1).Split("@")(1)
-                    Else
-                        Entry.CurseForgeSlug = Splited(1)
-                        Entry.ModrinthSlug = Nothing
-                    End If
-                    Entry.WikiId = i
-                    If Splited.Count >= 3 Then
-                        Entry.ChineseName = Splited.Last
-                        If Entry.ChineseName.Contains("*") Then '处理 *
-                            Entry.ChineseName = Entry.ChineseName.Replace("*",
-                                $" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
+            Using Archive As New ZipArchive(New MemoryStream(GetResources("ModData")), ZipArchiveMode.Read)
+                For Each Line In ReadFile(Archive.GetEntry("moddata.txt").Open(), Encoding.UTF8).Replace(vbCrLf, vbLf).Replace(vbCr, "").Split(vbLf)
+                    i += 1
+                    If Line = "" Then Continue For
+                    For Each EntryData As String In Line.Split("¨")
+                        Dim Entry = New CompDatabaseEntry
+                        Dim Splited = EntryData.Split("|")
+                        Entry.Popularity = Val(Splited(0))
+                        If Splited(1).StartsWithF("@") Then
+                            Entry.CurseForgeSlug = Nothing
+                            Entry.ModrinthSlug = Splited(1).Replace("@", "")
+                        ElseIf Splited(1).EndsWithF("@") Then
+                            Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
+                            Entry.ModrinthSlug = Entry.CurseForgeSlug
+                        ElseIf Splited(1).Contains("@") Then
+                            Entry.CurseForgeSlug = Splited(1).Split("@")(0)
+                            Entry.ModrinthSlug = Splited(1).Split("@")(1)
+                        Else
+                            Entry.CurseForgeSlug = Splited(1)
+                            Entry.ModrinthSlug = Nothing
                        End If
-                    End If
-                    _CompDatabase.Add(Entry)
+                        Entry.WikiId = i
+                        If Splited.Count >= 3 Then
+                            Entry.ChineseName = Splited.Last
+                            If Entry.ChineseName.Contains("*") Then '处理 *
+                                Entry.ChineseName = Entry.ChineseName.Replace("*",
+                                    $" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
+                            End If
+                        End If
+                        _CompDatabase.Add(Entry)
+                    Next
                Next
-            Next
+            End Using
            Return _CompDatabase
        End Get
    End Property
@@ -322,7 +326,7 @@
                    Next
                    CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
                    Drops = Files.SelectMany(Function(f) f.Value).
-                        Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
+                        Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
                    ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
                    'Tags
                    Tags = New List(Of String)
@@ -418,7 +422,7 @@
                    'GameVersions
                    '搜索结果的键为 versions，获取特定工程的键为 game_versions
                    UnsafeGameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).Select(Function(v) v.ToString).Distinct.ToList
-                    Drops = UnsafeGameVersions.Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
+                    Drops = UnsafeGameVersions.Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
                    'Type
                    Select Case Data("project_type").ToString
                        Case "modpack" : Types = CompType.ModPack
@@ -1100,7 +1104,7 @@ NextPage:

        '在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
        '所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
-        Dim IgnoreModLoaderFilter = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion, True) < 140
+        Dim IgnoreModLoaderFilter = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
        Try

            'CurseForge 搜索
@@ -213,6 +213,7 @@
        For Each Version As JObject In Loader.Output.Value("versions")
            Drops.Add(McVersion.VersionToDrop(Version("id")))
        Next
+        Drops.Remove(209)
        AllDrops = Drops.Distinct.OrderByDescending(Function(d) d).ToList()
    End Sub

@@ -1422,14 +1422,14 @@ NextInstance:
            End If
            Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾
        End If
+        McLaunchLog("使用 JLW：" & UseJLW)

        'LUA
        Dim UseLUA As Boolean =
            Not Settings.Get("LaunchAdvanceDisableLUA") AndAlso Not Settings.Get("VersionAdvanceDisableLUA", McInstanceSelected) AndAlso
-            McLaunchJavaSelected.MajorVersion >= 25
-        If UseLUA Then
-            Args.Add($"-javaagent:""{ExtractPatch("LUA")}""")
-        End If
+            McLaunchJavaSelected.MajorVersion >= 25 AndAlso McInstanceSelected.Version.Drop >= 261
+        If UseLUA Then Args.Add($"-javaagent:""{ExtractPatch("LUA")}""")
+        McLaunchLog("使用 LUA：" & UseLUA)

 #Region "内存管理"

@@ -170,7 +170,7 @@ Public Module ModMinecraft

 #Region "版本处理"

-    Public Const McInstanceCacheVersion As Integer = 33
+    Public Const McInstanceCacheVersion As Integer = 34

    Private _McInstanceSelected As McInstance
    ''' <summary>
@@ -444,21 +444,7 @@ Public Module ModMinecraft
 VersionSearchFinish:
                '获取版本号
                _Version.VanillaName = _Version.VanillaName.Replace("_unobfuscated", "").Replace(" Unobfuscated", "")
-                If _Version.VanillaName.StartsWithF("1.") Then
-                    Dim Segments = _Version.VanillaName.Split(" _-.".ToCharArray)
-                    _Version.Vanilla = New Version(
-                        Val(If(Segments.Count >= 2, Segments(1), "0")),
-                        0,
-                        Val(If(Segments.Count >= 3, Segments(2), "0")))
-                ElseIf RegexCheck(_Version.VanillaName, "^[2-9][0-9]\.") Then
-                    Dim Segments = _Version.VanillaName.Split(" _-.".ToCharArray)
-                    _Version.Vanilla = New Version(
-                        Val(Segments(0)),
-                        Val(If(Segments.Count >= 2, Segments(1), "0")),
-                        Val(If(Segments.Count >= 3, Segments(2), "0")))
-                Else
-                    _Version.Vanilla = New Version(9999, 0, 0)
-                End If
+                _Version.Vanilla = McVersion.NameToVersion(_Version.VanillaName)
                Return _Version
            End Get
            Set(value As McVersion)
@@ -761,7 +747,8 @@ Recheck:
                    Case Else '根据 API 进行筛选
                        Dim RealJson As String = If(JsonObject, JsonText).ToString
                        '愚人节与快照版本
-                        If If(JsonObject("type"), "").ToString = "fool" OrElse GetMcFoolName(Version.VanillaName) <> "" Then
+                        If If(JsonObject("type"), "").ToString = "fool" OrElse
+                           (ReleaseTime.ToUniversalTime.Month = 4 AndAlso ReleaseTime.ToUniversalTime.Day = 1) OrElse GetMcFoolName(Version.VanillaName) <> "" Then
                            State = McInstanceState.Fool
                        ElseIf IsSnapshot() Then
                            State = McInstanceState.Snapshot
@@ -1126,23 +1113,14 @@ ExitDataLoad:
            Return False
        End Function
        ''' <summary>
-        ''' 尝试将版本字符串转换为 Drop 序数。
-        ''' 若无法转换则返回 0。
+        ''' 将版本名转换为 Drop 序数。
+        ''' 若无法转换则返回 209。
        ''' </summary>
-        Public Shared Function VersionToDrop(Version As String, Optional AllowSnapshot As Boolean = False) As Integer
-            If Not AllowSnapshot AndAlso Version.Contains("-") Then Return 0
-            If Version Is Nothing Then Return 0
-            Dim Segments = Version.BeforeFirst("-").Split(".")
-            If Segments.Length < 2 Then Return 0
-            Dim Major As Integer = Val(Segments(0))
-            Dim Minor As Integer = Val(Segments(1))
-            If Major = 1 Then
-                Return Minor * 10
-            ElseIf Major < 25 Then
-                Return 0
-            Else
-                Return Major * 10 + Minor
-            End If
+        Public Shared Function VersionToDrop(VanillaName As String) As Integer
+            If VanillaName Is Nothing Then Return 209
+            Dim Version = NameToVersion(VanillaName)
+            If Version.Major >= 1000 Then Return 209
+            Return Version.Major * 10 + Version.Minor
        End Function
        ''' <summary>
        ''' 将 Drop 序数转换为版本字符串。
@@ -1150,10 +1128,36 @@ ExitDataLoad:
        Public Shared Function DropToVersion(Drop As Integer) As String
            If Drop >= 250 Then
                Return $"{Drop \ 10}.{Drop Mod 10}"
+            ElseIf Drop = 209 Then
+                Log("[Minecraft] 尝试将旧快照版 Drop 序数转换为版本字符串，这不应该发生！" & vbCrLf & GetStackTrace(), LogLevel.Debug)
+                Return "1.20"
            Else
                Return $"1.{Drop \ 10}"
            End If
        End Function
+        ''' <summary>
+        ''' 将版本名转换为可比较的三段式原版版本号。
+        ''' 对老版本格式，例如 1.20.3，会被转换为 20.0.3。
+        ''' 若没有版本号，例如旧快照，则为 9999.0.0。
+        ''' </summary>
+        Public Shared Function NameToVersion(VanillaName As String) As Version
+            VanillaName = VanillaName.Replace("_unobfuscated", "").Replace(" Unobfuscated", "")
+            If VanillaName.StartsWithF("1.") Then
+                Dim Segments = VanillaName.Split(" _-.".ToCharArray)
+                Return New Version(
+                    Val(If(Segments.Count >= 2, Segments(1), "0")),
+                    0,
+                    Val(If(Segments.Count >= 3, Segments(2), "0")))
+            ElseIf RegexCheck(VanillaName, "^[2-9][0-9]\.") Then
+                Dim Segments = VanillaName.Split(" _-.".ToCharArray)
+                Return New Version(
+                    Val(Segments(0)),
+                    Val(If(Segments.Count >= 2, Segments(1), "0")),
+                    Val(If(Segments.Count >= 3, Segments(2), "0")))
+            Else
+                Return New Version(9999, 0, 0)
+            End If
+        End Function

    End Class

@@ -1180,6 +1184,8 @@ ExitDataLoad:
            Return "2024 | 毒马铃薯一直都被大家忽视和低估，于是我们超级加强了它！"
        ElseIf Name = "25w14craftmine" Then
            Return "2025 | 你可以合成任何东西——包括合成你的世界！"
+        ElseIf Name = "26w14a" Then
+            Return "2026 | 为什么需要物品栏？让方块们跟着你走吧！"
        Else
            Return ""
        End If
@@ -166,7 +166,7 @@ EndHint:
        Public Text As String
        ''' <summary>
        ''' 输入模式：文本框的文本。
-        ''' 选择模式：需要放进去的 List(Of MyListItem)。
+        ''' 选择模式：需要放进去的 IEnumberable(Of IMyRadio)。
        ''' 登录模式：登录步骤 1 中返回的 JSON。
        ''' </summary>
        Public Content As Object
@@ -308,7 +308,7 @@ EndHint:
    ''' <param name="Button1">显示的第一个按钮，默认为 “确定”。</param>
    ''' <param name="Button2">显示的第二个按钮，默认为空。</param>
    ''' <param name="IsWarn">是否为警告弹窗，若为 True，弹窗配色和背景会变为红色。</param>
-    Public Function MyMsgBoxSelect(Selections As List(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
+    Public Function MyMsgBoxSelect(Selections As IEnumerable(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
        '将弹窗列入队列
        Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
        WaitingMyMsgBox.Add(Converter)
@@ -78,9 +78,9 @@ Friend Module ModSecret
            If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
                Req.Headers.Add("User-Agent", "LogStatistic")  '#4951
            ElseIf SimulateBrowserHeaders Then
-                Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
+                Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
            Else
-                Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
+                Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode}")
            End If
        End If
        If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")