2.7.3

2024-05-16 21:06:03 +08:00
parent a84601d99c
commit 67d830ea29
13 changed files with 2455 additions and 1441 deletions
@@ -19,18 +19,14 @@ Public Class Application

    '开始
    Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
-        SecretOnApplicationStart()
        Try
+            SecretOnApplicationStart()
            '检查参数调用
            If e.Args.Length > 0 Then
                If e.Args(0) = "--update" Then
                    '自动更新
                    UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
                    Environment.Exit(Result.Cancel)
-                    'ElseIf e.Args(0).StartsWithF("--link") Then
-                    '    '稍作等待后切换到联机页面
-                    '    Thread.Sleep(1000)
-                    '    FormMain.IsLinkRestart = True
                ElseIf e.Args(0).StartsWithF("--memory") Then
                    '内存优化
                    Dim Ram = My.Computer.Info.AvailablePhysicalMemory
@@ -129,7 +125,12 @@ Public Class Application
 #End If
            AniControlEnabled += 1
        Catch ex As Exception
-            MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL 初始化错误")
+            Dim FilePath As String = Nothing
+            Try
+                FilePath = PathWithName
+            Catch
+            End Try
+            MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径：" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
            FormMain.EndProgramForce(Result.Exception)
        End Try
    End Sub
@@ -130,7 +130,7 @@
                                                                    FrmDownloadInstall.MinecraftSelected(sender, e)
                                                                End Sub, False))
                Case 8
-                    If Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <>
+                    If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
                       CType(Stack.Tag, List(Of CompFile)).Count Then
                        '存在重复的名称（#1344）
                        Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
@@ -139,7 +139,7 @@
                        Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
                    End If
                Case 9
-                    If Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <>
+                    If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
                       CType(Stack.Tag, List(Of CompFile)).Count Then
                        '存在重复的名称（#1344）
                        Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
@@ -10,6 +10,14 @@ Public Class FormMain
        Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
        '统计更新日志条目
 #If BETA Then
+        If LastVersion < 323 Then 'Release 2.7.3
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
+            FeatureCount += 22
+            BugCount += 21
+        End If
        If LastVersion < 321 Then 'Release 2.7.1
            FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
            BugCount += 1
@@ -100,6 +108,10 @@ Public Class FormMain
        '3：BUG+ IMP* FEAT-
        '2：BUG* IMP-
        '1：BUG-
+        If LastVersion < 324 Then 'Snapshot 2.7.3
+            FeatureCount += 4
+            BugCount += 3
+        End If
        If LastVersion < 322 Then 'Snapshot 2.7.2
            FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
            FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
@@ -241,7 +253,7 @@ Public Class FormMain
        Next
        If SortedFeatures.Count > 10 Then FeatureCount += SortedFeatures.Count - 10
        If FeatureCount > 0 OrElse BugCount > 0 Then
-            ContentList.Add(If(FeatureCount > 0, "其他 " & FeatureCount & " 项小调整与修改", "") &
+            ContentList.Add(If(FeatureCount > 0, FeatureCount & " 项小调整与修改", "") &
                If(FeatureCount > 0 AndAlso BugCount > 0, "，", "") &
                If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
                "，详见完整更新日志")
@@ -11,12 +11,12 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.7.2" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.7.2." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.7.3" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.7.3." & VersionBranchCode '标准格式的四段式版本号
 #If BETA Then
-    Public Const VersionCode As Integer = 321 'Release
+    Public Const VersionCode As Integer = 323 'Release
 #Else
-    Public Const VersionCode As Integer = 322 'Snapshot
+    Public Const VersionCode As Integer = 324 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1817,15 +1817,11 @@ Re:
    ''' <summary>
    ''' 数组去重。
    ''' </summary>
-    Public Function Distinct(Of T)(Arr As ICollection(Of T), Optional IsEqual As CompareThreadStart(Of T) = Nothing) As List(Of T)
+    <Extension> Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As CompareThreadStart(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
-                If IsEqual Is Nothing Then
-                    If Arr(i).Equals(Arr(ii)) Then GoTo NextElement
-                Else
                If IsEqual(Arr(i), Arr(ii)) Then GoTo NextElement
-                End If
            Next
            ResultArray.Add(Arr(i))
 NextElement:
@@ -2073,7 +2069,7 @@ NextElement:
    ''' 按照既定的函数进行选择排序。
    ''' </summary>
    ''' <param name="SortRule">传入两个对象，若第一个对象应该排在前面，则返回 True。</param>
-    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 CompareThreadStart(Of T)) As List(Of T)
        Dim NewList As New List(Of T)
        While List.Any
            Dim Highest = List(0)
@@ -517,7 +517,7 @@ RequestFinished:
        ''' </summary>
        Finish = 6
        ''' <summary>
-        ''' 已失败。
+        ''' 已失败或中断。
        ''' </summary>
        [Error] = 7
    End Enum
@@ -1035,6 +1035,7 @@ StartThread:
                SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent)
                Dim ContentLength As Long = 0
                Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
+                    If State = NetState.Error Then GoTo SourceBreak '快速中断
                    If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then
                        Log($"[Download] {LocalName} {Info.Uuid}#：重定向至 {HttpResponse.ResponseUri.OriginalString}")
                    End If
@@ -1379,14 +1380,7 @@ Retry:
                '凉凉
                State = NetState.Error
            End SyncLock
-            Try
-                If File.Exists(LocalPath) Then File.Delete(LocalPath)
-            Catch
-            End Try
-            SyncLock NetManager.LockRemain
-                NetManager.FileRemain -= 1
-                Log("[Download] " & LocalName & "：已失败，剩余文件 " & NetManager.FileRemain)
-            End SyncLock
+            InterruptAndDelete()
            For Each Task In Tasks
                Task.OnFileFail(Me)
            Next
@@ -1395,7 +1389,7 @@ Retry:
        ''' 下载中断。
        ''' </summary>
        Public Sub Abort(CausedByTask As LoaderDownload)
-            '确认任务移除
+            '从特定任务中移除，如果它还属于其他任务，则继续下载
            SyncLock LockTasks
                Tasks.Remove(CausedByTask)
                If Tasks.Any Then Exit Sub
@@ -1405,9 +1399,14 @@ Retry:
                If State >= NetState.Finish Then Exit Sub
                State = NetState.Error
            End SyncLock
+            InterruptAndDelete()
+        End Sub
+        Private Sub InterruptAndDelete()
+            On Error Resume Next
+            If File.Exists(LocalPath) Then File.Delete(LocalPath)
            SyncLock NetManager.LockRemain
                NetManager.FileRemain -= 1
-                If ModeDebug Then Log("[Download] " & LocalName & "：已取消，剩余文件 " & NetManager.FileRemain)
+                Log($"[Download] {LocalName}：状态 {State}，剩余文件 {NetManager.FileRemain}")
            End SyncLock
        End Sub

@@ -593,7 +593,7 @@
                '添加后缀
                If Suffix <> "" Then SubtitleList.Add(Suffix)
            End If
-            SubtitleList = SubtitleList.Distinct().ToList()
+            SubtitleList = SubtitleList.Distinct.ToList()
            '设置标题与描述
            Dim Subtitle As String = ""
            If SubtitleList.Any Then
@@ -1046,7 +1046,7 @@ Retry:
        '这样做的话，去重后将优先保留 CurseForge 内容（考虑到 CurseForge 热度更高）
        RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
        'RawResults 去重
-        RawResults = Distinct(RawResults, Function(a, b) a.IsLike(b))
+        RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
        '已有内容去重
        RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
                                                  Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
@@ -1444,8 +1444,8 @@ Retry:
            'Modrinth
            ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True)
        End If
-        CompFilesCache(ProjectId) = Distinct(ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
-            Where(Function(a) a.Available).ToList, Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330）
+        CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
+            Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330）
        '获取前置 Mod 列表
        If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
        Dim Deps As List(Of String) = CompFilesCache(ProjectId).
@@ -98,6 +98,11 @@
                    TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
                    BackAssetsFile.LocalPath = TempAddress
                    Task.Output = New List(Of NetFile) From {BackAssetsFile}
+                    '检查是否需要更新：每天只更新一次
+                    If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
+                        Log("[Download] 无需更新资源文件索引")
+                        Task.Abort()
+                    End If
                End Sub))
                LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
                LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
@@ -106,7 +111,7 @@
                    McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
                End Sub))
                Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
-                Log("[Download] 开始后台更新资源文件索引")
+                Log("[Download] 开始后台检查资源文件索引")
                Updater.Start()
            End If
            '获取资源文件地址
@@ -567,7 +567,7 @@ NoUserJava:

            '确保可用并获取详细信息，转入正式列表
            Dim NewJavaList As New List(Of JavaEntry)
-            For Each Entry In Distinct(JavaPreList.ToList, Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
+            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)
@@ -719,12 +719,25 @@ Wait:
    ''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
    ''' </summary>
    Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
-        Return New LoaderCombo(Of Integer)($"下载 Java {Version}", {
+        Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10}
+        Dim Loader = New LoaderCombo(Of Integer)($"下载 Java {Version}", {
            New LoaderTask(Of Integer, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
-            New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10},
+            JavaDownloadLoader,
            JavaSearchLoader
        })
+        AddHandler JavaDownloadLoader.OnStateChangedThread,
+        Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
+            If (NewState = LoadState.Failed OrElse NewState = LoadState.Aborted) AndAlso LastJavaBaseDir IsNot Nothing Then
+                Log($"[Java] 由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}", LogLevel.Debug)
+                DeleteDirectory(LastJavaBaseDir)
+            ElseIf NewState = LoadState.Finished Then
+                LastJavaBaseDir = Nothing
+            End If
+        End Sub
+        JavaDownloadLoader.HasOnStateChangedThread = True
+        Return Loader
    End Function
+    Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java
    Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
        Log("[Java] 开始获取 Java 下载信息")
        Dim IndexFileStr As String = NetGetCodeByDownload(
@@ -739,25 +752,23 @@ Wait:
        Dim Address As String = TargetEntry.Value("manifest")("url")
        Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}（{TargetEntry.Key}）：{Address}")
        '获取文件列表
-        Dim ListFileStr As String = NetGetCodeByDownload(
-            {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"),
-             Address},
-        IsJson:=True)
-        Dim BaseDir As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
+        Dim ListFileStr As String = NetGetCodeByDownload({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
+        LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
        Dim Results As New List(Of NetFile)
        For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
            If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For
            Dim Info As JObject = CType(File.Value, JObject)("downloads")("raw")
            Dim Checker As New FileChecker(ActualSize:=Info("size"), Hash:=Info("sha1"))
-            If Checker.Check(BaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
+            If Checker.Hash = "12976a6c2b227cbac58969c1455444596c894656" OrElse Checker.Hash = "c80e4bab46e34d02826eab226a4441d0970f2aba" OrElse Checker.Hash = "84d2102ad171863db04e7ee22a259d1f6c5de4a5" Then
+                '跳过 3 个无意义大量重复文件（#3827）
+                Continue For
+            End If
+            If Checker.Check(LastJavaBaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
            Dim Url As String = Info("url")
-            Results.Add(New NetFile(
-                            {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"),
-                             Url},
-                        BaseDir & File.Name, Checker))
+            Results.Add(New NetFile({Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"), Url}, LastJavaBaseDir & File.Name, Checker))
        Next
        Loader.Output = Results
-        Log($"[Java] 需要下载 {Results.Count} 个文件，目标文件夹：{BaseDir}")
+        Log($"[Java] 需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}")
    End Sub

 #End Region
@@ -1192,12 +1192,10 @@ SystemBrowser:
            If Not JavaDownloadConfirm("Java 7") Then Throw New Exception("$$")
        ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
            JavaCode = "8u101"
-            JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True)
-            Throw New Exception("$$")
+            If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$")
        ElseIf MinVer > New Version(1, 8, 0, 100) Then
            JavaCode = "8u101"
-            JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True)
-            Throw New Exception("$$")
+            If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$")
        ElseIf MaxVer < New Version(1, 8, 0, 321) Then
            JavaCode = 8
            If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
@@ -1208,11 +1206,15 @@ SystemBrowser:

        '开始自动下载
        Dim JavaLoader = JavaFixLoaders(JavaCode)
+        Try
            JavaLoader.Start(JavaCode, IsForceRestart:=True)
            Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
                Task.Progress = JavaLoader.Progress
                Thread.Sleep(10)
            Loop
+        Finally
+            JavaLoader.Abort() '确保取消时中止 Java 下载
+        End Try

        '检查下载结果
        If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
@@ -2001,7 +2001,7 @@ NextVersion:
            Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker))
        Next
        '去重并返回
-        Return Distinct(Result, Function(a, b) a.LocalPath = b.LocalPath)
+        Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
    End Function
    ''' <summary>
    ''' 获取对应的支持库文件地址。
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
 ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
 ' 方法是按如下所示使用“*”

-<Assembly: AssemblyVersion("2.7.2.0")>
-<Assembly: AssemblyFileVersion("2.7.2.0")>
+<Assembly: AssemblyVersion("2.7.3.0")>
+<Assembly: AssemblyFileVersion("2.7.3.0")>
 <Assembly: NeutralResourcesLanguage("")>
@@ -389,10 +389,14 @@ Public Module ModDownloadLib
            If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java，已取消安装。")
            '开始自动下载
            Dim JavaLoader = JavaFixLoaders(17)
+            Try
                JavaLoader.Start(17, IsForceRestart:=True)
                Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
                    Thread.Sleep(10)
                Loop
+            Finally
+                JavaLoader.Abort() '确保取消时中止 Java 下载
+            End Try
            '检查下载结果
            Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
            If Task.IsAborted Then Exit Sub
@@ -1112,10 +1116,14 @@ Retry:
            If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java，已取消安装。")
            '开始自动下载
            Dim JavaLoader = JavaFixLoaders(17)
+            Try
                JavaLoader.Start(17, IsForceRestart:=True)
                Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
                    Thread.Sleep(10)
                Loop
+            Finally
+                JavaLoader.Abort() '确保取消时中止 Java 下载
+            End Try
            '检查下载结果
            Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
            If Task.IsAborted Then Exit Sub