2.8.4

2024-08-17 01:46:19 +08:00
parent c62ab46b99
commit 62394e0052
37 changed files with 2654 additions and 1565 deletions
@@ -11,12 +11,12 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.8.3" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.8.3." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.8.4" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.8.4." & VersionBranchCode '标准格式的四段式版本号
 #If BETA Then
    Public Const VersionCode As Integer = 332 'Release
 #Else
-    Public Const VersionCode As Integer = 331 'Snapshot
+    Public Const VersionCode As Integer = 333 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -80,10 +80,6 @@ Public Module ModBase
    ''' </summary>
    Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
    ''' <summary>
-    ''' 操作系统版本。Win10 为 10.0。
-    ''' </summary>
-    Public OsVersion As Version = Environment.OSVersion.Version
-    ''' <summary>
    ''' 系统盘盘符，以 \ 结尾。例如 “C:\”。
    ''' </summary>
    Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
@@ -1108,8 +1104,6 @@ Re:
        Dim Retry As Boolean = False
 Re:
        Try
-            ''检测该文件是否在下载中，若在下载则放弃检测
-            'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
            '获取 SHA1
            Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
            Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
@@ -1587,14 +1581,14 @@ RetryDir:
    ''' 获取处于两个子字符串之间的部分。
    ''' 会裁切尽可能多的内容：匹配开始使用 LastIndexOf，匹配结束使用 IndexOf，但如果未找到子字符串则不裁切。
    ''' </summary>
-    <Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String
-        Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase))
+    <Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
+        Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
        If StartPos >= 0 Then
-            StartPos += Before.Length
+            StartPos += After.Length
        Else
            StartPos = 0
        End If
-        Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase))
+        Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
        If EndPos >= 0 Then
            Return Str.Substring(StartPos, EndPos - StartPos)
        ElseIf StartPos > 0 Then
@@ -2682,7 +2676,7 @@ Retry:
    Public Sub FeedbackInfo()
        On Error Resume Next
        Log("[System] 诊断信息：" & vbCrLf &
-            "操作系统：" & My.Computer.Info.OSFullName & vbCrLf &
+            "操作系统：" & My.Computer.Info.OSFullName & "（32 位：" & Is32BitSystem & "）" & vbCrLf &
            "剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
            "DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf &
            "MC 文件夹：" & If(PathMcFolder, "Nothing") & vbCrLf &
@@ -566,38 +566,33 @@ Restart:
    End Class

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

    Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
        If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
-        SyncLock LoaderTaskbarLock
-            LoaderTaskbar.Add(Loader)
-            Log($"[Taskbar] {Loader.Name} 已加入任务列表")
-        End SyncLock
+        LoaderTaskbar.Add(Loader)
+        Log($"[Taskbar] {Loader.Name} 已加入任务列表")
    End Sub
    Public Sub LoaderTaskbarProgressRefresh()
        Try
            Dim NewState As Shell.TaskbarItemProgressState
            Dim NewProgress As Double = LoaderTaskbarProgressGet()
            '检查任务是否完成，若完成则移除
-            SyncLock LoaderTaskbarLock
-                '外显任务是否已经全部完成
-                Dim IsAllDownloadTaskCompleted As Boolean = True
-                For Each Loader In LoaderTaskbar
-                    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.Remove(Task)
-                        Log($"[Taskbar] {Task.Name} 已移出任务列表")
-                    End If
-                Next
-            End SyncLock
+            '外显任务是否已经全部完成
+            Dim IsAllDownloadTaskCompleted As Boolean = True
+            For Each Loader In LoaderTaskbar
+                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)
+                    Log($"[Taskbar] {Task.Name} 已移出任务列表")
+                End If
+            Next
            '更新平滑后的进度
            If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
                LoaderTaskbarProgress = NewProgress
@@ -625,15 +620,8 @@ Restart:
    End Sub
    Public Function LoaderTaskbarProgressGet() As Double
        Try
-            Dim Total As Double = 0, Count As Integer = 0
-            SyncLock LoaderTaskbarLock
-                For Each Task In LoaderTaskbar.ToList
-                    Total += Task.Progress
-                    Count += 1 '避免多线程影响导致计数出错
-                Next
-            End SyncLock
-            If Count = 0 Then Return 1
-            Return MathClamp(Total / Count, 0, 1)
+            If Not LoaderTaskbar.Any Then Return 1
+            Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
        Catch ex As Exception
            Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
            Return 0.5
@@ -1,8 +1,6 @@
 Imports System.Net

 Public Module ModNet
-
-
    Public Const NetDownloadEnd As String = ".PCLDownloading"

    ''' <summary>
@@ -208,10 +206,10 @@ RequestFinished:
        Catch ex As ThreadInterruptedException
            Throw
        Catch ex As Exception
-            If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
-                Throw New TimeoutException("连接服务器超时，已接收 " & Result.Count & " B（" & Url & "）")
+            If TypeOf ex Is WebException AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
+                Throw New TimeoutException($"获取结果失败（{CType(ex, WebException).Status}，{ex.Message}，{Url}）", ex)
            Else
-                Throw New WebException("获取结果失败，" & ex.Message & "（" & Url & "）", ex)
+                Throw New WebException($"获取结果失败（{If(TypeOf ex Is WebException, CType(ex, WebException).Status & "，", "")}{ex.Message}，{Url}）", ex)
            End If
        Finally
            Request.Abort()
@@ -420,7 +418,7 @@ RequestFinished:
            Throw
        Catch ex As WebException
            If ex.Status = WebExceptionStatus.Timeout Then
-                Throw New WebException("连接服务器超时，请检查你的网络环境是否良好（" & Url & "）", ex)
+                ex = New WebException($"连接服务器超时，请检查你的网络环境是否良好（{ex.Message}，{Url}）", ex)
            Else
                '获取请求失败的返回
                Dim Res As String = ""
@@ -434,10 +432,14 @@ RequestFinished:
                    End Using
                Catch
                End Try
-                Throw New WebException("网络请求失败（" & Url & "，" & ex.Message & "）" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex)
+                ex = New WebException($"网络请求失败（{ex.Status}，{ex.Message}，{Url}）{If(String.IsNullOrEmpty(Res), "", vbCrLf & Res)}", ex)
            End If
+            If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
+            Throw ex
        Catch ex As Exception
-            Throw New WebException("网络请求失败（" & Url & "）", ex)
+            ex = New WebException("网络请求失败（" & Url & "）", ex)
+            If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
+            Throw ex
        Finally
            If DataStream IsNot Nothing Then DataStream.Dispose()
            If Resp IsNot Nothing Then Resp.Dispose()
@@ -689,7 +691,7 @@ RequestFinished:
        ''' <summary>
        ''' 所属的文件列表任务。
        ''' </summary>
-        Public Tasks As New List(Of LoaderDownload)
+        Public Tasks As New Concurrent.ConcurrentBag(Of LoaderDownload)

        ''' <summary>
        ''' 所有下载源。
@@ -882,7 +884,6 @@ RequestFinished:
        Public ReadOnly LockState As New Object
        Public ReadOnly LockChain As New Object
        Public ReadOnly LockSource As New Object
-        Public ReadOnly LockTasks As New Object

        Public ReadOnly Uuid As Integer = GetUuid()
        Public Overrides Function Equals(obj As Object) As Boolean
@@ -965,7 +966,7 @@ Capture:
                    Next
                    '是否禁用多线程，以及规定碎片大小
                    Dim TargetUrl As String = GetSource().Url
-                    If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing
+                    If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
                    '寻找最大碎片
                    'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程
                    Dim FilePieceMax As NetThread = Threads
@@ -981,10 +982,8 @@ StartThread:
                    If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing
                    '构建线程
                    Dim ThreadUuid As Integer = GetUuid()
-                    SyncLock LockTasks
-                        If Not Tasks.Any() Then Return Nothing '由于中断，已没有可用任务
-                        Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
-                    End SyncLock
+                    If Not Tasks.Any() Then Return Nothing '由于中断，已没有可用任务
+                    Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
                    ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
                    '链表处理
                    If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then
@@ -1141,11 +1140,9 @@ NotSupportRange:
                                End If
                                SyncLock LockCount
                                    Info.Source.FailCount = 0
-                                    SyncLock LockTasks
-                                        For Each Task In Tasks
-                                            Task.FailCount = 0
-                                        Next
-                                    End SyncLock
+                                    For Each Task In Tasks
+                                        Task.FailCount = 0
+                                    Next
                                End SyncLock
                                NetManager.DownloadDone += RealDataCount
                                SyncLock LockDone
@@ -1199,11 +1196,9 @@ SourceBreak:
                '状态变更
                SyncLock LockCount
                    Info.Source.FailCount += 1
-                    SyncLock LockTasks
-                        For Each Task In Tasks
-                            Task.FailCount += 1
-                        Next
-                    End SyncLock
+                    For Each Task In Tasks
+                        Task.FailCount += 1
+                    Next
                End SyncLock
                Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
                Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
@@ -1308,7 +1303,7 @@ Retry:
                    '合并文件
                    If IsNoSplit Then
                        '仅有一个线程，从缓存中输出
-                        If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从缓存输出文件")
+                        If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从缓存输出文件，长度：" & SmailFileCache.Count)
                        MergeFile = New FileStream(LocalPath, FileMode.Create)
                        AddWriter = New BinaryWriter(MergeFile)
                        AddWriter.Write(SmailFileCache.ToArray)
@@ -1345,7 +1340,7 @@ Retry:
                    '检查文件
                    Dim CheckResult As String = Check?.Check(LocalPath)
                    If CheckResult IsNot Nothing Then
-                        Log($"[Download] {LocalName} 合并文件失败，下载线程细节：")
+                        Log($"[Download] {LocalName} 文件校验失败，下载线程细节：")
                        For Each Th As NetThread In Threads
                            Log($"[Download]     {Th.Uuid}#，状态 {GetStringFromEnum(Th.State)}，范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone}，完成 {Th.DownloadDone}，剩余 {Th.DownloadUndone}")
                        Next
@@ -1398,10 +1393,8 @@ Retry:
        ''' </summary>
        Public Sub Abort(CausedByTask As LoaderDownload)
            '从特定任务中移除，如果它还属于其他任务，则继续下载
-            SyncLock LockTasks
-                Tasks.Remove(CausedByTask)
-                If Tasks.Any Then Exit Sub
-            End SyncLock
+            Tasks.TryTake(CausedByTask)
+            If Tasks.Any Then Exit Sub
            '确认中断
            SyncLock LockState
                If State >= NetState.Finish Then Exit Sub
@@ -1431,11 +1424,9 @@ Retry:
                NetManager.FileRemain -= 1
                If PrintLog Then Log("[Download] " & LocalName & "：已完成，剩余文件 " & NetManager.FileRemain)
            End SyncLock
-            SyncLock LockTasks
-                For Each Task In Tasks
-                    Task.OnFileFinish(Me)
-                Next
-            End SyncLock
+            For Each Task In Tasks
+                Task.OnFileFinish(Me)
+            Next
        End Sub

    End Class
@@ -1962,9 +1953,7 @@ Retry:
                        If Files(File.LocalPath).State >= NetState.Finish Then
                            '该文件已经下载过一次，且下载完成
                            '将已下载的文件替换成当前文件，重新下载
-                            SyncLock File.LockTasks
-                                File.Tasks.Add(Task)
-                            End SyncLock
+                            File.Tasks.Add(Task)
                            Files(File.LocalPath) = File
                            SyncLock LockRemain
                                FileRemain += 1
@@ -1975,15 +1964,11 @@ Retry:
                            '该文件正在下载中
                            '将当前文件替换成下载中的文件，即两个任务指向同一个文件
                            File = Files(File.LocalPath)
-                            SyncLock File.LockTasks
-                                File.Tasks.Add(Task)
-                            End SyncLock
+                            File.Tasks.Add(Task)
                        End If
                    Else
                        '没有该文件
-                        SyncLock File.LockTasks
-                            File.Tasks.Add(Task)
-                        End SyncLock
+                        File.Tasks.Add(Task)
                        Files.Add(File.LocalPath, File)
                        SyncLock LockRemain
                            FileRemain += 1
@@ -2005,14 +1990,12 @@ Retry:
    ''' 是否有正在进行中、需要在下载管理页面显示的下载任务？
    ''' </summary>
    Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
-        SyncLock LoaderTaskbarLock
-            For Each Task In LoaderTaskbar
-                If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
-                   (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
-                    Return True
-                End If
-            Next
-        End SyncLock
+        For Each Task In LoaderTaskbar
+            If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
+               (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
+                Return True
+            End If
+        Next
        Return False
    End Function