2.12.3

Plain Craft Launcher 2/Modules/Base/ModBase.vb

@@ -14,13 +14,13 @@ Public Module ModBase
 #Region "声明"
 
     '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.12.2" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.12.2." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.12.3" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.12.3." & VersionBranchCode '标准格式的四段式版本号
     Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
-    Public Const VersionCode As Integer = 379 'Release
+    Public Const VersionCode As Integer = 381 'Release
 #Else
-    Public Const VersionCode As Integer = 380 'Snapshot
+    Public Const VersionCode As Integer = 382 'Snapshot
 #End If
     '自动生成的版本信息
     Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1071,10 +1071,9 @@ Public Module ModBase
     ''' 获取文件 MD5，若失败则返回空字符串。
     ''' </summary>
     Public Function GetFileMD5(FilePath As String) As String
-        Dim Retry As Boolean = False
+        Dim Retried As Boolean = False
 Re:
         Try
-            '获取 MD5
             Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
                 Using h = MD5Cng.Create()
                     Dim Retval As Byte() = h.ComputeHash(File)
@@ -1082,16 +1081,15 @@ Re:
                     For i = 0 To Retval.Length - 1
                         Result.Append(Retval(i).ToString("x2"))
                     Next
-
                     Return Result.ToString
                 End Using
             End Using
         Catch ex As Exception
-            If Retry OrElse TypeOf ex Is FileNotFoundException Then
+            If Retried OrElse TypeOf ex Is FileNotFoundException Then
                 Log(ex, "获取文件 MD5 失败：" & FilePath)
                 Return ""
             Else
-                Retry = True
+                Retried = True
                 Log(ex, "获取文件 MD5 可重试失败：" & FilePath, LogLevel.Normal)
                 Thread.Sleep(RandomInteger(200, 500))
                 GoTo Re
@@ -1102,29 +1100,25 @@ Re:
     ''' 获取文件 SHA512，若失败则返回空字符串。
     ''' </summary>
     Public Function GetFileSHA512(FilePath As String) As String
-        Dim Retry As Boolean = False
+        Dim Retried As Boolean = False
 Re:
         Try
-            ''检测该文件是否在下载中，若在下载则放弃检测
-            'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
-            '获取 SHA512
-            Using file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
+            Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
                 Using h = SHA512Cng.Create()
-                    Dim retval As Byte() = h.ComputeHash(file)
+                    Dim retval As Byte() = h.ComputeHash(File)
                     Dim Result As New StringBuilder(retval.Length * 2)
                     For i As Integer = 0 To retval.Length - 1
                         Result.Append(retval(i).ToString("x2"))
                     Next
-
                     Return Result.ToString
                 End Using
             End Using
         Catch ex As Exception
-            If Retry OrElse TypeOf ex Is FileNotFoundException Then
+            If Retried OrElse TypeOf ex Is FileNotFoundException Then
                 Log(ex, "获取文件 SHA512 失败：" & FilePath)
                 Return ""
             Else
-                Retry = True
+                Retried = True
                 Log(ex, "获取文件 SHA512 可重试失败：" & FilePath, LogLevel.Normal)
                 Thread.Sleep(RandomInteger(200, 500))
                 GoTo Re
@@ -1138,17 +1132,13 @@ Re:
         Dim Retry As Boolean = False
 Re:
         Try
-            ''检测该文件是否在下载中，若在下载则放弃检测
-            'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
-            '获取 SHA256
-            Using file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
+            Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
                 Using h = SHA256Cng.Create()
-                    Dim retval As Byte() = h.ComputeHash(file)
+                    Dim retval As Byte() = h.ComputeHash(File)
                     Dim Result As New StringBuilder(retval.Length * 2)
                     For i As Integer = 0 To retval.Length - 1
                         Result.Append(retval(i).ToString("x2"))
                     Next
-
                     Return Result.ToString()
                 End Using
             End Using
@@ -1171,15 +1161,13 @@ Re:
         Dim Retry As Boolean = False
 Re:
         Try
-            '获取 SHA1
-            Using file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
+            Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
                 Using h = SHA1Cng.Create()
-                    Dim retval As Byte() = h.ComputeHash(file)
+                    Dim retval As Byte() = h.ComputeHash(File)
                     Dim Result As New StringBuilder(retval.Length * 2)
                     For i As Integer = 0 To retval.Length - 1
                         Result.Append(retval(i).ToString("x2"))
                     Next
-
                     Return Result.ToString
                 End Using
             End Using
@@ -1327,7 +1315,7 @@ Re:
             End Using
         End Sub
         Try
-            TryExtractZip(Encoding.UTF8)
+            TryExtractZip(New UTF8Encoding(False, True))
         Catch ex As Exception
             Log(ex, $"首次解压尝试失败，将更换编码并重试（{CompressFilePath} → {DestDirectory}）")
             Try
@@ -1896,50 +1884,53 @@ RetryDir:
     ''' <param name="Source">被搜索的长内容。</param>
     ''' <param name="Query">用户输入的搜索文本。</param>
     Private Function SearchSimilarity(Source As String, Query As String) As Double
+        If String.IsNullOrEmpty(Source) OrElse String.IsNullOrEmpty(Query) Then Return 0
         Dim qp As Integer = 0, lenSum As Double = 0
-        Source = Source.ToLower.Replace(" ", "")
-        Query = Query.ToLower.Replace(" ", "")
-        Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
+        Dim str As New StringBuilder(Source.Length)
+        str.Append(Source.ToLower().Replace(" ", ""))
+        Query = Query.ToLower().Replace(" ", "")
+        Dim sourceLength As Integer = str.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
+        If queryLength = 0 Then Return 0
         Do While qp < queryLength
             '对 qp 作为开始位置计算
             Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
-            '查找以 qp 为头的最大子串
-            Do While sp < Source.Length
-                '对每个 sp 作为开始位置计算最大子串
+            Dim currentSourceLength As Integer = str.Length
+            Do While sp < currentSourceLength
                 Dim len As Integer = 0
-                Do While (qp + len) < queryLength AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
+                While (qp + len) < queryLength AndAlso (sp + len) < currentSourceLength AndAlso str(sp + len) = Query(qp + len)
                     len += 1
-                Loop
+                End While
                 '存储 len
                 If len > lenMax Then
                     lenMax = len
                     spMax = sp
                 End If
                 '根据结果增加 sp
-                sp += Math.Max(1, len)
+                sp += If(len > 0, len, 1)
             Loop
             If lenMax > 0 Then
-                Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空
+                str.Remove(spMax, lenMax) '将源中的对应字段移除
                 '存储 lenSum
                 Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
                 IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
                 lenSum += IncWeight
             End If
-            '根据结果增加 qp
-            qp += Math.Max(1, lenMax)
+            qp += If(lenMax > 0, lenMax, 1)
         Loop
         '计算结果：重复字段量 × 源长度影响比例
-        Return (lenSum / queryLength) * (3 / Math.Pow(sourceLength + 15, 0.5)) * If(queryLength <= 2, 3 - queryLength, 1)
+        Return (lenSum / queryLength) * (3 / Math.Sqrt(sourceLength + 15)) * If(queryLength <= 2, 3 - queryLength, 1)
     End Function
     ''' <summary>
     ''' 获取多段文本加权后的相似度。
     ''' </summary>
-    Private Function SearchSimilarityWeighted(Source As List(Of KeyValuePair(Of String, Double)), Query As String) As Double
+    Private Function SearchSimilarityWeighted(Source As List(Of SearchSource), Query As String) As Double
         Dim TotalWeight As Double = 0
         Dim Sum As Double = 0
         For Each Pair In Source
-            Sum += SearchSimilarity(Pair.Key, Query) * Pair.Value
-            TotalWeight += Pair.Value
+            If Pair.Aliases.Any Then
+                Sum += Pair.Aliases.Max(Function(a) SearchSimilarity(a, Query)) * Pair.Weight
+            End If
+            TotalWeight += Pair.Weight
         Next
         Return Sum / TotalWeight
     End Function
@@ -1952,9 +1943,10 @@ RetryDir:
         ''' </summary>
         Public Item As T
         ''' <summary>
-        ''' 该项目用于搜索的源。
+        ''' 该项目用于搜索的文本源。
+        ''' 在搜索时，会对每个文本源单独加权，但单个文本源内的多个别名只取最高的一个的相似度。
         ''' </summary>
-        Public SearchSource As List(Of KeyValuePair(Of String, Double))
+        Public SearchSource As List(Of SearchSource)
         ''' <summary>
         ''' 相似度。
         ''' </summary>
@@ -1963,9 +1955,28 @@ RetryDir:
         ''' 是否完全匹配。
         ''' </summary>
         Public AbsoluteRight As Boolean
+        Public Overrides Function ToString() As String
+            Return Math.Round(Similarity, 3) & " - " & Item.ToString()
+        End Function
+    End Class
+    ''' <summary>
+    ''' 单个用于搜索的文本源。
+    ''' </summary>
+    Public Class SearchSource
+        Public Aliases As String()
+        Public Weight As Double
+        Public Sub New(Aliases As String(), Optional Weight As Double = 1)
+            Me.Aliases = Aliases
+            Me.Weight = Weight
+        End Sub
+        Public Sub New(Text As String, Optional Weight As Double = 1)
+            Me.Aliases = {Text}
+            Me.Weight = Weight
+        End Sub
     End Class
     ''' <summary>
     ''' 进行多段文本加权搜索，获取相似度较高的数项结果。
+    ''' 在搜索时，会对每个文本源单独加权，但单个文本源内的多个别名只取最高的一个的相似度。
     ''' </summary>
     ''' <param name="MaxBlurCount">返回的最大模糊结果数。</param>
     ''' <param name="MinBlurSimilarity">返回结果要求的最低相似度。</param>
@@ -1974,15 +1985,19 @@ RetryDir:
         Dim ResultList As New List(Of SearchEntry(Of T))
         If Not Entries.Any() Then Return ResultList
         '进行搜索，获取相似信息
+        Dim QueryParts = Query.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
+        Dim Candidates As New List(Of SearchEntry(Of T))
         For Each Entry In Entries
             Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
             Entry.AbsoluteRight =
-                Query.Split(" ").All( '对于按空格分割的每一段
+                QueryParts.All( '对于按空格分割的每一段
                 Function(QueryPart) Entry.SearchSource.Any( '若与任意一个搜索源完全匹配，则标记为完全匹配项
-                Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True)))
+                Function(Source) Source.Aliases.Any(
+                Function([Alias]) [Alias].Replace(" ", "").ContainsF(QueryPart, True))))
+            If Entry.AbsoluteRight OrElse Entry.Similarity >= MinBlurSimilarity Then Candidates.Add(Entry)
         Next
         '按照相似度进行排序
-        Entries = Entries.SortByComparison(
+        Candidates = Candidates.SortByComparison(
         Function(Left, Right) As Boolean
             If Left.AbsoluteRight Xor Right.AbsoluteRight Then
                 Return Left.AbsoluteRight
@@ -1992,11 +2007,11 @@ RetryDir:
         End Function)
         '返回结果
         Dim BlurCount As Integer = 0
-        For Each Entry In Entries
+        For Each Entry In Candidates
             If Entry.AbsoluteRight Then
                 ResultList.Add(Entry) '完全匹配，直接加入
             Else
-                If Entry.Similarity < MinBlurSimilarity OrElse BlurCount = MaxBlurCount Then Exit For '模糊结果边界条件
+                If BlurCount = MaxBlurCount Then Exit For
                 ResultList.Add(Entry)
                 BlurCount += 1 '模糊结果计数
             End If
@@ -2175,7 +2190,7 @@ RetryDir:
     ''' </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
+        If Task.WhenAny(TargetTask, DelayTask).ConfigureAwait(False).GetAwaiter().GetResult() Is DelayTask Then
             TokenSource.Cancel()
             Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
         End If
@@ -2186,7 +2201,7 @@ RetryDir:
     ''' </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
+        If Task.WhenAny(TargetTask, DelayTask).ConfigureAwait(False).GetAwaiter().GetResult() Is DelayTask Then
             TokenSource.Cancel()
             Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
         End If
@@ -2537,7 +2552,7 @@ NextElement:
     ''' 选择最大值对应的对象。
     ''' 若没有元素则返回 Nothing。
     ''' </summary>
-    <Extension> Public Function MaxOf(Of T, C As IComparable(Of C))(Source As IEnumerable(Of T), Selector As Func(Of T, C)) As T
+    <Extension> Public Function MaxBy(Of T, C As IComparable(Of C))(Source As IEnumerable(Of T), Selector As Func(Of T, C)) As T
         Using Enumerator = Source.GetEnumerator()
             If Not Enumerator.MoveNext() Then Return Nothing
             Dim MaxItem As T = Enumerator.Current
@@ -2555,7 +2570,7 @@ NextElement:
     ''' 选择最小值对应的对象。
     ''' 若没有元素则返回 Nothing。
     ''' </summary>
-    <Extension> Public Function MinOf(Of T, C As IComparable(Of C))(List As IEnumerable(Of T), Selector As Func(Of T, C)) As T
+    <Extension> Public Function MinBy(Of T, C As IComparable(Of C))(List As IEnumerable(Of T), Selector As Func(Of T, C)) As T
         Using Enumerator = List.GetEnumerator()
             If Not Enumerator.MoveNext() Then Return Nothing
             Dim MinItem As T = Enumerator.Current

Plain Craft Launcher 2/Modules/Base/ModNet.vb

@@ -1,5 +1,4 @@
-Imports System.Net.Http.Headers
-Imports System.Net.Sockets
+Imports System.Net.Sockets
 Imports System.Runtime.CompilerServices
 Imports System.Threading.Tasks
 
@@ -248,7 +247,7 @@ RequestFinished:
             SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
             'DNS 解析
             CancelToken = New CancellationTokenSource(Timeout)
-            HostIp = DNSLookup(Request, CancelToken)
+            HostIp = DNSLookup(Request, CancelToken.Token)
             If HostIp IsNot Nothing AndAlso Not IPReliability.ContainsKey(HostIp) Then
                 IPReliability(HostIp) = -0.01 '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
             End If
@@ -263,11 +262,12 @@ RequestFinished:
                 End If
             End SyncLock
             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).GetResultWithTimeout(CancelToken, Timeout)
-                ResponseBytes = Stream.ToArray()
+            Using ResponseStream = Response.Content.ReadAsStreamAsync().GetResultWithTimeout(CancelToken, Timeout)
+                Using Stream As New MemoryStream
+                    ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
+                    ResponseBytes = Stream.ToArray()
+                End Using
             End Using
             '输出
             If Response.IsSuccessStatusCode Then
@@ -304,10 +304,9 @@ RequestFinished:
 
     ''' <summary>
     ''' 进行 DNS 解析。它仅在选择的 IP 与系统默认的不一致时才对 URL 中的 Host 进行替换。
-    ''' 返回请求时应使用的 IP；若为 IPv6，则加上了方括号。
-    ''' 若解析失败，则返回 Nothing。
+    ''' 返回请求时应使用的 IP。若解析失败，则返回 Nothing。
     ''' </summary>
-    Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String
+    Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationToken) As String
         '若一分钟内已失败过，则不再重复尝试解析，以减少断网时的 Exception 数量
         Dim Host = Request.RequestUri.Host
         SyncLock DNSFailureRecord.SyncRoot
@@ -320,43 +319,36 @@ RequestFinished:
             End If
         End SyncLock
         '初步 DNS 解析
-        Dim DnsTask As Task(Of IPAddress()) = Nothing
+        Dim Candidates As IPAddress()
         Try
-            DnsTask = Dns.GetHostAddressesAsync(Host)
-            DnsTask.Wait(CancelToken.Token)
+            Dim AsyncResult = Dns.BeginGetHostAddresses(Host, Nothing, Nothing)
+            If WaitHandle.WaitAny(New WaitHandle() {AsyncResult.AsyncWaitHandle, CancelToken.WaitHandle}) Then Throw New TimeoutException("DNS 解析超时")
+            Candidates = Dns.EndGetHostAddresses(AsyncResult).Distinct.ToArray
         Catch ex As Exception
             Log(ex, $"DNS 解析失败（{Host}）")
             DNSFailureRecord(Host) = Date.Now
             Return Nothing
         End Try
-        Dim Candidates As IPAddress() = DnsTask.Result.ToArray
         If Not Candidates.Any Then
             Log($"[Net] DNS 解析无结果（{Host}）")
             Return Nothing
         End If
         '若同时存在 IPv4 和 IPv6 地址，仅选择其中一类（因为 GFW 可能只屏蔽了 IPv4 或 IPv6）
-        Dim GetIPReliability = Function(Key) IPReliability.GetOrDefault(Key.ToString, 0)
+        Dim Reliabilities = Candidates.ToDictionary(Function(i) i, Function(i) IPReliability.GetOrDefault(i.ToString, 0))
         Dim IPv4Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetwork).ToArray
         Dim IPv6Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetworkV6).ToArray
         If IPv4Targets.Any AndAlso IPv6Targets.Any Then
-            Dim IPv4Reliability = IPv4Targets.Average(Function(i) GetIPReliability(i))
-            Dim IPv6Reliability = IPv6Targets.Average(Function(i) GetIPReliability(i))
+            Dim IPv4Reliability = IPv4Targets.Max(Function(i) Reliabilities(i))
+            Dim IPv6Reliability = IPv6Targets.Max(Function(i) Reliabilities(i))
             If Host = "api.modrinth.com" Then IPv6Reliability -= 0.1 '让 Modrinth 优先使用 IPv4 地址（#6887）
+            If ModeDebug Then Log($"[Net] DNS IPv4/IPv6 选择（{Host}），IPv4 {IPv4Reliability:0.000}，IPv6 {IPv6Reliability:0.000}")
             Candidates = If(IPv4Reliability >= IPv6Reliability, IPv4Targets, IPv6Targets)
         End If
         '选择可靠度最高的 IP
-        Dim MaxReliability As Double = Candidates.Max(Function(i) GetIPReliability(i))
-        Dim Target As IPAddress = Candidates.First(Function(i) GetIPReliability(i) = MaxReliability)
-        Dim TargetIp As String = If(Target.AddressFamily = AddressFamily.InterNetworkV6, $"[{Target}]", Target.ToString)
-        If Target IsNot Candidates.First Then
-            '优选结果与系统默认 IP 不一致，替换域名并设置 Host 头
-            If ModeDebug Then Log($"[Net] DNS 解析结果：{Host} → {Target}，所有可能的 IP 与可靠度：{DnsTask.Result.Select(Function(i) $"{i} → {GetIPReliability(i):0.000}").Join("；")}")
-            Request.Headers.Host = Host
-            Dim Builder As New UriBuilder(Request.RequestUri)
-            Builder.Host = TargetIp
-            Request.RequestUri = Builder.Uri
-        End If
-        Return TargetIp
+        Dim Target As IPAddress = Candidates.MaxBy(Function(i) Reliabilities(i))
+        Request.Headers.Host = Request.RequestUri.Authority
+        Request.RequestUri = (New UriBuilder(Request.RequestUri) With {.Host = If(Target.AddressFamily = AddressFamily.InterNetworkV6, $"[{Target}]", Target.ToString)}).Uri
+        Return Target.ToString
     End Function
     Private DNSFailureRecord As New SafeDictionary(Of String, Date)
     ''' <summary>
@@ -369,8 +361,10 @@ RequestFinished:
     ''' </summary>
     Private Sub RecordIPReliability(IP As String, Result As Double)
         If IP Is Nothing Then Return
-        If Not IPReliability.ContainsKey(IP) Then IPReliability(IP) = 0
-        IPReliability(IP) = (IPReliability(IP) + Result) / 2
+        SyncLock IPReliability.SyncRoot
+            If Not IPReliability.ContainsKey(IP) Then IPReliability(IP) = 0
+            IPReliability(IP) = (IPReliability(IP) + Result) / 2
+        End SyncLock
     End Sub
 
     ''' <summary>
@@ -418,12 +412,10 @@ RequestFinished:
     ''' 基于限速，当前可以下载的剩余量。
     ''' </summary>
     Public NetTaskSpeedLimitLeft As Long = -1
-    Private ReadOnly NetTaskSpeedLimitLeftLock As New Object
     ''' <summary>
     ''' 正在运行中的线程数。
     ''' </summary>
     Public NetTaskThreadCount As Integer = 0
-    Private ReadOnly NetTaskThreadCountLock As New Object
 
     ''' <summary>
     ''' 下载源。
@@ -760,7 +752,6 @@ RequestFinished:
         ''' 文件的已下载大小。
         ''' </summary>
         Public DownloadDone As Long = 0
-        Private ReadOnly LockDone As New Object
         ''' <summary>
         ''' 文件的校验规则。
         ''' </summary>
@@ -840,14 +831,12 @@ RequestFinished:
         ''' </summary>
         Private ReadOnly Property ConnectAverage As Integer
             Get
-                SyncLock LockCount
-                    Return If(ConnectCount = 0, -1, ConnectTime / ConnectCount)
-                End SyncLock
+                Dim CurrentConnectCount As Integer = ConnectCount '防止竞态条件
+                Return If(CurrentConnectCount = 0, -1, ConnectTime / CurrentConnectCount)
             End Get
         End Property
 
         Private Const FilePieceLimit As Long = 256 * 1024
-        Public ReadOnly LockCount As New Object
         Public ReadOnly LockState As New Object
         Public ReadOnly LockChain As New Object
         Public ReadOnly LockSource As New Object
@@ -929,7 +918,7 @@ StartSingleThreadDownload:
                     If Source Is Nothing Then Return Nothing
                     Dim TargetUrl As String = Source.Url
                     If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse
-                       TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") OrElse TargetUrl.Contains("momot.rs") Then Return Nothing
+                       TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("momot.rs") Then Return Nothing
                     '寻找最大碎片
                     'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程
                     Dim FilePieceMax As NetThread = Threads
@@ -962,9 +951,7 @@ StartThread:
 
                 End SyncLock
                 '开始线程
-                SyncLock NetTaskThreadCountLock
-                    NetTaskThreadCount += 1
-                End SyncLock
+                Interlocked.Increment(NetTaskThreadCount)
                 SyncLock LockSource
                     If Not HasAvailableSource(False) Then SourcesOnce.First.SingleThread = ThreadInfo
                 End SyncLock
@@ -986,7 +973,7 @@ StartThread:
                 CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing
             '部分下载源真的特别慢，并且只需要一个请求，例如 Ping 为 20s，如果增长太慢，就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟
             '延迟过长会导致某些特别慢的链接迟迟不被掐死
-            Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 10000) * (1 + Th.Source.FailCount), 30000)
+            Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 15000) * (1 + Th.Source.FailCount), 30000)
             Th.State = NetState.Connecting
             Try
                 Dim HttpDataCount As Integer = 0
@@ -994,8 +981,8 @@ StartThread:
                 HttpRequest = New HttpRequestMessage(HttpMethod.Get, Th.Source.Url)
                 SecretHeadersSign(Th.Source.Url, HttpRequest, SimulateBrowserHeaders)
                 CancelToken = New CancellationTokenSource(Timeout)
-                HostIp = DNSLookup(HttpRequest, CancelToken) 'DNS 预解析
-                If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Th.DownloadStart, Nothing)
+                HostIp = DNSLookup(HttpRequest, CancelToken.Token) 'DNS 预解析
+                If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New Headers.RangeHeaderValue(Th.DownloadStart, Nothing)
                 Dim ContentLength As Long = 0
                 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}") '状态码检查
@@ -1032,7 +1019,7 @@ StartThread:
                             Dim DriveName As String = Drive.Name.First.ToString
                             Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
                                                 If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
-                            If Drive.TotalFreeSpace < RequiredSpace Then
+                            If RequiredSpace > 0 AndAlso Drive.TotalFreeSpace < RequiredSpace Then
                                 Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间，但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
                                                     If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", ""))
                             End If
@@ -1040,7 +1027,7 @@ StartThread:
                     End If
                 ElseIf FileSize < 0 Then
                     Throw New Exception("非首线程运行时，尚未获取文件大小")
-                ElseIf Th.DownloadStart > 0 AndAlso ContentLength = FileSize Then
+                ElseIf Th.DownloadStart > 0 AndAlso ContentLength >= FileSize Then
 NotSupportRange:
                     SyncLock LockSource
                         If SourcesOnce.Contains(Th.Source) Then GoTo SourceBreak
@@ -1076,11 +1063,9 @@ NotSupportRange:
                         Threading.Thread.Sleep(16)
                     End While
                     Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Th.DownloadUndone))
-                    SyncLock NetTaskSpeedLimitLeftLock
-                        If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
-                    End SyncLock
+                    If NetTaskSpeedLimitHigh > 0 Then Interlocked.Add(NetTaskSpeedLimitLeft, -RealDataCount)
                     Dim DeltaTime = GetTimeMs() - Th.LastReceiveTime
-                    If DeltaTime > 1000000 Then DeltaTime = 1 '避免时间刻反转导致出现极大值
+                    If DeltaTime > 100000000 Then DeltaTime = 1 '避免时间刻反转导致出现极大值
                     If RealDataCount > 0 Then
                         '有数据
                         If Th.DownloadDone = 0 Then
@@ -1089,27 +1074,21 @@ NotSupportRange:
                             SyncLock LockState
                                 If State < NetState.Downloading Then State = NetState.Downloading
                             End SyncLock
-                            SyncLock LockCount
-                                ConnectCount += 1
-                                ConnectTime += GetTimeMs() - Th.InitTime
-                            End SyncLock
+                            Interlocked.Increment(ConnectCount)
+                            Interlocked.Add(ConnectTime, GetTimeMs() - Th.InitTime)
                         End If
-                        SyncLock LockCount
-                            Th.Source.FailCount = 0
-                            For Each Task In Tasks
-                                Task.FailCount = 0
-                            Next
-                        End SyncLock
-                        NetManager.DownloadDone += RealDataCount
-                        SyncLock LockDone
-                            DownloadDone += RealDataCount
-                        End SyncLock
+                        Th.Source.FailCount = 0
+                        For Each Task In Tasks
+                            Task.FailCount = 0
+                        Next
+                        Interlocked.Add(NetManager.DownloadDone, RealDataCount)
+                        Interlocked.Add(DownloadDone, RealDataCount)
                         Th.DownloadDone += RealDataCount
                         ResultStream.Write(ResponseBytes, 0, RealDataCount)
                         '已完成
                         If Th.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
                         '检查速度是否过慢
-                        If DeltaTime > 5000 AndAlso DeltaTime > RealDataCount AndAlso '数据包间隔大于 5s，且速度小于 1K/s
+                        If Th.LastReceiveTime > 0 AndAlso DeltaTime > 5000 AndAlso DeltaTime > RealDataCount AndAlso '数据包间隔大于 5s，且速度小于 1K/s
                                     Th.Source.SingleThread Is Nothing Then '且并非单线程下载
                             Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。")
                         End If
@@ -1147,9 +1126,7 @@ SourceBreak:
                 CancelToken?.Dispose()
                 If Not IsNoSplit Then ResultStream?.Dispose()
                 '改变计数
-                SyncLock NetTaskThreadCountLock
-                    NetTaskThreadCount -= 1
-                End SyncLock
+                Interlocked.Decrement(NetTaskThreadCount)
                 '合并
                 If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso
                     State < NetState.Merging AndAlso Th.State <> NetState.Interrupted Then Merge(Th)
@@ -1157,12 +1134,10 @@ SourceBreak:
         End Sub
         Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean)
             '状态变更
-            SyncLock LockCount
-                Th.Source.FailCount += 1
-                For Each Task In Tasks
-                    Task.FailCount += 1
-                Next
-            End SyncLock
+            Interlocked.Increment(Th.Source.FailCount)
+            For Each Task In Tasks
+                Interlocked.Increment(Task.FailCount)
+            Next
             Th.State = NetState.Interrupted
             Th.Source.Ex = ex
             '根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
@@ -1241,10 +1216,8 @@ SourceBreak:
             SyncLock LockChain
                 Threads = Nothing
             End SyncLock
-            NetManager.DownloadDone -= DownloadDone
-            SyncLock LockDone
-                DownloadDone = 0
-            End SyncLock
+            Interlocked.Add(NetManager.DownloadDone, -DownloadDone)
+            DownloadDone = 0
             SpeedLastDone = 0
         End Sub
 
@@ -1271,7 +1244,7 @@ Retry:
                 SyncLock LockChain
                     '合并文件
                     If IsNoSplit Then
-                        '仅有一个线程，从缓存中输出
+                        '仅有一个线程，从内存中输出
                         If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从内存输出文件")
                         Cache.Position = 0
                         WriteFile(LocalPath, Cache)
@@ -1321,6 +1294,7 @@ Retry:
                 End SyncLock
             Catch ex As Exception
                 RetryCount += 1
+                If State > NetState.Merging Then Return '通常是因为在合并时被中断了
                 Log(ex, $"合并文件出错，第 {RetryCount} 次尝试（{LocalName}）")
                 '重新尝试合并
                 If RetryCount < 3 Then
@@ -1372,9 +1346,7 @@ Retry:
         Private Sub AbortInternal()
             On Error Resume Next
             Reset()
-            SyncLock NetManager.LockRemain
-                NetManager.FileRemain -= 1
-            End SyncLock
+            Interlocked.Decrement(NetManager.FileRemain)
         End Sub
 
         '状态改变接口
@@ -1386,9 +1358,7 @@ Retry:
                 If State >= NetState.Finished Then Return
                 State = NetState.Finished
             End SyncLock
-            SyncLock NetManager.LockRemain
-                NetManager.FileRemain -= 1
-            End SyncLock
+            Interlocked.Decrement(NetManager.FileRemain)
             If PrintLog Then Log($"[Download] {LocalName}：已完成")
             For Each Task In Tasks
                 Task.OnFileFinish(Me)
@@ -1522,8 +1492,8 @@ FinishExCatch:
                         If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径：" & File.LocalPath)
                         Directory.CreateDirectory(GetPathFromFullPath(File.LocalPath)) '创建目标文件夹
                     Next
-                    '接入下载管理器
-                    NetManager.Start(Me)
+                    '接入下载管理器，获取新开始下载的文件列表
+                    Dim NewFiles = NetManager.Start(Me)
 
                     '====================================
                     ' 已存在文件查找
@@ -1531,9 +1501,8 @@ FinishExCatch:
 
                     '整理允许进行查找的文件
                     Dim FilesToCheck As New List(Of NetFile)
-                    Dim DisabledCopy As Boolean = Setup.Get("SystemDebugSkipCopy") '在设置中禁用了复制
-                    For Each File In Files
-                        If Not DisabledCopy AndAlso File.Check?.CanUseExistsFile Then
+                    For Each File In NewFiles
+                        If File.Check?.CanUseExistsFile Then
                             FilesToCheck.Add(File)
                         Else '不允许，直接开始下载
                             SyncLock LockState
@@ -1570,7 +1539,7 @@ FinishExCatch:
         End Sub
         Private Sub CheckExistingFiles(Files As List(Of NetFile), FolderList As List(Of String))
             Try
-                If ModeDebug Then Log($"[Download] 文件检查线程已启动，分配的文件数：{Files.Count}")
+                If ModeDebug Then Log($"[Download] 文件检查开始，本线程负责的文件数：{Files.Count}")
                 '列出 MC 文件夹中的各个版本文件夹
                 Dim VersionFolders As New List(Of String)
                 For Each McFolder In FolderList
@@ -1584,7 +1553,7 @@ FinishExCatch:
                 '处理每个文件
                 For Each File As NetFile In Files
                     Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File)
-                    If File.State >= NetState.WaitingToDownload Then Return '中断
+                    If File.State >= NetState.WaitingToDownload Then Continue For '中断
                     '已找到相同文件
                     If Target IsNot Nothing Then
                         File.IsCopy = True
@@ -1594,6 +1563,8 @@ Retry:
                             If Target <> File.LocalPath Then
                                 Log($"[Download] 复制已存在的文件：{Target} → {File.LocalPath}")
                                 CopyFile(Target, File.LocalPath)
+                            Else
+                                If ModeDebug Then Log($"[Download] 需要下载的文件已存在，并通过校验：{Target}")
                             End If
                             File.Finish(False)
                             Continue For
@@ -1619,6 +1590,8 @@ Retry:
         Private Function CheckExistingFile(FolderList As List(Of String), VersionFolders As List(Of String), File As NetFile) As String
             '目标文件已存在
             If File.Check.Check(File.LocalPath) Is Nothing Then Return File.LocalPath
+            '在设置中禁用了复制
+            If Setup.Get("SystemDebugSkipCopy") Then Return Nothing
             '没有可用的检查规则，只能开始下载
             If File.Check.Hash Is Nothing AndAlso File.Check.ActualSize < 0 Then Return Nothing
             '大致判断文件类别
@@ -1633,7 +1606,7 @@ Retry:
                     Return Nothing
                 End If
             End If
-            Dim Type = TypeIndexes.MaxOf(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
+            Dim Type = TypeIndexes.MaxBy(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
             '根据类别进行查找
             Static Sizes As New SafeDictionary(Of String, Long)
             Select Case Type
@@ -1757,8 +1730,7 @@ Retry:
         ''' <summary>
         ''' 需要下载的文件。为“本地地址 - 文件对象”键值对。
         ''' </summary>
-        Public Files As New Dictionary(Of String, NetFile)
-        Public ReadOnly LockFiles As New Object
+        Public AllFiles As New SafeDictionary(Of String, NetFile)
 
         ''' <summary>
         ''' 当前的所有下载任务。
@@ -1768,25 +1740,12 @@ Retry:
         ''' <summary>
         ''' 已下载完成的大小。
         ''' </summary>
-        Public Property DownloadDone As Long
-            Get
-                Return _DownloadDone
-            End Get
-            Set(value As Long)
-                SyncLock LockDone
-                    _DownloadDone = value
-                End SyncLock
-            End Set
-        End Property
-        Private _DownloadDone As Long = 0
-        Private ReadOnly LockDone As New Object
-
+        Public DownloadDone As Long = 0
 
         ''' <summary>
         ''' 尚未完成下载的文件数。
         ''' </summary>
         Public FileRemain As Integer = 0
-        Public ReadOnly LockRemain As New Object
 
         '这些属性由 RefreshStat 刷新
         ''' <summary>
@@ -1855,9 +1814,9 @@ Retry:
                         Thread.Sleep(20)
                         '获取文件列表
                         Dim AllFiles As List(Of NetFile)
-                        SyncLock LockFiles
-                            If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then Files.Clear() '若已完成，则清空
-                            AllFiles = Files.Values.ToList()
+                        SyncLock Me.AllFiles.SyncRoot
+                            If Id = 0 AndAlso FileRemain = 0 AndAlso Me.AllFiles.Any() Then Me.AllFiles.Clear() '若已完成，则清空
+                            AllFiles = Me.AllFiles.Values.ToList()
                         End SyncLock
                         Dim WaitingFiles As New List(Of NetFile)
                         Dim OngoingFiles As New List(Of NetFile)
@@ -1865,7 +1824,7 @@ Retry:
                             If File.Uuid Mod 2 = Id Then Continue For
                             If File.State = NetState.WaitingToDownload Then
                                 WaitingFiles.Add(File)
-                            ElseIf File.State < NetState.Merging Then
+                            ElseIf File.State < NetState.Merging AndAlso File.State >= NetState.WaitingToDownload Then
                                 OngoingFiles.Add(File)
                             End If
                         Next
@@ -1908,7 +1867,7 @@ Retry:
                     Dim NextTick As Long = GetTimeMs()
                     While True
                         '增加限速余量
-                        If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 10
+                        If NetTaskSpeedLimitHigh > 0 Then Interlocked.Add(NetTaskSpeedLimitLeft, CLng(NetTaskSpeedLimitHigh / 10))
                         '刷新公开属性
                         RefreshStat()
                         '等待 100 ms
@@ -1931,7 +1890,7 @@ Retry:
         ''' <summary>
         ''' 开始一个下载任务。
         ''' </summary>
-        Public Sub Start(Task As LoaderDownload)
+        Public Function Start(Task As LoaderDownload) As List(Of NetFile)
             StartManager()
             '清理缓存
             SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理
@@ -1943,45 +1902,30 @@ Retry:
                     Catch ex As Exception
                         Log(ex, "清理下载缓存失败")
                     End Try
+                    IsDownloadCacheCleared = True
                 End If
-                IsDownloadCacheCleared = True
-            End SyncLock
-            '文件处理
-            SyncLock LockFiles
-                '添加每个文件
-                For i = 0 To Task.Files.Count - 1
-                    Dim File = Task.Files(i)
-                    If Files.ContainsKey(File.LocalPath) Then
-                        '已有该文件
-                        If Files(File.LocalPath).State >= NetState.Finished Then
-                            '该文件已经下载过一次，且下载完成
-                            '将已下载的文件替换成当前文件，重新下载
-                            File.Tasks.Add(Task)
-                            Files(File.LocalPath) = File
-                            SyncLock LockRemain
-                                FileRemain += 1
-                            End SyncLock
-                            If ModeDebug Then Log($"[Download] {File.LocalName}：重新加入下载列表，目标 {File.LocalPath}")
-                        Else
-                            '该文件正在下载中
-                            '将当前文件替换成下载中的文件，即两个任务指向同一个文件
-                            File = Files(File.LocalPath)
-                            File.Tasks.Add(Task)
-                        End If
-                    Else
-                        '没有该文件
-                        File.Tasks.Add(Task)
-                        Files.Add(File.LocalPath, File)
-                        SyncLock LockRemain
-                            FileRemain += 1
-                        End SyncLock
-                        If ModeDebug Then Log($"[Download] {File.LocalName}：已加入下载列表，目标 {File.LocalPath}")
-                    End If
-                    Task.Files(i) = File '回设
-                Next
             End SyncLock
+            '添加每个文件
+            Dim NewFiles As New List(Of NetFile)
+            For i = 0 To Task.Files.Count - 1
+                Dim File As NetFile = Task.Files(i)
+                If AllFiles.ContainsKey(File.LocalPath) AndAlso AllFiles(File.LocalPath).State < NetState.Finished Then
+                    '该文件正在被另一个任务下载
+                    If ModeDebug Then Log($"[Download] {File.LocalName}：无需开始，该文件已在下载中，目标 {File.LocalPath}")
+                    File = AllFiles(File.LocalPath) '将列表中的文件替换成下载中的文件，即两个任务指向同一个文件；抛弃现在的 File 对象
+                    Task.Files(i) = File
+                Else
+                    '常规情况（该文件可能已在其他任务中下载完成，但这并不影响）
+                    If ModeDebug Then Log($"[Download] {File.LocalName}：开始，目标 {File.LocalPath}")
+                    AllFiles(File.LocalPath) = File
+                    NewFiles.Add(File)
+                    Interlocked.Increment(FileRemain)
+                End If
+                File.Tasks.Add(Task)
+            Next
             Tasks.Add(Task)
-        End Sub
+            Return NewFiles
+        End Function
 
     End Class