2.7.3

2024-05-16 21:06:03 +08:00
parent a84601d99c
commit 67d830ea29
13 changed files with 2455 additions and 1441 deletions
@@ -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
+                If IsEqual(Arr(i), Arr(ii)) Then GoTo NextElement
            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)
-        JavaLoader.Start(JavaCode, IsForceRestart:=True)
-        Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
-            Task.Progress = JavaLoader.Progress
-            Thread.Sleep(10)
-        Loop
+        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>
    ''' 获取对应的支持库文件地址。