2.8.7

2024-09-24 17:04:14 +08:00
parent 30bc43bdb5
commit b5c9736918
39 changed files with 932 additions and 747 deletions
@@ -1,4 +1,5 @@
-Imports System.IO.Compression
+Imports System.Globalization
+Imports System.IO.Compression
 Imports System.Runtime.CompilerServices
 Imports System.Security.Cryptography
 Imports System.Security.Principal
@@ -11,13 +12,13 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.8.6" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.8.6." & VersionBranchCode '标准格式的四段式版本号
-    Public Const CommitHash As String = "" 'Commit Hash
+    Public Const VersionBaseName As String = "2.8.7" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.8.7." & VersionBranchCode '标准格式的四段式版本号
+    Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
    Public Const VersionCode As Integer = 336 'Release
 #Else
-    Public Const VersionCode As Integer = 335 'Snapshot
+    Public Const VersionCode As Integer = 337 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -65,7 +66,7 @@ Public Module ModBase
    ''' </summary>
    Public ApplicationOpenTime As Date = Date.Now
    ''' <summary>
-    ''' 设备唯一标识符。
+    ''' 识别码。
    ''' </summary>
    Public UniqueAddress As String = SecretGetUniqueAddress()
    ''' <summary>
@@ -1237,9 +1238,15 @@ Re:
    Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
        If Not Directory.Exists(Path) Then Return 0
        Dim DeletedCount As Integer = 0
-        Dim Temp As String()
-        Temp = Directory.GetFiles(Path)
-        For Each FilePath As String In Temp
+        Dim Files As String()
+        Try
+            Files = Directory.GetFiles(Path)
+        Catch ex As DirectoryNotFoundException '#4549
+            Log(ex, $"疑似为孤立符号链接，尝试直接删除（{Path}）", LogLevel.Developer)
+            Directory.Delete(Path)
+            Return 0
+        End Try
+        For Each FilePath As String In Files
            Dim RetriedFile As Boolean = False
 RetryFile:
            Try
@@ -1258,8 +1265,7 @@ RetryFile:
                End If
            End Try
        Next
-        Temp = Directory.GetDirectories(Path)
-        For Each str As String In Temp
+        For Each str As String In Directory.GetDirectories(Path)
            DeleteDirectory(str, IgnoreIssue)
        Next
        Dim RetriedDir As Boolean = False
@@ -1441,14 +1447,14 @@ RetryDir:
    End Function

    ''' <summary>
-    ''' 获取 Json 对象。
+    ''' 获取 JSON 对象。
    ''' </summary>
    Public Function GetJson(Data As String)
        Try
            Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
        Catch ex As Exception
            Dim Length As Integer = If(Data, "").Length
-            Throw New Exception("格式化 json 对象失败：" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data))
+            Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data))
        End Try
    End Function

@@ -1852,6 +1858,13 @@ RetryDir:
        Return NewProcess.ExitCode
    End Function

+    ''' <summary>
+    ''' 判断当前系统语言是否为中文。
+    ''' </summary>
+    Public Function IsSystemLanguageChinese() As Boolean
+        Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
+    End Function
+
    Private Uuid As Integer = 1
    Private UuidLock As Object
    ''' <summary>
@@ -2657,7 +2670,11 @@ Retry:
    End Sub
    Public Function CanFeedback(ShowHint As Boolean) As Boolean
        If False.Equals(PageSetupSystem.IsLauncherNewest) Then
-            If ShowHint Then MyMsgBox("你的 PCL 不是最新版，因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈")
+            If ShowHint Then
+                If MyMsgBox($"你的 PCL 不是最新版，因此无法提交反馈。{vbCrLf}请在更新后，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
+                    UpdateCheckByButton()
+                End If
+            End If
            Return False
        Else
            Return True
@@ -91,17 +91,18 @@
                _State = value
                Log("[Loader] 加载器 " & Name & " 状态改变：" & GetStringFromEnum(value))
                '实现 ILoadingTrigger 接口与 OnStateChanged 回调
-                RunInUi(Sub()
-                            Select Case value
-                                Case LoadState.Loading
-                                    LoadingState = MyLoading.MyLoadingState.Run
-                                Case LoadState.Failed
-                                    LoadingState = MyLoading.MyLoadingState.Error
-                                Case Else
-                                    LoadingState = MyLoading.MyLoadingState.Stop
-                            End Select
-                            RaiseEvent OnStateChangedUi(Me, value, OldState)
-                        End Sub)
+                RunInUi(
+                Sub()
+                    Select Case value
+                        Case LoadState.Loading
+                            LoadingState = MyLoading.MyLoadingState.Run
+                        Case LoadState.Failed
+                            LoadingState = MyLoading.MyLoadingState.Error
+                        Case Else
+                            LoadingState = MyLoading.MyLoadingState.Stop
+                    End Select
+                    RaiseEvent OnStateChangedUi(Me, value, OldState)
+                End Sub)
                If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState))
            End Set
        End Property
@@ -566,7 +567,7 @@ Restart:
    End Class

    '任务栏进度条
-    Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
+    Public LoaderTaskbar As New SynchronizedCollection(Of LoaderBase)
    Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
    Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None

@@ -582,14 +583,14 @@ Restart:
            '检查任务是否完成，若完成则移除
            '外显任务是否已经全部完成
            Dim IsAllDownloadTaskCompleted As Boolean = True
-            For Each Loader In LoaderTaskbar
+            For Each Loader In LoaderTaskbar.ToList()
                If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
            Next
            '若单个任务已中止或全部任务已完成，则刷新并移除
            For Each Task In LoaderTaskbar.ToList()
                If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
                    If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
-                    LoaderTaskbar.TryTake(Task)
+                    LoaderTaskbar.Remove(Task)
                    Log($"[Taskbar] {Task.Name} 已移出任务列表")
                End If
            Next
@@ -329,7 +329,7 @@ Retry:
    ''' <summary>
    ''' 同时发送多个网络请求并要求返回内容。
    ''' </summary>
-    Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing)
+    Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True)
        Dim Threads As New List(Of Thread)
        Dim RequestResult = Nothing
        Dim RequestEx As Exception = Nothing
@@ -338,7 +338,7 @@ Retry:
            Dim th As New Thread(
            Sub()
                Try
-                    RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
+                    RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers, MakeLog)
                Catch ex As Exception
                    FailCount += 1
                    RequestEx = ex
@@ -1232,7 +1232,7 @@ SourceBreak:
                '根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
                If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
                   ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
-                   (ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源
+                   ((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403、429，所以不应因此禁用下载源
                   (Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
                    Info.Source.FailCount > NetTaskThreadLimit + 2 Then
                    Dim IsThisFail As Boolean = False
@@ -1344,7 +1344,7 @@ Retry:
                        If Check.ActualSize = -1 Then
                            Check.ActualSize = FileSize
                        ElseIf Check.ActualSize <> FileSize Then
-                            Throw New Exception("文件大小不一致：任务要求为 " & Check.ActualSize & " B，网络获取结果为 " & FileSize & "B")
+                            Throw New Exception($"文件大小不一致：任务要求为 {Check.ActualSize} B，网络获取结果为 {FileSize}B")
                        End If
                    End If
                    '检查文件
@@ -1654,6 +1654,9 @@ NextElement:
                '复制已存在的文件
                For Each FileToken In ExistFiles
                    Dim File As NetFile = FileToken.Key
+                    SyncLock LockState
+                        If File.State > NetState.WaitForCopy Then Exit Sub
+                    End SyncLock
                    Dim LocalPath As String = FileToken.Value
                    Dim RetryCount As Integer = 0
 Retry:
@@ -1882,7 +1885,7 @@ Retry:
                        For Each File As NetFile In WaitingFiles
                            If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
                            Dim NewThread = File.TryBeginThread()
-                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests
+                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests
                        Next
                        '为进行中的文件追加线程
                        If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增
@@ -1902,7 +1905,7 @@ Retry:
                            '新增线程
                            If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程，不再新增
                            Dim NewThread = File.TryBeginThread()
-                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests
+                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests
                        Next
                    End While
                Catch ex As Exception
@@ -2000,7 +2003,7 @@ Retry:
    ''' 是否有正在进行中、需要在下载管理页面显示的下载任务？
    ''' </summary>
    Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
-        For Each Task In LoaderTaskbar
+        For Each Task In LoaderTaskbar.ToList()
            If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
               (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
                Return True
@@ -66,8 +66,20 @@ Public Class MyBitmap
            Else
                '使用这种自己接管 FileStream 的方法加载才能解除文件占用
                Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
-                    Pic = New System.Drawing.Bitmap(InputStream)
-                    InputStream.Dispose()
+                    '判断是否为 WebP 文件头
+                    Dim Header(1) As Byte
+                    InputStream.Read(Header, 0, 2)
+                    InputStream.Seek(0, SeekOrigin.Begin)
+                    If Header(0) = 82 AndAlso Header(1) = 73 Then
+                        '读取 WebP
+                        If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
+                        Dim FileBytes(InputStream.Length - 1) As Byte
+                        InputStream.Read(FileBytes, 0, FileBytes.Length)
+                        Dim Decoder As New Imazen.WebP.SimpleDecoder()
+                        Pic = Decoder.DecodeFromBytes(FileBytes, FileBytes.Length)
+                    Else
+                        Pic = New System.Drawing.Bitmap(InputStream)
+                    End If
                End Using
            End If
        Catch ex As Exception