2.11.1

2025-11-01 11:51:54 +08:00
parent a067271995
commit efd480f06c
24 changed files with 1031 additions and 431 deletions
@@ -5,6 +5,7 @@ Imports System.Runtime.CompilerServices
 Imports System.Security.Cryptography
 Imports System.Security.Principal
 Imports System.Text.RegularExpressions
+Imports System.Threading.Tasks
 Imports System.Xaml
 Imports Newtonsoft.Json

@@ -13,13 +14,13 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.11.0" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.11.0." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.11.1" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.11.1." & VersionBranchCode '标准格式的四段式版本号
    Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
    Public Const VersionCode As Integer = 372 'Release
 #Else
-    Public Const VersionCode As Integer = 373 'Snapshot
+    Public Const VersionCode As Integer = 374 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1727,6 +1728,7 @@ RetryDir:
    ''' </summary>
    <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
    Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
+        If Str Is Nothing Then Return False
        Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
    End Function
    ''' <summary>
@@ -1734,6 +1736,7 @@ RetryDir:
    ''' </summary>
    <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
    Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
+        If Str Is Nothing Then Return False
        Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
    End Function
    ''' <summary>
@@ -1741,6 +1744,7 @@ RetryDir:
    ''' </summary>
    <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
    Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
+        If Str Is Nothing Then Return False
        Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
    End Function
    ''' <summary>
@@ -1777,6 +1781,7 @@ RetryDir:
    ''' 如果输入有误，返回 0。
    ''' </summary>
    Public Function Val(Str As Object) As Double
+        If Str Is Nothing Then Return 0
        Try
            Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
        Catch
@@ -2147,6 +2152,29 @@ RetryDir:
        Return result
    End Function

+    ''' <summary>
+    ''' 为 Task 设置超时，在超时时抛出 TimeoutException。
+    ''' </summary>
+    <Extension> Public Function GetResultWithTimeout(Of T)(TargetTask As Task(Of T), TokenSource As CancellationTokenSource, TimeoutMs As Integer) As T
+        Dim DelayTask = Task.Delay(TimeoutMs)
+        If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
+            TokenSource.Cancel()
+            Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
+        End If
+        Return TargetTask.GetAwaiter().GetResult()
+    End Function
+    ''' <summary>
+    ''' 为 Task 设置超时，在超时时抛出 TimeoutException。
+    ''' </summary>
+    <Extension> Public Sub GetResultWithTimeout(TargetTask As Task, TokenSource As CancellationTokenSource, TimeoutMs As Integer)
+        Dim DelayTask = Task.Delay(TimeoutMs)
+        If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
+            TokenSource.Cancel()
+            Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
+        End If
+        TargetTask.GetAwaiter().GetResult()
+    End Sub
+
    ''' <summary>
    ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
    ''' </summary>
@@ -2586,7 +2614,7 @@ Retry:
                RunInUi(
                Sub()
                    My.Computer.Clipboard.Clear()
-                    My.Computer.Clipboard.SetText(Text)
+                    If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
                End Sub)
            Catch ex As Exception
                RetryCount += 1
@@ -2600,6 +2628,21 @@ Retry:
            If ShowSuccessHint Then Hint("已成功复制！", HintType.Green)
        End Sub)
    End Sub
+    ''' <summary>
+    ''' 获取剪贴板文本。将在 UI 线程运行，且不会抛出异常。
+    ''' </summary>
+    Public Function ClipboardGetText() As String
+        Dim Result As String = Nothing
+        RunInUiWait(
+        Sub()
+            Try
+                If My.Computer.Clipboard.ContainsText() Then Result = My.Computer.Clipboard.GetText()
+            Catch ex As Exception
+                Log(ex, "获取剪贴板文本失败")
+            End Try
+        End Sub)
+        Return Result
+    End Function

    ''' <summary>
    ''' 以 Byte() 形式获取程序中的资源。
@@ -3079,6 +3122,7 @@ Retry:
    Public Sub Telemetry([Event] As String, ParamArray Datas As String())
        If Not Setup.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
        If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
+        If VersionBranchName = "Debug" Then Return '开发版本不上传遥测
        RunInNewThread(
        Sub()
            Try
@@ -344,12 +344,12 @@
            LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsAborted
        End Sub
        Public Overrides Sub Failed(ex As Exception)
+            [Error] = ex
            SyncLock LockState
                If IsAborted OrElse State >= LoadState.Finished Then Return
                State = LoadState.Failed
            End SyncLock
            Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
-            [Error] = ex
            TriggerThreadAbort()
        End Sub
        Public Overrides Sub Abort()
@@ -464,11 +464,11 @@
            End Sub)
        End Sub
        Public Overrides Sub Failed(Ex As Exception)
+            [Error] = Ex '先设置错误再调整状态，防止父加载器获取不到异常
            SyncLock LockState
                If State >= LoadState.Finished Then Return
                State = LoadState.Failed
            End SyncLock
-            [Error] = Ex
            For Each Loader In Loaders
                Loader.Abort()
            Next
@@ -262,11 +262,11 @@ RequestFinished:
                    })
                End If
            End SyncLock
-            Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
+            Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
            Dim ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
            Dim ResponseBytes As Byte()
            Using Stream As New MemoryStream
-                ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetAwaiter().GetResult()
+                ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
                ResponseBytes = Stream.ToArray()
            End Using
            '输出
@@ -286,7 +286,7 @@ RequestFinished:
            Throw
        Catch ex As Exception
            RecordIPReliability(HostIp, -1)
-            If TypeOf ex Is OperationCanceledException Then 'CancellationToken 超时
+            If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时
                Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
            ElseIf ex.IsNetworkRelated Then
                Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
@@ -992,7 +992,7 @@ StartThread:
                HostIp = DNSLookup(HttpRequest, CancelToken) 'DNS 预解析
                If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Th.DownloadStart, Nothing)
                Dim ContentLength As Long = 0
-                Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
+                Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
                If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}") '状态码检查
                If State = NetState.Error Then GoTo SourceBreak '快速中断
                If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
@@ -1063,7 +1063,7 @@ NotSupportRange:
                ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
                If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
                Dim ResponseBytes As Byte() = New Byte(16384) {}
-                HttpDataCount = ReadWithTimeout(ResponseStream, ResponseBytes, 0, 16384, Timeout)
+                HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
                While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
                            HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
                    '限速
@@ -1113,7 +1113,7 @@ NotSupportRange:
                        '无数据，且已超时
                        Throw New TimeoutException("操作超时，无数据。")
                    End If
-                    HttpDataCount = ReadWithTimeout(ResponseStream, ResponseBytes, 0, 16384, Timeout)
+                    HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
                End While
 SourceBreak:
                If State = NetState.Error OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
@@ -1130,7 +1130,8 @@ SourceBreak:
                    RecordIPReliability(HostIp, 0.5)
                End If
            Catch ex As Exception
-                Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException, $"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{HostIp}")
+                Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException,
+                    $"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{HostIp}")
                RecordIPReliability(HostIp, -0.7)
                SourceFail(Th, ex, False)
            Finally
@@ -1650,15 +1651,15 @@ Retry:
                If State >= LoadState.Finished Then Return
                If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
                '寻找有效的错误信息
-                Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
+                Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot TimeoutException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
                [Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
                '获取实际失败的文件
                For Each File In Files
                    If File.State <> NetState.Error Then Continue For
+                    If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
                    Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}（{s.Url}）"), vbCrLf)
                    [Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf &
-                                            "各下载源的错误如下：" & vbCrLf & Detail,
-                                            [Error])
+                                            "各下载源的错误如下：" & vbCrLf & Detail, [Error])
                    '上报
                    Telemetry("文件下载失败",
                              "FileName", File.LocalName,
@@ -1951,6 +1952,45 @@ Retry:
        Return False
    End Function

+#End Region
+
+#Region "端口"
+
+    ''' <summary>
+    ''' 随机获取单个可用的端口。
+    ''' </summary>
+    Public Function FindFreePort() As Integer
+        Dim Listener As New TcpListener(IPAddress.Loopback, 0)
+        Listener.Start()
+        Dim port As Integer = CType(Listener.LocalEndpoint, IPEndPoint).Port
+        Listener.Stop()
+        Return port
+    End Function
+
+    ''' <summary>
+    ''' 获取当前已被占用的端口列表。
+    ''' </summary>
+    Public Function GetUsedPorts() As List(Of Integer)
+        Dim IPProperties = NetworkInformation.IPGlobalProperties.GetIPGlobalProperties()
+        Dim UsedPorts As New List(Of Integer)
+        UsedPorts.AddRange(IPProperties.GetActiveTcpListeners().Select(Function(ep) ep.Port))
+        UsedPorts.AddRange(IPProperties.GetActiveUdpListeners().Select(Function(ep) ep.Port))
+        UsedPorts.AddRange(IPProperties.GetActiveTcpConnections().Select(Function(conn) conn.LocalEndPoint.Port))
+        Return UsedPorts.Distinct().ToList()
+    End Function
+
+    ''' <summary>
+    ''' 寻找数个连续编号的可用端口。
+    ''' </summary>
+    Public Function FindFreePorts(ConsecutiveCount As Integer, ParamArray ExtraBlackLists As Integer()) As List(Of Integer)
+        Dim UsedPorts = GetUsedPorts().Concat(ExtraBlackLists)
+        For port = 12000 To 65000 - ConsecutiveCount
+            Dim Range = Enumerable.Range(port, ConsecutiveCount)
+            If Not Range.Any(Function(p) UsedPorts.Contains(p)) Then Return Range.ToList
+        Next
+        Throw New Exception("未能找到可用的端口！")
+    End Function
+
 #End Region

    ''' <summary>
@@ -1985,27 +2025,4 @@ Retry:
        }.Any(Function(k) Detail.ContainsF(k, True))
    End Function

-    ''' <summary>
-    ''' 随机获取一个可用的端口。
-    ''' </summary>
-    Public Function GetAvailablePort() As Integer
-        Dim Listener As New TcpListener(IPAddress.Loopback, 0)
-        Listener.Start()
-        Dim port As Integer = CType(Listener.LocalEndpoint, IPEndPoint).Port
-        Listener.Stop()
-        Return port
-    End Function
-
-    ''' <summary>
-    ''' 带有 Timeout 的读取 Stream 方法。
-    ''' </summary>
-    Private Function ReadWithTimeout(TargetStream As Stream, Buffer() As Byte, Offset As Integer, Count As Integer, ReadTimeoutMs As Integer) As Integer
-        Dim ReadTask = TargetStream.ReadAsync(Buffer, Offset, Count)
-        Dim DelayTask = Task.Delay(ReadTimeoutMs)
-        If Task.WhenAny(ReadTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
-            Throw New TimeoutException($"读取数据超时（{ReadTimeoutMs} ms）")
-        End If
-        Return ReadTask.GetAwaiter().GetResult()
-    End Function
-
 End Module
@@ -114,12 +114,7 @@ Public Class ValidateInteger
    End Sub
    Public Overrides Function Validate(Str As String) As String
        Dim Valed As Integer
-        If Not Integer.TryParse(Str, Valed) Then 
-            Return "请输入一个整数！"
-        End If
-        If Not RegexCheck(Str, "^(-?0|-?[1-9]\d*)$") Then 
-            Return "请输入一个不带有前导零的整数！"
-        End If
+        If Not Integer.TryParse(Str, Valed) Then Return "请输入一个整数！"
        If Str.Length > 9 Then Return "请输入一个大小合理的数字！"
        If Valed > Max Then Return "不可超过 " & Max & "！"
        If Valed < Min Then Return "不可低于 " & Min & "！"