Merge branch 'Hex-Dragon:main' into main

2024-07-11 21:10:19 +08:00
parent 2b55ed078b 5436c5ec8a
commit eaebd04bbb
15 changed files with 130 additions and 108 deletions
@@ -11,12 +11,12 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.8.1" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.8.1." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.8.2" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.8.2." & VersionBranchCode '标准格式的四段式版本号
 #If BETA Then
-    Public Const VersionCode As Integer = 326 'Release
+    Public Const VersionCode As Integer = 330 'Release
 #Else
-    Public Const VersionCode As Integer = 328 'Snapshot
+    Public Const VersionCode As Integer = 329 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -86,7 +86,7 @@ Public Module ModBase
    ''' <summary>
    ''' 系统盘盘符，以 \ 结尾。例如 “C:\”。
    ''' </summary>
-    Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\"
+    Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
    ''' <summary>
    ''' 程序的缓存文件夹路径，以 \ 结尾。
    ''' </summary>
@@ -1257,12 +1257,19 @@ Re:
        Dim DeletedCount As Integer = 0
        Dim Temp As String()
        Temp = Directory.GetFiles(Path)
-        For Each str As String In Temp
+        For Each FilePath As String In Temp
+            Dim RetriedFile As Boolean = False
+RetryFile:
            Try
-                File.Delete(str)
+                File.Delete(FilePath)
                DeletedCount += 1
            Catch ex As Exception
-                If IgnoreIssue Then
+                If Not RetriedFile Then
+                    RetriedFile = True
+                    Log(ex, $"删除文件失败，将在 0.3s 后重试（{FilePath}）")
+                    Thread.Sleep(300)
+                    GoTo RetryFile
+                ElseIf IgnoreIssue Then
                    Log(ex, "删除单个文件可忽略地失败")
                Else
                    Throw
@@ -1273,10 +1280,17 @@ Re:
        For Each str As String In Temp
            DeleteDirectory(str, IgnoreIssue)
        Next
+        Dim RetriedDir As Boolean = False
+RetryDir:
        Try
            Directory.Delete(Path, True)
        Catch ex As Exception
-            If IgnoreIssue Then
+            If Not RetriedDir Then
+                RetriedDir = True
+                Log(ex, $"删除文件夹失败，将在 0.3s 后重试（{Path}）")
+                Thread.Sleep(300)
+                GoTo RetryDir
+            ElseIf IgnoreIssue Then
                Log(ex, "删除单个文件夹可忽略地失败")
            Else
                Throw
@@ -1652,7 +1666,10 @@ Re:
    ''' 为字符串进行 XML 转义。
    ''' </summary>
    Public Function EscapeXML(Str As String) As String
-        Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
+        If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
+        Return Str.
+            Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
+            Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
    End Function

    '正则
@@ -629,19 +629,19 @@ NoSubtitle:
            If Id = Project.Id Then Return True '相同实例
            '提取字符串中的字母和数字
            Dim GetRaw =
-                Function(Data As String) As String
-                    Dim Result As New StringBuilder()
-                    For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
-                        Result.Append(r)
-                    Next
-                    Return Result.ToString.ToLower
-                End Function
+            Function(Data As String) As String
+                Dim Result As New StringBuilder()
+                For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
+                    Result.Append(r)
+                Next
+                Return Result.ToString.ToLower
+            End Function
            '来自不同的网站
            If FromCurseForge = Project.FromCurseForge Then Return False
            'Mod 加载器一致
-            If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
+            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).Count > 0 Then Return False
+            If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
            'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
            If TranslatedName = Project.TranslatedName OrElse
               RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -8,9 +8,13 @@
    ''' </summary>
    Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
        '获取底层继承版本
-        Do While Not String.IsNullOrEmpty(Version.InheritVersion)
-            Version = New McVersion(Version.InheritVersion)
-        Loop
+        Try
+            Do While Not String.IsNullOrEmpty(Version.InheritVersion)
+                Version = New McVersion(Version.InheritVersion)
+            Loop
+        Catch ex As Exception
+            Log(ex, "获取底层继承版本失败")
+        End Try
        '检查 Json 是否标准
        If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
            Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
@@ -610,7 +614,9 @@
    Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
        Dim Result As String
        Try
-            Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
+            Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
+                                          Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057
+                                          ".html", UseBrowserUserAgent:=True)
        Catch ex As Exception
            If GetExceptionSummary(ex).Contains("(404)") Then
                Throw New Exception("没有可用版本")
@@ -679,7 +685,9 @@
    ''' Forge 版本列表，BMCLAPI。
    ''' </summary>
    Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
-        Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
+        Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
+                                                      Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4，#4057
+                                                      IsJson:=True)
        Dim Versions As New List(Of DlForgeVersionEntry)
        Try
            Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -1278,7 +1278,9 @@ SystemBrowser:
    Public Function ExtractJavaWrapper() As String
        Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
        SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
-            WriteFile(WrapperPath, GetResources("JavaWrapper"))
+            If Not WriteFile(WrapperPath, GetResources("JavaWrapper")) Then
+                Throw New FileNotFoundException("释放 Java Wrapper 失败")
+            End If
        End SyncLock
        Log("[Java] 已释放 Java Wrapper：" & WrapperPath)
        Return WrapperPath
@@ -25,6 +25,7 @@ Public Module ModModpack
                Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
                '从根目录判断整合包类型
                If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
+                If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
                If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
                If Archive.GetEntry("manifest.json") IsNot Nothing Then
                    Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
@@ -35,7 +36,6 @@ Public Module ModModpack
                    End If
                End If
                If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
-                If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
                '从一级目录判断整合包类型
                For Each Entry In Archive.Entries
                    Dim FullNames As String() = Entry.FullName.Split("/")
@@ -21,26 +21,28 @@
                    OpenWebsite(Data(0))

                Case "打开文件", "打开帮助"
-                    RunInThread(Sub()
-                                    Try
-                                        '确认实际路径
-                                        Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
-                                        Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
-                                        '执行
-                                        If Type = "打开文件" Then
-                                            Dim Info As New ProcessStartInfo With {
-                                                .Arguments = If(Data.Length >= 2, Data(1), ""),
-                                                .FileName = Location,
-                                                .WorkingDirectory = WorkingDir
-                                            }
-                                            Process.Start(Info)
-                                        Else '打开帮助
-                                            PageOtherHelp.EnterHelpPage(Location)
-                                        End If
-                                    Catch ex As Exception
-                                        Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
-                                    End Try
-                                End Sub)
+                    RunInThread(
+                    Sub()
+                        Try
+                            '确认实际路径
+                            Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
+                            Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
+                            Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
+                            '执行
+                            If Type = "打开文件" Then
+                                Dim Info As New ProcessStartInfo With {
+                                    .Arguments = If(Data.Length >= 2, Data(1), ""),
+                                    .FileName = Location,
+                                    .WorkingDirectory = WorkingDir
+                                }
+                                Process.Start(Info)
+                            Else '打开帮助
+                                PageOtherHelp.EnterHelpPage(Location)
+                            End If
+                        Catch ex As Exception
+                            Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
+                        End Try
+                    End Sub)

                Case "启动游戏"
                    If Data(0) = "\current" Then