2.12.2

2026-01-15 03:20:43 +08:00
parent 87f5cc2ea9
commit 52b4c87fbc
24 changed files with 530 additions and 2212 deletions
@@ -743,9 +743,9 @@ Public Module ModAnimation
    ''' <param name="AniGroup">由 Aa 开头的函数初始化的 AniData 对象集合。</param>
    ''' <param name="Name">动画组的名称。如果重复会直接停止同名动画组。</param>
    Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False)
-        If RefreshTime Then AniLastTick = GetTimeTick() '避免处理动画时已经造成了极大的延迟，导致动画突然结束
+        If RefreshTime Then AniLastTick = GetTimeMs() '避免处理动画时已经造成了极大的延迟，导致动画突然结束
        '添加到正在执行的动画组
-        Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeTick()}
+        Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeMs()}
        If Name = "" Then
            Name = NewEntry.Uuid
        Else
@@ -788,7 +788,7 @@ Public Module ModAnimation
    ''' </summary>
    Public Sub AniStart()
        '初始化计时器
-        AniLastTick = GetTimeTick()
+        AniLastTick = GetTimeMs()
        AniFPSTimer = AniLastTick
        AniRunning = True '标记动画执行开始

@@ -798,9 +798,9 @@ Public Module ModAnimation
                Log("[Animation] 动画线程开始")
                Do While True
                    '两帧之间的间隔时间
-                    Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
+                    Dim DeltaTime As Long = MathClamp(GetTimeMs() - AniLastTick, 0, 100000)
                    If DeltaTime < 3 Then GoTo Sleeper
-                    AniLastTick = GetTimeTick()
+                    AniLastTick = GetTimeMs()
                    '记录 FPS
                    If ModeDebug Then
                        If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
@@ -14,13 +14,13 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.12.1" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.12.1." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.12.2" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.12.2." & VersionBranchCode '标准格式的四段式版本号
    Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
-    Public Const VersionCode As Integer = 372 'Release
+    Public Const VersionCode As Integer = 379 'Release
 #Else
-    Public Const VersionCode As Integer = 378 'Snapshot
+    Public Const VersionCode As Integer = 380 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -62,7 +62,7 @@ Public Module ModBase
    ''' <summary>
    ''' 程序的打开计时。
    ''' </summary>
-    Public ApplicationStartTick As Long = GetTimeTick()
+    Public ApplicationStartTick As Long = GetTimeMs()
    ''' <summary>
    ''' 程序打开时的时间。
    ''' </summary>
@@ -1284,27 +1284,31 @@ Re:
    ''' <summary>
    ''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。
    ''' 会尝试创建，但不会清空目标文件夹。
+    ''' 会先使用 UTF-8 解压，失败后换用 GB18030 解压。
    ''' </summary>
-    Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing,
-                           Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
+    Public Sub ExtractCompressedFile(CompressFilePath As String, DestDirectory As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
        Directory.CreateDirectory(DestDirectory)
+        '解压 gz（gz 不需要考虑编码）
        If CompressFilePath.EndsWithF(".gz", True) Then
-            '以 gz 方式解压
-            Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
-            Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
-            Dim data As Integer = stream.ReadByte()
-            While data <> -1
-                decompressedFile.WriteByte(data)
-                data = stream.ReadByte()
-            End While
-            decompressedFile.Close()
-            stream.Close()
-        Else
-            '以 zip 方式解压
-            Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
-                Dim TotalCount As Long = Archive.Entries.Count
-                For Each Entry As ZipArchiveEntry In Archive.Entries
-                    If ProgressIncrementHandler IsNot Nothing AndAlso TotalCount > 0 Then ProgressIncrementHandler(1 / TotalCount)
+            Using stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.Read, FileShare.Read), CompressionMode.Decompress)
+                Using decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""),
+                                                         FileMode.OpenOrCreate, FileAccess.Write)
+                    Dim data As Integer = stream.ReadByte()
+                    While data <> -1
+                        decompressedFile.WriteByte(data)
+                        data = stream.ReadByte()
+                    End While
+                End Using
+            End Using
+            Return
+        End If
+        '解压 zip
+        Dim TryExtractZip =
+        Sub(Encoding As Encoding)
+            Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, Encoding)
+                Dim EntryCount = Archive.Entries.Count
+                For Each Entry In Archive.Entries
+                    If ProgressIncrementHandler IsNot Nothing AndAlso EntryCount > 0 Then ProgressIncrementHandler(1 / EntryCount)
                    Dim DestinationFullPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
                    If Not IO.Path.GetFullPath(DestinationFullPath).StartsWithF(IO.Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复
                    If DestinationFullPath.EndsWithF("\") OrElse DestinationFullPath.EndsWithF("/") Then Continue For '不创建空文件夹
@@ -1313,7 +1317,17 @@ Re:
                    Entry.ExtractToFile(DestinationFullPath.Replace(DestinationDirectory, ShortenPath(DestinationDirectory)), True) '#7329
                Next
            End Using
-        End If
+        End Sub
+        Try
+            TryExtractZip(Encoding.UTF8)
+        Catch ex As Exception
+            Log(ex, $"首次解压尝试失败，将更换编码并重试（{CompressFilePath} → {DestDirectory}）")
+            Try
+                TryExtractZip(Encoding.GetEncoding("GB18030"))
+            Catch
+                Throw
+            End Try
+        End Try
    End Sub

    ''' <summary>
@@ -1609,6 +1623,7 @@ RetryDir:
    End Function
    ''' <summary>
    ''' 分割字符串。
+    ''' 若原始字符串为空，则返回 {""}。
    ''' </summary>
    <Extension> Public Function Split(FullStr As String, SplitStr As String) As String()
        If SplitStr.Length = 1 Then
@@ -2297,10 +2312,10 @@ NextElement:
        Return Date.Now.ToString("HH':'mm':'ss'.'fff")
    End Function
    ''' <summary>
-    ''' 获取系统运行时间（毫秒），保证为正 Long 且大于 1，但可能突变减小。
+    ''' 获取一个单调递增时间值（毫秒）。
    ''' </summary>
-    Public Function GetTimeTick() As Long
-        Return My.Computer.Clock.TickCount + 2147483651L
+    Public Function GetTimeMs() As Long
+        Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
    End Function
    ''' <summary>
    ''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
@@ -295,7 +295,7 @@

            If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
               (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
-               LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
+               LastFinishedTime = 0 OrElse GetTimeMs() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
                Return False '…则不重试
            Else
                Return True '否则需要重启
@@ -328,7 +328,7 @@
                    If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
                    RaisePreviewFinish()
                    State = LoadState.Finished
-                    LastFinishedTime = GetTimeTick() '未中断，本次输出有效
+                    LastFinishedTime = GetTimeMs() '未中断，本次输出有效
                Catch ex As CancelledException
                    If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
                    If Not IsAborted Then State = LoadState.Aborted
@@ -52,7 +52,7 @@ Public Module ModNet
            Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False) As String
        Dim RetryCount As Integer = 0
        Dim RetryException As Exception = Nothing
-        Dim StartTime As Long = GetTimeTick()
+        Dim StartTime As Long = GetTimeMs()
        Try
 Retry:
            Select Case RetryCount
@@ -62,7 +62,7 @@ Retry:
                    Thread.Sleep(500)
                    Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 30000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
                Case Else '快速重试
-                    If GetTimeTick() - StartTime > 5500 Then
+                    If GetTimeMs() - StartTime > 5500 Then
                        '若前两次加载耗费 5 秒以上，才进行重试
                        Thread.Sleep(500)
                        Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 4000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
@@ -586,7 +586,7 @@ RequestFinished:
        ''' <summary>
        ''' 上次记速时的时间。
        ''' </summary>
-        Private SpeedLastTime As Long = GetTimeTick()
+        Private SpeedLastTime As Long = GetTimeMs()
        ''' <summary>
        ''' 上次记速时的已下载大小。
        ''' </summary>
@@ -596,8 +596,8 @@ RequestFinished:
        ''' </summary>
        Public ReadOnly Property Speed As Long
            Get
-                If GetTimeTick() - SpeedLastTime > 200 Then
-                    Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime
+                If GetTimeMs() - SpeedLastTime > 200 Then
+                    Dim DeltaTime As Long = GetTimeMs() - SpeedLastTime
                    _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
                    SpeedLastDone = DownloadDone
                    SpeedLastTime += DeltaTime
@@ -610,7 +610,7 @@ RequestFinished:
        ''' <summary>
        ''' 线程初始化时的时间。
        ''' </summary>
-        Public InitTime As Long = GetTimeTick()
+        Public InitTime As Long = GetTimeMs()
        ''' <summary>
        ''' 上次接受到有效数据的时间，-1 表示尚未有有效数据。
        ''' </summary>
@@ -773,7 +773,7 @@ RequestFinished:
        ''' <summary>
        ''' 上次记速时的时间。
        ''' </summary>
-        Private SpeedLastTime As Long = GetTimeTick()
+        Private SpeedLastTime As Long = GetTimeMs()
        ''' <summary>
        ''' 上次记速时的已下载大小。
        ''' </summary>
@@ -783,8 +783,8 @@ RequestFinished:
        ''' </summary>
        Public ReadOnly Property Speed As Long
            Get
-                If GetTimeTick() - SpeedLastTime > 200 Then
-                    Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime
+                If GetTimeMs() - SpeedLastTime > 200 Then
+                    Dim DeltaTime As Long = GetTimeMs() - SpeedLastTime
                    _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
                    SpeedLastDone = DownloadDone
                    SpeedLastTime += DeltaTime
@@ -1079,7 +1079,7 @@ NotSupportRange:
                    SyncLock NetTaskSpeedLimitLeftLock
                        If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
                    End SyncLock
-                    Dim DeltaTime = GetTimeTick() - Th.LastReceiveTime
+                    Dim DeltaTime = GetTimeMs() - Th.LastReceiveTime
                    If DeltaTime > 1000000 Then DeltaTime = 1 '避免时间刻反转导致出现极大值
                    If RealDataCount > 0 Then
                        '有数据
@@ -1091,7 +1091,7 @@ NotSupportRange:
                            End SyncLock
                            SyncLock LockCount
                                ConnectCount += 1
-                                ConnectTime += GetTimeTick() - Th.InitTime
+                                ConnectTime += GetTimeMs() - Th.InitTime
                            End SyncLock
                        End If
                        SyncLock LockCount
@@ -1113,7 +1113,7 @@ NotSupportRange:
                                    Th.Source.SingleThread Is Nothing Then '且并非单线程下载
                            Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。")
                        End If
-                        Th.LastReceiveTime = GetTimeTick()
+                        Th.LastReceiveTime = GetTimeMs()
                    ElseIf Th.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
                        '无数据，且已超时
                        Throw New TimeoutException("操作超时，无数据。")
@@ -1346,6 +1346,7 @@ Retry:
                If State >= NetState.Finished Then Return
                If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
                '凉凉
+                Log($"[Download] {LocalName}：已失败，当前状态 {State}")
                State = NetState.Interrupted
            End SyncLock
            AbortInternal()
@@ -1363,6 +1364,7 @@ Retry:
            '确认中断
            SyncLock LockState
                If State >= NetState.Finished Then Return
+                Log($"[Download] {LocalName}：已中断，当前状态 {State}")
                State = NetState.Interrupted
            End SyncLock
            AbortInternal()
@@ -1373,7 +1375,6 @@ Retry:
            SyncLock NetManager.LockRemain
                NetManager.FileRemain -= 1
            End SyncLock
-            Log($"[Download] {LocalName}：已终止，当前状态 {State}")
        End Sub

        '状态改变接口
@@ -1584,14 +1585,8 @@ FinishExCatch:
                For Each File As NetFile In Files
                    Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File)
                    If File.State >= NetState.WaitingToDownload Then Return '中断
-                    If Target Is Nothing Then
-                        '未找到相同文件
-                        SyncLock LockState
-                            File.State = NetState.WaitingToDownload
-                            File.IsCopy = False
-                        End SyncLock
-                    Else
-                        '已找到相同文件
+                    '已找到相同文件
+                    If Target IsNot Nothing Then
                        File.IsCopy = True
                        Dim RetryCount As Integer = 0
 Retry:
@@ -1601,20 +1596,21 @@ Retry:
                                CopyFile(Target, File.LocalPath)
                            End If
                            File.Finish(False)
+                            Continue For
                        Catch ex As Exception
                            RetryCount += 1
                            Log(ex, $"复制已存在的文件失败，第 {RetryCount} 次重试（{Target} → {File.LocalPath}）")
                            If RetryCount < 3 Then
-                                Thread.Sleep(200)
+                                Thread.Sleep(2000)
                                GoTo Retry
                            End If
-                            '失败，回退到下载
-                            SyncLock LockState
-                                File.State = NetState.WaitingToDownload
-                                File.IsCopy = False
-                            End SyncLock
                        End Try
                    End If
+                    '回退到下载
+                    SyncLock LockState
+                        File.State = NetState.WaitingToDownload
+                        File.IsCopy = False
+                    End SyncLock
                Next
            Catch ex As Exception
                OnFail(New List(Of Exception) From {New Exception("下载已存在文件查找失败", ex)})
@@ -1639,6 +1635,7 @@ Retry:
            End If
            Dim Type = TypeIndexes.MaxOf(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
            '根据类别进行查找
+            Static Sizes As New SafeDictionary(Of String, Long)
            Select Case Type
                Case "assets\", "libraries\"
                    'assets/libraries：查找 MC 文件夹下的相同路径
@@ -1651,6 +1648,10 @@ Retry:
                    For Each VersionFolder In VersionFolders
                        For Each Candidate In Directory.GetFiles(VersionFolder,
                            "*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").ToLower, SearchOption.TopDirectoryOnly)
+                            '快速进行大小校验
+                            If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
+                            If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
+                            'Hash 校验
                            If File.Check.Check(Candidate) Is Nothing Then Return Candidate
                        Next
                    Next
@@ -1662,7 +1663,6 @@ Retry:
                        If Not Directory.Exists(TargetFolder) Then Continue For
                        For Each Candidate In Directory.GetFiles(TargetFolder)
                            '快速进行大小校验
-                            Static Sizes As New SafeDictionary(Of String, Long)
                            If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
                            If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
                            'Hash 校验
@@ -1803,7 +1803,7 @@ Retry:
        ''' </summary>
        Private Sub RefreshStat()
            Try
-                Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
+                Dim DeltaTime As Long = GetTimeMs() - RefreshStatLast
                If DeltaTime = 0 Then Return
                RefreshStatLast += DeltaTime
 #Region "刷新整体速度"
@@ -1905,7 +1905,7 @@ Retry:
            RunInNewThread(
            Sub()
                Try
-                    Dim NextTick As Long = GetTimeTick()
+                    Dim NextTick As Long = GetTimeMs()
                    While True
                        '增加限速余量
                        If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 10
@@ -1913,11 +1913,11 @@ Retry:
                        RefreshStat()
                        '等待 100 ms
                        NextTick += 100
-                        Dim SleepTime = NextTick - GetTimeTick()
+                        Dim SleepTime = NextTick - GetTimeMs()
                        If SleepTime > 0 Then
                            Thread.Sleep(SleepTime)
                        Else
-                            NextTick = GetTimeTick() '超时，直接追帧，不等待
+                            NextTick = GetTimeMs() '超时，直接追帧，不等待
                        End If
                    End While
                Catch ex As Exception
@@ -72,7 +72,7 @@ Public Class MyBitmap
                End If
            Else
                '使用这种自己接管 FileStream 的方法加载才能解除文件占用
-                Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
+                Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open, FileAccess.Read, FileShare.Read)
                    '判断是否为 WebP 文件头
                    Dim Header(1) As Byte
                    InputStream.Read(Header, 0, 2)