This commit is contained in:
龙腾猫跃
2024-10-01 03:39:04 +08:00
parent d48ab143be
commit 76bf3c40d0
21 changed files with 242 additions and 287 deletions
+19 -4
View File
@@ -12,13 +12,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.7" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.7." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.8" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.8." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 336 'Release
Public Const VersionCode As Integer = 340 'Release
#Else
Public Const VersionCode As Integer = 337 'Snapshot
Public Const VersionCode As Integer = 339 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1840,6 +1840,13 @@ RetryDir:
#Region "系统"
''' <summary>
''' 指示接取到这个异常的函数进行重试。
''' </summary>
Public Class RetryException
Inherits Exception
End Class
''' <summary>
''' 当前程序是否拥有管理员权限。
''' </summary>
@@ -2430,6 +2437,14 @@ Retry:
Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
End Function
''' <summary>
''' 控件是否受到 TextTrimming 属性影响,导致内容被截取。
''' </summary>
<Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
Return Control.DesiredSize.Width > Control.ActualWidth
End Function
#End Region
#Region "Debug"
@@ -288,15 +288,13 @@
End SyncLock
End Try
'检验输入以确定情况
If (Not IsForceRestart) AndAlso '不要求强行重启
((Input IsNot Nothing AndAlso Input.Equals(Me.Input)) OrElse (Input Is Nothing AndAlso Me.Input Is Nothing)) AndAlso '输入相同
(State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已加载成功
If IsForceRestart Then Return True '强制要求重启
If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
'如果输入相同且未出错则不重试
Return False
Return False '则不重试
Else
'需要开始
Return True
Return True '需要开始
End If
End Function
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
@@ -317,7 +315,7 @@
Sub()
Try
IsForceRestarting = IsForceRestart
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已启动")
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已" & If(IsForceRestarting, "强制", "") & "启动")
LoadDelegate(Me)
If IsAborted Then
Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束,输出被弃用(最新线程:" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & ")", LogLevel.Developer)
@@ -441,12 +439,13 @@
Exit Sub
End If
End SyncLock
RunInThread(Sub()
'中断加载器
For Each Loader In Loaders
Loader.Abort()
Next
End Sub)
RunInThread(
Sub()
'中断加载器
For Each Loader In Loaders
Loader.Abort()
Next
End Sub)
End Sub
''' <summary>
@@ -485,7 +484,7 @@
Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub
Dim IsFinished As Boolean = True
Dim Ignore As Boolean = False
Dim Blocked As Boolean = False
Dim Input As Object = Me.Input
For Each Loader In Loaders
Select Case Loader.State
@@ -493,28 +492,30 @@
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart
End If
'更新下一个加载器的输入
Input = CType(Loader, Object).Output
End If
'如果不让继续启动,且已有加载器正在加载中,就不继续启动
If Loader.Block AndAlso Not IsFinished Then Blocked = True
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart
End If
End If
'已经有正在加载中的了,不需要再启动了
IsFinished = False
Ignore = True
Blocked = True
Case Else
Restart:
'未启动,则启动加载器
IsFinished = False
If Ignore Then Continue For
If Blocked Then Continue For
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
@@ -528,8 +529,8 @@ Restart:
Else
Loader.Start(IsForceRestart:=IsForceRestarting)
End If
'如果不让继续启动,那就不启动呗
If Loader.Block Then Ignore = True
'阻止继续
If Loader.Block Then Blocked = True
End Select
Next
If IsFinished Then
@@ -140,7 +140,7 @@ Retry:
''' </summary>
''' <param name="Url">网页的 Url。</param>
''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
Public Function NetGetCodeByRequestMulty(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
Public Function NetGetCodeByRequestMultiple(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
Dim Threads As New List(Of Thread)
Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing
@@ -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, Optional MakeLog As Boolean = True)
Public Function NetRequestMultiple(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
@@ -701,8 +701,7 @@ RequestFinished:
''' <summary>
''' 所属的文件列表任务。
''' </summary>
Public Tasks As New Concurrent.ConcurrentBag(Of LoaderDownload)
Public Tasks As New SynchronizedCollection(Of LoaderDownload)
''' <summary>
''' 所有下载源。
''' </summary>
@@ -1232,7 +1231,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)") OrElse ex.Message.Contains("(429)")) AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403、429,所以不应因此禁用下载源
(ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403,所以不应因此禁用下载源
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit + 2 Then
Dim IsThisFail As Boolean = False
@@ -1403,7 +1402,7 @@ Retry:
''' </summary>
Public Sub Abort(CausedByTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载
Tasks.TryTake(CausedByTask)
Tasks.Remove(CausedByTask)
If Tasks.Any Then Exit Sub
'确认中断
SyncLock LockState