2.13.1.0

2026-08-02 01:00:16 +08:00
parent c7ccdd65dc
commit 7fb6e5d68e
61 changed files with 3291 additions and 1165 deletions
@@ -79,7 +79,7 @@ Public Module ModAnimation
        ''' 已经执行的动画长度。如果为负数则为延迟。
        ''' </summary>
        ''' <remarks></remarks>
-        Public TimeFinished As Integer
+        Public TimeFinished As Double
        ''' <summary>
        ''' 已经完成的百分比。
        ''' </summary>
@@ -853,9 +853,8 @@ Sleeper:
    ''' <summary>
    ''' 动画定时器事件。
    ''' </summary>
-    Public Sub AniTimer(DeltaTick As Integer)
+    Public Sub AniTimer(DeltaTick As Double)
        Try
-
            If DeltaTick / AniSpeed > 100 Then Logger.Info($"两个动画帧间隔 {DeltaTick} ms")
            Dim i As Integer = -1
            '循环每个动画组
@@ -1034,6 +1033,7 @@ NextAni:
                    End If

                Case AniType.Code
+                    Ani.TimeFinished = Ani.TimeTotal
                    CType(Ani.Value, ThreadStart)()

                Case AniType.ScaleTransform
@@ -6,12 +6,12 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.13.0.1" '显示用版本名
+    Public Const VersionBaseName As String = "2.13.1.0" '显示用版本名
    Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If RELEASE Then
-    Public Const VersionCode As Integer = 406 '正式版
+    Public Const VersionCode As Integer = 408 '正式版
 #Else
-    Public Const VersionCode As Integer = 407 '快照版
+    Public Const VersionCode As Integer = 409 '快照版
 #End If

    '版本信息
@@ -465,57 +465,7 @@ Public Module ModBase

 #Region "文件"

-    '=============================
-    '  注册表
-    '=============================
-
-    ''' <summary>
-    ''' 读取注册表键。如果失败则返回默认值。
-    ''' </summary>
-    Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
-        Try
-            Return If(My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False)?.GetValue(Key), DefaultValue)
-        Catch ex As Exception
-            Logger.Error(ex, $"读取注册表出错：{Key}", LogBehavior.Toast)
-            Return DefaultValue
-        End Try
-    End Function
-    ''' <summary>
-    ''' 写入注册表键。
-    ''' </summary>
-    Public Sub WriteReg(Key As String, Value As String, Optional ThrowException As Boolean = False)
-        Try
-            Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
-            If SubKey Is Nothing Then SubKey = My.Computer.Registry.CurrentUser.CreateSubKey("Software\" & RegFolder) '如果不存在就创建  
-            SubKey.SetValue(Key, Value)
-        Catch ex As Exception
-            Logger.Warn(ex, $"写入注册表出错：{Key}", If(ThrowException, LogBehavior.Toast, LogBehavior.ToastIfDebug))
-            If ThrowException Then Throw
-        End Try
-    End Sub
-    ''' <summary>
-    ''' 是否存在某个注册表键。
-    ''' </summary>
-    Public Function HasReg(Key As String) As Boolean
-        Return ReadReg(Key, Nothing) IsNot Nothing
-    End Function
-    ''' <summary>
-    ''' 删除注册表键。
-    ''' </summary>
-    Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False)
-        Try
-            Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
-            If SubKey?.GetValue(Key) Is Nothing Then Return
-            SubKey.DeleteValue(Key)
-        Catch ex As Exception
-            Logger.Warn(ex, $"删除注册表出错：{Key}", If(ThrowException, LogBehavior.Toast, LogBehavior.ToastIfDebug))
-            If ThrowException Then Throw
-        End Try
-    End Sub
-
-    '=============================
-    '  ini
-    '=============================
+    'ini

    Private ReadOnly IniCache As New ConcurrentDictionary(Of String, ConcurrentDictionary(Of String, String))
    ''' <summary>
@@ -617,7 +567,8 @@ Public Module ModBase
        End Try
    End Sub

-    '文件校验
+    '权限检查
+
    ''' <summary>
    ''' 检查是否拥有某一文件夹的 I/O 权限。如果文件夹不存在，会返回 False。
    ''' </summary>
@@ -837,8 +788,8 @@ Public Module ModBase
    ''' <summary>
    ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
    ''' </summary>
-    Public PathPure As String = GetPureASCIIDir()
-    Private Function GetPureASCIIDir() As String
+    Public PathPure As Lazy(Of String) = New Lazy(Of String)(
+    Function()
        If Paths.Base.IsAsciiOnly() Then
            Return Paths.Base & "PCL\"
        ElseIf Paths.AppDataThenName.IsAsciiOnly() Then
@@ -848,7 +799,7 @@ Public Module ModBase
        Else
            Return OsDrive & "ProgramData\PCL\"
        End If
-    End Function
+    End Function)

    ''' <summary>
    ''' 指示接取到这个异常的函数进行重试。
@@ -288,7 +288,7 @@ Retry:
        Catch ex As TimeoutException
            Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
        Catch ex As Exception
-            ex.ThrowIfCanceled()
+            If TypeOf ex IsNot TaskCanceledException Then ex.ThrowIfCanceled() 'GetResultWithTimeout 会抛出 TaskCanceledException
            RecordIPReliability(HostIp, -1)
            If ex.IsBadNetwork Then
                Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
@@ -1423,8 +1423,8 @@ Retry:
            End Get
            Set(value As Integer)
                _FailCount = value
-                If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then
-                    Logger.Warn($"由于同加载器中失败次数过多引发强制失败：连续失败了 {value} 次")
+                If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 8, NetTaskThreadLimit * 8 + 3)) Then
+                    Logger.Error($"由于同加载器中失败次数过多引发强制失败：连续失败了 {value} 次", LogBehavior.ToastIfDebug)
                    On Error Resume Next
                    Dim ExList As New List(Of Exception)
                    For Each File In Files
@@ -1917,7 +1917,7 @@ FinishExCatch:
    End Class

    ''' <summary>
-    ''' 是否有正在进行中、需要在下载管理页面显示的下载任务？
+    ''' 是否有正在进行中、需要在任务管理页面显示的下载任务？
    ''' </summary>
    Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
        Return LoaderTaskbar.Any(
@@ -260,16 +260,16 @@ Public Class ValidateFolderName
    Inherits Validate
    Public Property Folder As String
    Public Property UseMinecraftCharCheck As Boolean = True
-    Public Property IgnoreCase As Boolean = True
    Private ReadOnly PathIgnore As IEnumerable(Of String)
+    Private ReadOnly IgnoreList As List(Of String)
    Public Sub New()
    End Sub
-    Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
+    Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreList As List(Of String) = Nothing)
        Me.Folder = Folder
-        Me.IgnoreCase = IgnoreCase
        Me.UseMinecraftCharCheck = UseMinecraftCharCheck
        On Error Resume Next
        PathIgnore = DirectoryUtils.EnumerateDirectories(Folder)
+        Me.IgnoreList = IgnoreList
    End Sub
    Public Overrides Function Validate(Str As String) As String
        Try
@@ -291,15 +291,17 @@ Public Class ValidateFolderName
            Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！", True).Validate(Str)
            If InvalidStrCheck <> "" Then Return InvalidStrCheck
            '检查 NTFS 8.3 文件名（#4505）
-            If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不可包含这一特殊格式！"
+            If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
            '检查文件夹重名
            Dim Arr As New List(Of String)
+            Dim folderName As String
            If PathIgnore IsNot Nothing Then
                For Each FolderPath In PathIgnore
-                    Arr.Add(PathUtils.GetLastPart(FolderPath))
+                    folderName = PathUtils.GetLastPart(FolderPath)
+                    If IgnoreList Is Nothing OrElse Not IgnoreList.Contains(folderName, StringComparer.OrdinalIgnoreCase) Then Arr.Add(folderName)
                Next
            End If
-            Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str)
+            Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", True).Validate(Str)
            If Not SameNameCheck = "" Then Return SameNameCheck
            Return ""
        Catch ex As Exception
@@ -387,6 +389,9 @@ Public Class ValidateFolderPath
        '检查长度
        LengthCheck = New ValidateLength(1, 254).Validate(Str)
        If LengthCheck <> "" Then Return LengthCheck
+        '检查 NTFS 8.3 文件名（#4505）
+        Dim Match = Str.RegexSeek(".{2,}~\d")
+        If Match IsNot Nothing Then Return $"文件夹名不能包含 {Match} 这一特殊格式！"
        '检查开头
        If Str.StartsWithF("\\Mac\") Then GoTo Fin
        For Each Drive In Environment.GetLogicalDrives().Where(Function(p) DirectoryUtils.Exists(p))
@@ -413,8 +418,6 @@ Fin:
            '检查特殊字符串
            Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr)
            If Not InvalidStrCheck = "" Then Return InvalidStrCheck
-            '检查 NTFS 8.3 文件名（#4505）
-            If SubStr.RegexCheck(".{2,}~\d") Then Return "文件夹名不可包含这一特殊格式！"
        Next
        Return ""
    End Function