Files

2055 lines
97 KiB
VB.net
Raw Permalink Normal View History

1989-06-04 00:00:05 +09:00
Imports System.Net
Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading"
''' <summary>
''' 以 WebClient 获取网页源代码。会进行至多 45 秒 3 次的尝试,允许最长 30s 的超时。
''' </summary>
''' <param name="Url">网页的 Url。</param>
''' <param name="Encoding">网页的编码,通常为 UTF-8。</param>
Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Optional Accept As String = "application/json, text/javascript, */*; q=0.01") As String
Dim RetryCount As Integer = 0
Dim RetryException As Exception = Nothing
Dim StartTime As Long = GetTimeTick()
Try
Retry:
Select Case RetryCount
Case 0 '正常尝试
Return NetGetCodeByClient(Url, Encoding, 10000, Accept)
Case 1 '慢速重试
Thread.Sleep(500)
Return NetGetCodeByClient(Url, Encoding, 30000, Accept)
Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上,才进行重试
Thread.Sleep(500)
Return NetGetCodeByClient(Url, Encoding, 4000, Accept)
Else
Throw RetryException
End If
End Select
Catch ex As Exception
Select Case RetryCount
Case 0
RetryException = ex
RetryCount += 1
GoTo Retry
Case 1
RetryCount += 1
GoTo Retry
Case Else
Throw
End Select
End Try
End Function
Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String) As String
Url = SecretCdnSign(Url)
Log("[Net] 获取客户端网络结果:" & Url & ",最大超时 " & Timeout)
Dim Request As CookieWebClient
Dim res As HttpWebResponse = Nothing
Dim HttpStream As Stream = Nothing
Try
Request = New CookieWebClient With {
.Encoding = Encoding,
.Timeout = Timeout
}
Request.Headers("Accept") = Accept
Request.Headers("Accept-Language") = "en-US,en;q=0.5"
Request.Headers("X-Requested-With") = "XMLHttpRequest"
SecretHeadersSign(Url, Request)
Return Request.DownloadString(Url)
Catch ex As Exception
If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时(" & Url & "", ex)
Else
Throw New WebException("获取结果失败," & ex.Message & "" & Url & "", ex)
End If
Finally
If Not IsNothing(HttpStream) Then HttpStream.Dispose()
If Not IsNothing(res) Then res.Dispose()
End Try
End Function
''' <summary>
''' 以 WebRequest 获取网页源代码或 Json。会进行至多 45 秒 3 次的尝试,允许最长 30s 的超时。
''' </summary>
''' <param name="Url">网页的 Url。</param>
''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
Dim RetryCount As Integer = 0
Dim RetryException As Exception = Nothing
Dim StartTime As Long = GetTimeTick()
Try
Retry:
Select Case RetryCount
Case 0 '正常尝试
Return NetGetCodeRequest(Url, Encode, 10000, IsJson, Accept)
Case 1 '慢速重试
Thread.Sleep(500)
Return NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept)
Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上,才进行重试
Thread.Sleep(500)
Return NetGetCodeRequest(Url, Encode, 4000, IsJson, Accept)
Else
Throw RetryException
End If
End Select
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
Select Case RetryCount
Case 0
RetryException = ex
RetryCount += 1
GoTo Retry
Case 1
RetryCount += 1
GoTo Retry
Case Else
Throw
End Select
End Try
End Function
''' <summary>
''' 以 WebRequest 获取网页源代码或 Json。会逐渐生成 4 个尝试线程,并在 60s 后超时。
''' </summary>
''' <param name="Url">网页的 Url。</param>
''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
Public Function NetGetCodeByRequestMuity(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
Dim FailCount As Integer = 0
For i = 1 To 4
Dim th As New Thread(Sub()
Try
RequestResult = NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
th.Start()
Threads.Add(th)
Thread.Sleep(i * 250)
If RequestResult IsNot Nothing Then GoTo RequestFinished
Next
Do While True
If RequestResult IsNot Nothing Then
RequestFinished:
Try
For Each th In Threads
If th.IsAlive Then th.Interrupt()
Next
Catch
End Try
Return RequestResult
ElseIf FailCount = 4 Then
Try
For Each th In Threads
If th.IsAlive Then th.Interrupt()
Next
Catch
End Try
Throw RequestEx
End If
Thread.Sleep(20)
Loop
Throw New Exception("未知错误")
End Function
Private Function NetGetCodeRequest(Url As String, Encode As Encoding, Timeout As Integer, IsJson As Boolean, Accept As String)
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
Url = SecretCdnSign(Url)
Log("[Net] 获取网络结果:" & Url & ",最大超时 " & Timeout)
Dim Request As HttpWebRequest = WebRequest.Create(Url)
Dim Result As New List(Of Byte)
Try
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11
Request.Timeout = Timeout
Request.Accept = Accept
Request.KeepAlive = False
SecretHeadersSign(Url, Request)
Using res As HttpWebResponse = Request.GetResponse()
Using HttpStream As Stream = res.GetResponseStream()
HttpStream.ReadTimeout = Timeout
Dim HttpData As Byte() = New Byte(16384) {}
Using Reader As New StreamReader(HttpStream, If(Encode, Encoding.UTF8))
Dim ResultString As String = Reader.ReadToEnd
Return If(IsJson, GetJson(ResultString), ResultString)
End Using
End Using
End Using
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 & "")
Else
Throw New WebException("获取结果失败," & ex.Message & "" & Url & "", ex)
End If
Finally
Request.Abort()
End Try
End Function
''' <summary>
''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary>
''' <param name="Url">网页的 Url。</param>
Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid()
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson})})
Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(" & Url & "")
NetGetCodeByDownload = ReadFile(Temp)
File.Delete(Temp)
Finally
NewTask.Abort()
End Try
End Function
''' <summary>
''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary>
''' <param name="Urls">网页的 Url 列表。</param>
Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Urls(0).GetHashCode() & "_" & GetUuid()
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson})})
Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls(0) & "")
NetGetCodeByDownload = ReadFile(Temp)
File.Delete(Temp)
Finally
NewTask.Abort()
End Try
End Function
''' <summary>
''' 从网络中直接下载文件。这不能下载 CDN 中的文件。
''' </summary>
''' <param name="Url">网络 Url。</param>
''' <param name="LocalFile">下载的本地地址。</param>
Public Sub NetDownload(Url As String, LocalFile As String)
Log("[Net] 直接下载文件:" & Url)
'初始化
Try
'建立目录
Directory.CreateDirectory(GetPathFromFullPath(LocalFile))
'尝试删除原文件
File.Delete(LocalFile)
Catch ex As Exception
Throw New WebException("预处理下载文件路径失败(" & LocalFile & ")。", ex)
End Try
'下载
Using Client As New WebClient
Try
Client.DownloadFile(Url, LocalFile)
Catch ex As Exception
Throw New WebException("直接下载文件失败(" & Url & ")。", ex)
End Try
End Using
End Sub
''' <summary>
''' 发送一个网络请求并获取返回内容,会重试三次并在最长 45s 后超时。
''' </summary>
''' <param name="Url">请求的服务器地址。</param>
''' <param name="Method">请求方式POST 或 GET。</param>
''' <param name="Data">请求的内容。</param>
''' <param name="ContentType">请求的套接字类型。</param>
''' <param name="DontRetryOnRefused">当返回 40x 时不重试。</param>
Public Function NetRequestRetry(Url As String, Method As String, Data As Object, ContentType As String, Optional DontRetryOnRefused As Boolean = True, Optional Headers As Dictionary(Of String, String) = Nothing) As String
Dim RetryCount As Integer = 0
Dim RetryException As Exception = Nothing
Dim StartTime As Long = GetTimeTick()
Try
Retry:
Select Case RetryCount
Case 0 '正常尝试
Return NetRequestOnce(Url, Method, Data, ContentType, 15000, Headers)
Case 1 '慢速重试
Thread.Sleep(500)
Return NetRequestOnce(Url, Method, Data, ContentType, 25000, Headers)
Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上,才进行重试
Thread.Sleep(500)
Return NetRequestOnce(Url, Method, Data, ContentType, 4000, Headers)
Else
Throw RetryException
End If
End Select
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then RetryCount = 999
Select Case RetryCount
Case 0
If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败(" & Url & "")
RetryException = ex
RetryCount += 1
GoTo Retry
Case 1
If ModeDebug Then Log(ex, "[Net] 网络请求第二次失败(" & Url & "")
RetryCount += 1
GoTo Retry
Case Else
Throw
End Select
End Try
End Function
''' <summary>
''' 同时发送多个网络请求并要求返回内容。
''' </summary>
Public Function NetRequestMuity(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)
Dim Threads As New List(Of Thread)
Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing
Dim FailCount As Integer = 0
For i = 1 To RequestCount
Dim th As New Thread(Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
th.Start()
Threads.Add(th)
Thread.Sleep(i * 250)
If RequestResult IsNot Nothing Then GoTo RequestFinished
Next
Do While True
If RequestResult IsNot Nothing Then
RequestFinished:
For Each th In Threads
If th.IsAlive Then th.Interrupt()
Next
Return RequestResult
ElseIf FailCount = RequestCount Then
For Each th In Threads
If th.IsAlive Then th.Interrupt()
Next
Throw RequestEx
End If
Thread.Sleep(20)
Loop
Throw New Exception("未知错误")
End Function
''' <summary>
''' 发送一次网络请求并获取返回内容。
''' </summary>
Public Function NetRequestOnce(Url As String, Method As String, Data As Object, ContentType As String, Optional Timeout As Integer = 25000, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True) As String
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
Url = SecretCdnSign(Url)
If MakeLog Then Log("[Net] 发起网络请求(" & Method & "" & Url & "),最大超时 " & Timeout)
Dim DataStream As Stream = Nothing
Dim Resp As WebResponse = Nothing
Dim Req As HttpWebRequest
Try
Req = WebRequest.Create(New Uri(Url))
Req.Method = Method
Dim SendData As Byte()
If TypeOf Data Is Byte() Then
SendData = Data
Else
SendData = New UTF8Encoding(False).GetBytes(Data.ToString)
End If
If Headers IsNot Nothing Then
For Each Pair In Headers
Req.Headers.Add(Pair.Key, Pair.Value)
Next
End If
Req.ContentType = ContentType
Req.Timeout = Timeout
Req.KeepAlive = False
SecretHeadersSign(Url, Req)
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11
If Method = "POST" OrElse Method = "PUT" Then
Req.ContentLength = SendData.Length
DataStream = Req.GetRequestStream()
DataStream.WriteTimeout = Timeout
DataStream.ReadTimeout = Timeout
DataStream.Write(SendData, 0, SendData.Length)
DataStream.Close()
End If
Resp = Req.GetResponse()
DataStream = Resp.GetResponseStream()
DataStream.WriteTimeout = Timeout
DataStream.ReadTimeout = Timeout
Using Reader As New StreamReader(DataStream)
Return Reader.ReadToEnd()
End Using
Catch ex As ThreadInterruptedException
Throw
Catch ex As WebException
If ex.Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时,请检查你的网络环境是否良好(" & Url & "", ex)
Else
'获取请求失败的返回
Dim Res As String = ""
Try
If ex.Response Is Nothing Then Exit Try
DataStream = ex.Response.GetResponseStream()
DataStream.WriteTimeout = Timeout
DataStream.ReadTimeout = Timeout
Using Reader As New StreamReader(DataStream)
Res = Reader.ReadToEnd()
End Using
Catch
End Try
Throw New WebException("网络请求失败(" & Url & "" & ex.Message & "" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex)
End If
Catch ex As Exception
Throw New WebException("网络请求失败(" & Url & "", ex)
Finally
If DataStream IsNot Nothing Then DataStream.Dispose()
If Resp IsNot Nothing Then Resp.Dispose()
End Try
End Function
''' <summary>
''' 最大线程数。
''' </summary>
Public NetTaskThreadLimit As Integer
''' <summary>
''' 速度下限。
''' </summary>
Public NetTaskSpeedLimitLow As Long = 1024 * 1024L
''' <summary>
''' 速度上限。若无限制则为 -1。
''' </summary>
Public NetTaskSpeedLimitHigh As Long = -1
''' <summary>
''' 基于限速,当前可以下载的剩余量。
''' </summary>
Public NetTaskSpeedLimitLeft As Long = -1
Private ReadOnly NetTaskSpeedLimitLeftLock As New Object
Private NetTaskSpeedLimitLeftLast As Long
''' <summary>
''' 正在运行中的线程数。
''' </summary>
Public NetTaskThreadCount As Integer = 0
Private ReadOnly NetTaskThreadCountLock As New Object
''' <summary>
''' 下载源。
''' </summary>
Public Class NetSource
Public Id As Integer
Public Url As String
Public FailCount As Integer
Public Ex As Exception
Public Thread As NetThread
Public IsFailed As Boolean
Public Overrides Function ToString() As String
Return Url
End Function
End Class
''' <summary>
''' 下载进度标示。
''' </summary>
Public Enum NetState
''' <summary>
''' 尚未进行已存在检查。
''' </summary>
WaitForCheck = -1
''' <summary>
''' 尚未开始。
''' </summary>
WaitForDownload = 0
''' <summary>
''' 正在连接,尚未获取文件大小。
''' </summary>
Connect = 1
''' <summary>
''' 已获取文件大小,尚未有有效下载。
''' </summary>
[Get] = 2
''' <summary>
''' 正在下载。
''' </summary>
Download = 3
''' <summary>
''' 正在合并文件。
''' </summary>
Merge = 4
''' <summary>
''' 不进行下载,因为已发现现存的文件。
''' </summary>
WaitForCopy = 5
''' <summary>
''' 已完成。
''' </summary>
Finish = 6
''' <summary>
''' 已失败。
''' </summary>
[Error] = 7
End Enum
''' <summary>
''' 预下载检查行为。
''' </summary>
Public Enum NetPreDownloadBehaviour
''' <summary>
''' 当文件已存在时,显示提示以提醒用户是否继续下载。
''' </summary>
HintWhileExists
''' <summary>
''' 当文件已存在或正在下载时,直接退出下载函数执行,不对用户进行提示。
''' </summary>
ExitWhileExistsOrDownloading
''' <summary>
''' 不进行已存在检查。
''' </summary>
IgnoreCheck
End Enum
''' <summary>
''' 下载线程。
''' </summary>
Public Class NetThread
Implements IEnumerable(Of NetThread)
''' <summary>
''' 对应的下载任务。
''' </summary>
Public Task As NetFile
''' <summary>
''' 对应的线程。
''' </summary>
Public Thread As Thread
''' <summary>
''' 链表中的下一个线程。
''' </summary>
Public NextThread As NetThread
Private ReadOnly Iterator Property [Next]() As IEnumerable(Of NetThread)
Get
Dim CurrentChain As NetThread = Me
While CurrentChain IsNot Nothing
Yield CurrentChain
CurrentChain = CurrentChain.NextThread
End While
End Get
End Property
Public Function GetEnumerator() As IEnumerator(Of NetThread) Implements IEnumerable(Of NetThread).GetEnumerator
Return [Next].GetEnumerator()
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return [Next].GetEnumerator()
End Function
''' <summary>
''' 分配给任务中每个线程(无论其是否失败)的编号。
''' </summary>
Public Uuid As Integer
''' <summary>
''' 是否为第一个线程。
''' </summary>
Public ReadOnly Property IsFirstThread As Boolean
Get
Return DownloadStart = 0 AndAlso Task.FileSize = -2
End Get
End Property
''' <summary>
''' 该线程的缓存文件。
''' </summary>
Public Temp As String
''' <summary>
''' 线程下载起始位置。
''' </summary>
Public DownloadStart As Long
''' <summary>
''' 线程下载结束位置。
''' </summary>
Public ReadOnly Property DownloadEnd As Long
Get
SyncLock Task.LockChain
If NextThread Is Nothing Then
If Task.IsUnknownSize Then
Return 1024 * 1024 * 1024 '1G
Else
Return Task.FileSize - 1
End If
Else
Return NextThread.DownloadStart - 1
End If
End SyncLock
End Get
End Property
''' <summary>
''' 线程未下载的文件大小。
''' </summary>
Public ReadOnly Property DownloadUndone As Long
Get
Return DownloadEnd + 1 - (DownloadStart + DownloadDone)
End Get
End Property
''' <summary>
''' 线程已下载的文件大小。
''' </summary>
Public DownloadDone As Long = 0
''' <summary>
''' 上次记速时的时间。
''' </summary>
Private SpeedLastTime As Long = GetTimeTick()
''' <summary>
''' 上次记速时的已下载大小。
''' </summary>
Private SpeedLastDone As Long = 0
''' <summary>
''' 当前的下载速度,单位为 Byte / 秒。
''' </summary>
Public ReadOnly Property Speed As Long
Get
If GetTimeTick() - SpeedLastTime > 200 Then
Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime
_Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
SpeedLastDone = DownloadDone
SpeedLastTime += DeltaTime
End If
Return _Speed
End Get
End Property
Private _Speed As Long = 0
''' <summary>
''' 线程初始化时的时间。
''' </summary>
Public InitTime As Long = GetTimeTick()
''' <summary>
''' 上次接受到有效数据的时间,-1 表示尚未有有效数据。
''' </summary>
Public LastReceiveTime As Long = -1
''' <summary>
''' 当前线程的状态。
''' </summary>
Public State As NetState = NetState.WaitForDownload
''' <summary>
''' 是否已经结束。
''' </summary>
Public ReadOnly Property IsEnded As Boolean
Get
Return State = NetState.Finish OrElse State = NetState.Error
End Get
End Property
''' <summary>
''' 当前选取的是哪一个 Url。
''' </summary>
Public Source As NetSource
End Class
''' <summary>
''' 下载单个文件。
''' </summary>
Public Class NetFile
#Region "属性"
''' <summary>
''' 所属的文件列表任务。
''' </summary>
Public Tasks As New List(Of LoaderDownload)
''' <summary>
''' 所有下载源。
''' </summary>
Public Sources As NetSource()
''' <summary>
''' 用于在第一个线程出错时切换下载源。
''' </summary>
Private FirstThreadSource As Integer = 0
''' <summary>
''' 所有已经被标记为失败的,但未完整尝试过的,不允许断点续传的下载源。
''' </summary>
Public SourcesOnce As New List(Of NetSource)
''' <summary>
''' 获取从某个源开始,第一个可用的源。
''' </summary>
Private Function GetSource(Optional Id As Integer = 0) As NetSource
If Id >= Sources.Count OrElse Id < 0 Then Id = 0
SyncLock LockSource
If Not IsSourceFailed(False) Then
'存在多线程可用源
Dim CurrentSource As NetSource = Sources(Id)
While CurrentSource.IsFailed
Id += 1
If Id >= Sources.Count Then Id = 0
CurrentSource = Sources(Id)
End While
Return CurrentSource
ElseIf SourcesOnce.Count > 0 Then
'仅存在单线程可用源
Return SourcesOnce(0)
Else
'没有可用源
Return Nothing
End If
End SyncLock
End Function
''' <summary>
''' 是否已经没有可用源了。
''' </summary>
Public Function IsSourceFailed(Optional AllowOnceSource As Boolean = True) As Boolean
If AllowOnceSource AndAlso SourcesOnce.Count > 0 Then Return False
SyncLock LockSource
For Each Source As NetSource In Sources
If Not Source.IsFailed Then Return False
Next
End SyncLock
Return True
End Function
''' <summary>
''' 存储在本地的带文件名的地址。
''' </summary>
Public LocalPath As String = Nothing
''' <summary>
''' 存储在本地的文件名。
''' </summary>
Public LocalName As String = Nothing
''' <summary>
''' 当前的下载状态。
''' </summary>
Public State As NetState = NetState.WaitForCheck
''' <summary>
''' 导致下载失败的原因。
''' </summary>
Public Ex As New List(Of Exception)
'''' <summary>
'''' 文件进行整体重试的计数。
'''' </summary>
'Private RetryCount As Integer = 0
''' <summary>
''' 作为文件组成部分的线程链表。
''' </summary>
Private Threads As NetThread
''' <summary>
''' 文件的总大小。若为 -2 则为未获取,若为 -1 则为无法获取准确大小。
''' </summary>
Public FileSize As Long = -2
''' <summary>
''' 该文件是否无法获取准确大小。
''' </summary>
Public IsUnknownSize As Boolean = False
''' <summary>
''' 该文件是否不需要分割。
''' </summary>
Public ReadOnly Property IsNoSplit As Boolean
Get
Return IsUnknownSize OrElse FileSize < FilePieceLimit
End Get
End Property
''' <summary>
''' 为不需要分割的小文件进行临时存储。
''' </summary>
Private SmailFileCache As List(Of Byte)
''' <summary>
''' 文件的已下载大小。
''' </summary>
Public DownloadDone As Long = 0
Private ReadOnly LockDone As New Object
''' <summary>
''' 文件的校验规则。
''' </summary>
Public Check As FileChecker
''' <summary>
''' 上次记速时的时间。
''' </summary>
Private SpeedLastTime As Long = GetTimeTick()
''' <summary>
''' 上次记速时的已下载大小。
''' </summary>
Private SpeedLastDone As Long = 0
''' <summary>
''' 当前的下载速度,单位为 Byte / 秒。
''' </summary>
Public ReadOnly Property Speed As Long
Get
If GetTimeTick() - SpeedLastTime > 200 Then
Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime
_Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
SpeedLastDone = DownloadDone
SpeedLastTime += DeltaTime
End If
Return _Speed
End Get
End Property
Private _Speed As Long = 0
''' <summary>
''' 该文件是否由本地文件直接拷贝完成。
''' </summary>
Public IsCopy As Boolean = False
''' <summary>
''' 本文件的显示进度。
''' </summary>
Public ReadOnly Property Progress As Double
Get
Select Case State
Case NetState.WaitForCheck
Return 0
Case NetState.WaitForCopy
Return 0.2
Case NetState.WaitForDownload
Return 0.01
Case NetState.Connect
Return 0.02
Case NetState.Get
Return 0.04
Case NetState.Download
'正在下载中,对应 5% ~ 99%
Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1))
OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9
Return OriginalProgress * 0.94 + 0.05
Case NetState.Merge
Return 0.99
Case NetState.Finish, NetState.Error
Return 1
Case Else
Throw New ArgumentOutOfRangeException("文件状态未知:" & State)
End Select
End Get
End Property
''' <summary>
''' 各个线程建立连接成功的总次数。
''' </summary>
Private ConnectCount As Integer = 0
''' <summary>
''' 各个线程建立连接成功的总时间。
''' </summary>
Private ConnectTime As Long = 0
''' <summary>
''' 各个线程建立连接成功的平均时间,单位为毫秒,-1 代表尚未有成功连接。
''' </summary>
Private ReadOnly Property ConnectAverage As Integer
Get
SyncLock LockCount
Return If(ConnectCount = 0, -1, ConnectTime / ConnectCount)
End SyncLock
End Get
End Property
Private Const FilePieceLimit As Long = 256 * 1024
Public ReadOnly RandomCode As Integer = RandomInteger(0, 999999)
Public ReadOnly LockCount As New Object
Public ReadOnly LockState As New Object
Public ReadOnly LockChain As New Object
Public ReadOnly LockSource As New Object
Public ReadOnly LockTasks As New Object
Private ReadOnly Uuid As Integer = GetUuid()
Public Overrides Function Equals(obj As Object) As Boolean
Dim file = TryCast(obj, NetFile)
Return file IsNot Nothing AndAlso Uuid = file.Uuid
End Function
#End Region
''' <summary>
''' 新建一个需要下载的文件。
''' </summary>
''' <param name="LocalPath">包含文件名的本地地址。</param>
Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing)
Dim Sources As New List(Of NetSource)
Dim Count As Integer = 0
Urls = ArrayNoDouble(Urls)
For Each Source As String In Urls
Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing})
Count += 1
Next
Me.Sources = Sources.ToArray
Me.LocalPath = LocalPath
Me.Check = Check
Me.LocalName = GetFileNameFromPath(LocalPath)
End Sub
''' <summary>
''' 尝试开始一个新的下载线程。
''' </summary>
Public Function TryBeginThread() As Boolean
Try
'条件检测
If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return False
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return False
SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect
End SyncLock
'初始化参数
Dim StartPosition As Long, StartSource As NetSource = Nothing
Dim Th As Thread, ThreadInfo As NetThread
SyncLock LockChain
'获取线程起点与下载源
'不分割
If IsNoSplit Then GoTo Capture
'单线程
If IsSourceFailed(False) Then
'确认没有其他线程正使用此点
If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return False
'占用此点
Capture:
SmailFileCache = Nothing
Threads = Nothing
NetManager.DownloadDone -= DownloadDone
SyncLock LockDone
DownloadDone = 0
End SyncLock
SpeedLastDone = 0
State = NetState.Get
End If
'首个开始点
If Threads Is Nothing Then
StartPosition = 0
StartSource = GetSource(FirstThreadSource)
If StartSource Is Nothing Then
'没有可用源了
Throw New Exception("无可用源,请反馈此问题。")
Else
'有可用源
FirstThreadSource = StartSource.Id + 1
GoTo StartThread
End If
End If
'寻找失败点
For Each Thread As NetThread In Threads
If Thread.State = NetState.Error AndAlso Thread.DownloadUndone > 0 Then
StartPosition = Thread.DownloadStart + Thread.DownloadDone
StartSource = GetSource(Thread.Source.Id + 1)
GoTo StartThread
End If
Next
'是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") Then Return False
Dim RealFilePieceLimit = If(TargetUrl.Contains("download.mcbbs.net"), FilePieceLimit * 5, FilePieceLimit)
'寻找最大碎片
Dim FilePieceMax As NetThread = Threads
For Each Thread As NetThread In Threads
If Thread.DownloadUndone > FilePieceMax.DownloadUndone Then FilePieceMax = Thread
Next
If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < RealFilePieceLimit Then Return False
StartPosition = FilePieceMax.DownloadEnd - FilePieceMax.DownloadUndone * 0.4
StartSource = GetSource()
'开始线程
StartThread:
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return False
'构建线程
Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks
If Tasks.Count = 0 Then Return False '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal}
End SyncLock
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
Threads = ThreadInfo
Else
Dim CurrentChain As NetThread = Threads
While CurrentChain.DownloadEnd <= StartPosition
CurrentChain = CurrentChain.NextThread
End While
ThreadInfo.NextThread = CurrentChain.NextThread
CurrentChain.NextThread = ThreadInfo
End If
End SyncLock
'开始线程
SyncLock NetTaskThreadCountLock
NetTaskThreadCount += 1
End SyncLock
SyncLock LockSource
If IsSourceFailed(False) Then SourcesOnce(0).Thread = ThreadInfo
End SyncLock
Th.Start(ThreadInfo)
Return True
Catch ex As Exception
Log(ex, "尝试开始下载线程失败(" & If(LocalName, "Nothing") & "", LogLevel.Hint)
Return False
End Try
End Function
''' <summary>
''' 每个下载线程执行的代码。
''' </summary>
Private Sub Thread(Info As NetThread)
If ModeDebug OrElse Info.DownloadStart = 0 Then Log("[Download] " & LocalName & " " & Info.Uuid & "#:开始,起始点 " & Info.DownloadStart & "" & Info.Source.Url)
Dim HttpRequest As HttpWebRequest
Dim ResultStream As Stream = Nothing
'部分下载源真的特别慢,并且只需要一个请求,例如 Ping 为 20s如果增长太慢就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟
'延迟过长会导致某些特别慢的链接迟迟不被掐死,即使 MCBBS 源在 10s 下也会出现类似情况
Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Info.Source.FailCount), 30000)
Info.State = NetState.Connect
Try
Dim HttpDataCount As Integer = 0
If SourcesOnce.Contains(Info.Source) AndAlso Not Info.Equals(Info.Source.Thread) Then GoTo SourceBreak
'请求头
HttpRequest = WebRequest.Create(Info.Source.Url)
If Info.Source.Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then HttpRequest.ProtocolVersion = HttpVersion.Version11
'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
HttpRequest.Timeout = Timeout
HttpRequest.AddRange(Info.DownloadStart)
SecretHeadersSign(Info.Source.Url, HttpRequest)
Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
'文件大小校验
Dim ThreadFileSize = HttpResponse.ContentLength
If ThreadFileSize = -1 Then
If FileSize > 1 Then
Log("[Download] " & LocalName & " " & Info.Uuid & "#:文件大小未知,但已从其他下载源获取,不作处理")
Else
FileSize = -1 : IsUnknownSize = True
Log("[Download] " & LocalName & " " & Info.Uuid & "#:文件大小未知")
End If
ElseIf ThreadFileSize < 0 Then
Throw New Exception("获取片大小失败,结果为 " & ThreadFileSize & "")
ElseIf Info.IsFirstThread Then
If Check IsNot Nothing Then
If ThreadFileSize < Check.MinSize AndAlso Check.MinSize > 0 Then
Throw New Exception("文件大小不足,获取结果为 " & ThreadFileSize & ",要求至少为 " & Check.MinSize & "")
End If
If ThreadFileSize <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
Throw New Exception("文件大小不一致,获取结果为 " & ThreadFileSize & ",要求必须为 " & Check.ActualSize & "")
End If
End If
FileSize = ThreadFileSize : IsUnknownSize = False
Log("[Download] " & LocalName & ":文件大小 " & ThreadFileSize & " B" & "" & GetString(ThreadFileSize) & "")
'若文件大小大于 50 M进行剩余磁盘空间校验
If ThreadFileSize > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
Dim DriveName As String = Drive.Name.First.ToString
Dim RequiredSpace = If(PathTemp.StartsWith(DriveName), ThreadFileSize * 1.1, 0) +
If(LocalPath.StartsWith(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0)
If Drive.TotalFreeSpace < RequiredSpace Then
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "" &
If(PathTemp.StartsWith(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
End If
Next
End If
ElseIf FileSize < 0 Then
Throw New Exception("非首线程运行时,尚未获取文件大小。")
ElseIf Info.DownloadStart > 0 AndAlso ThreadFileSize = FileSize Then
SyncLock LockSource
If SourcesOnce.Contains(Info.Source) Then
GoTo SourceBreak
Else
SourcesOnce.Add(Info.Source)
End If
End SyncLock
Throw New WebException("该下载源不支持断点续传。")
ElseIf Not FileSize - Info.DownloadStart = ThreadFileSize Then
Throw New WebException("获取到的片大小不一致:线程结果为 " & ThreadFileSize & " B任务结果为 " & FileSize & "B起点为 " & Info.DownloadStart & "B。")
End If
Info.State = NetState.Get
SyncLock LockState
If State < NetState.Get Then State = NetState.Get
End SyncLock
'创建缓存文件
If IsNoSplit Then
Info.Temp = Nothing
SmailFileCache = New List(Of Byte)
Else
Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp"
ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
End If
'开始下载
Using HttpStream = HttpResponse.GetResponseStream()
HttpStream.ReadTimeout = Timeout
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
Dim HttpData As Byte() = New Byte(16384) {}
HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
While (IsUnknownSize OrElse Info.DownloadUndone > 0) AndAlso '判断是否下载完成
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread))
'限速
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
Threading.Thread.Sleep(16)
End While
Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Info.DownloadUndone))
SyncLock NetTaskSpeedLimitLeftLock
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
End SyncLock
Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime
If DeltaTime > 1000000 Then DeltaTime = 0 '时间刻反转导致出现极大值
If RealDataCount > 0 Then
'有数据
If Info.DownloadDone = 0 Then
'第一次接受到数据
Info.State = NetState.Download
SyncLock LockState
If State < NetState.Download Then State = NetState.Download
End SyncLock
SyncLock LockCount
ConnectCount += 1
ConnectTime += GetTimeTick() - Info.InitTime
End SyncLock
End If
SyncLock LockCount
Info.Source.FailCount = 0
SyncLock LockTasks
For Each Task In Tasks
Task.FailCount = 0
Next
End SyncLock
End SyncLock
NetManager.DownloadDone += RealDataCount
SyncLock LockDone
DownloadDone += RealDataCount
End SyncLock
Info.DownloadDone += RealDataCount
If IsNoSplit Then
If HttpData.Count = RealDataCount Then
SmailFileCache.AddRange(HttpData)
Else
SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount))
End If
Else
ResultStream.Write(HttpData, 0, RealDataCount)
End If
'检查速度是否过慢
If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s且速度小于 1K/s
Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B消耗 " & DeltaTime & " ms。")
End If
Info.LastReceiveTime = GetTimeTick()
'已完成
If Info.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
ElseIf Info.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
'无数据,且已超时
Throw New TimeoutException("操作超时,无数据。")
End If
HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
End While
End Using
End Using
SourceBreak:
If HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception("服务器无返回数据,但下载尚未完成")
ElseIf State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
'被外部中断
Info.State = NetState.Error
Log("[Download] " & LocalName & " " & Info.Uuid & "#:中断")
Else
'本线程完成
Info.State = NetState.Finish
If ModeDebug Then Log("[Download] " & LocalName & " " & Info.Uuid & "#:完成,已下载 " & GetString(Info.DownloadDone))
End If
Catch ex As Exception
'状态变更
SyncLock LockCount
Info.Source.FailCount += 1
SyncLock LockTasks
For Each Task In Tasks
Task.FailCount += 1
Next
End SyncLock
End SyncLock
Dim IsTimeoutString As String = GetString(ex, False).ToLower.Replace(" ", "")
Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
IsTimeoutString.Contains("超时") OrElse IsTimeoutString.Contains("timeout") OrElse IsTimeoutString.Contains("timedout")
Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#:超时(" & (Timeout * 0.001) & "s", "#:出错," & GetString(ex, False)))
Info.State = NetState.Error
''使用该下载源的线程是否没有速度
''下载超时也会导致没有速度,容易误判下载失败,所以已弃用此方法
'Dim IsNoSpeed As Boolean = True
'SyncLock LockChain
' If Threads IsNot Nothing Then
' For Each Thread As NetThread In Threads
' If Thread.Source.Id = Info.Source.Id AndAlso Thread.Speed > 0 Then
' IsNoSpeed = False
' Exit For
' End If
' Next
' End If
'End SyncLock
Info.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(403)") OrElse ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
(Info.Source.FailCount >= MathRange(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit Then
Dim IsThisFail As Boolean = False
SyncLock LockSource
If Info.Source.Thread IsNot Nothing AndAlso Info.Source.Thread.Equals(Info) Then
'单线程下,本线程出错
SourcesOnce.RemoveAt(0)
GoTo Wrong
ElseIf Not Info.Source.IsFailed Then
'多线程下,本线程出错
Wrong:
Info.Source.IsFailed = True
IsThisFail = True
End If
End SyncLock
'本线程引发下载源被禁用
If IsThisFail Then
Log("[Download] " & LocalName & " " & Uuid & "#:下载源被禁用(" & Info.Source.Id & "" & Info.Source.Url)
Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持断点续传") OrElse ex.Message.Contains("404") OrElse ex.Message.Contains("416"), LogLevel.Developer, LogLevel.Debug))
If IsSourceFailed() Then
'没有可用源
Log("[Download] 文件 " & LocalName & " 已无可用下载源")
Dim ExampleEx As Exception = Nothing
SyncLock LockSource
For Each Source As NetSource In Sources
Log("[Download] 已禁用的下载源:" & Source.Url)
If Source.Ex IsNot Nothing Then
ExampleEx = Source.Ex
Log(Source.Ex, "下载源禁用原因", LogLevel.Developer)
End If
Next
End SyncLock
Fail(ExampleEx)
ElseIf ex.Message.Contains("空间不足") Then
'没有空间
Fail(ex)
End If
End If
End If
'首线程错误
If FileSize = -2 Then
SyncLock LockChain
Threads = Nothing
End SyncLock
End If
Finally
If ResultStream IsNot Nothing Then ResultStream.Dispose()
SyncLock NetTaskThreadCountLock
NetTaskThreadCount -= 1
End SyncLock
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
End Try
End Sub
'下载文件的最终收束事件
''' <summary>
''' 下载完成。合并文件。
''' </summary>
Private Sub Merge()
'状态判断
SyncLock LockState
If State < NetState.Merge Then
State = NetState.Merge
Else
Exit Sub
End If
End SyncLock
Dim RetryCount As Integer = 0
Dim MergeFile As Stream = Nothing, AddWriter As BinaryWriter = Nothing
Try
Retry:
SyncLock LockChain
''大小检测
'If DownloadDone <> FileSize AndAlso Not IsUnknownSize Then
' For Each Th As NetThread In Threads
' Log("[Download] " & "File size detail: ")
' Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone)
' Next
' Throw New Exception("文件大小应为 " & FileSize & " B实际下载为 " & DownloadDone & " B。")
'End If
If ModeDebug Then Log("[Download] " & LocalName & ":正在合并文件")
'创建文件夹
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Dim Info As New FileInfo(LocalPath)
Info.Directory.Create()
'合并文件
If IsNoSplit Then
'仅有一个线程,从缓存中输出
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
AddWriter.Write(SmailFileCache.ToArray)
AddWriter.Dispose() : AddWriter = Nothing
MergeFile.Dispose() : MergeFile = Nothing
ElseIf Threads.DownloadDone = DownloadDone Then
'仅有一个文件,直接复制
File.Copy(Threads.Temp, LocalPath, True)
Else
'有多个线程,合并
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
For Each Thread As NetThread In Threads
If Thread.DownloadDone = 0 Then Continue For
Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read)
Dim TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(fs.Length))
TempReader.Close()
End Using
Next
AddWriter.Dispose() : AddWriter = Nothing
MergeFile.Dispose() : MergeFile = Nothing
End If
'写入大小要求
If Not IsUnknownSize AndAlso Check IsNot Nothing Then
If Check.ActualSize = -1 Then
Check.ActualSize = FileSize
ElseIf Check.ActualSize <> FileSize Then
Throw New Exception("文件大小不一致:任务要求为 " & Check.ActualSize & " B网络获取结果为 " & FileSize & "B")
End If
End If
'检查文件
Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then
Log("[Download] " & "File size detail of " & Uuid & "# :")
For Each Th As NetThread In Threads
Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone)
Next
Throw New Exception(CheckResult)
End If
'后处理
If IsNoSplit Then
SmailFileCache = Nothing
Else
For Each Thread As NetThread In Threads
If Thread.Temp IsNot Nothing Then File.Delete(Thread.Temp)
Next
End If
Finish()
End SyncLock
Catch ex As Exception
Log(ex, "合并文件出错(" & LocalName & "")
If MergeFile IsNot Nothing Then
MergeFile.Dispose() : MergeFile = Nothing
End If
If AddWriter IsNot Nothing Then
AddWriter.Dispose() : AddWriter = Nothing
End If
'重试
If RetryCount <= 3 Then
Threading.Thread.Sleep(RandomInteger(500, 1000))
RetryCount += 1
GoTo Retry
End If
Fail(ex)
End Try
End Sub
''' <summary>
''' 下载失败。
''' </summary>
Private Sub Fail(Optional RaiseEx As Exception = Nothing)
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉
State = NetState.Error
End SyncLock
Try
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Catch
End Try
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
Log("[Download] " & LocalName & ":已失败,剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
For Each Task In Tasks
Task.OnFileFail(Me)
Next
End Sub
''' <summary>
''' 下载中断。
''' </summary>
Public Sub Abort(CausedByTask As LoaderDownload)
'确认任务移除
SyncLock LockTasks
Tasks.Remove(CausedByTask)
If Tasks.Count > 0 Then Exit Sub
End SyncLock
'确认中断
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
State = NetState.Error
End SyncLock
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
If ModeDebug Then Log("[Download] " & LocalName & ":已取消,剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
End Sub
'状态改变接口
''' <summary>
''' 将该文件设置为已下载完成。
''' </summary>
Public Sub Finish(Optional PrintLog As Boolean = True)
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
State = NetState.Finish
End SyncLock
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
SyncLock LockTasks
For Each Task In Tasks
Task.OnFileFinish(Me)
Next
End SyncLock
End Sub
End Class
''' <summary>
''' 下载一系列文件的加载器。
''' </summary>
Public Class LoaderDownload
Inherits LoaderBase
#Region "属性"
''' <summary>
''' 需要下载的文件。
''' </summary>
Public Files As List(Of NetFile)
Private ReadOnly FilesLock As New Object
''' <summary>
''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用)
''' </summary>
Private FileRemain As Integer
Private ReadOnly FileRemainLock As New Object
''' <summary>
''' 用于显示的百分比进度。
''' </summary>
Public Overrides Property Progress As Double
Get
If State >= LoadState.Finished Then Return 1
If Files.Count = 0 Then Return 0 '必须返回 0否则在获取列表的时候会错觉已经下载完了
Return _Progress
End Get
Set(value As Double)
Throw New Exception("文件下载不允许指定进度")
End Set
End Property
Private _Progress As Double = 0
''' <summary>
''' 任务中的文件的连续失败计数。
''' </summary>
Public Property FailCount As Integer
Get
Return _FailCount
End Get
Set(value As Integer)
_FailCount = value
If State = LoadState.Loading AndAlso value >= Math.Min(2000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then
Log("[Download] 由于同加载器中失败次数过多引发强制失败:连续失败了 " & value & "", LogLevel.Debug)
On Error Resume Next
Dim ExList As New List(Of Exception)
SyncLock FilesLock
For Each File In Files
For Each Source In File.Sources
If Source.Ex IsNot Nothing Then
ExList.Add(Source.Ex)
If ExList.Count > 10 Then GoTo FinishExCatch
End If
Next
Next
End SyncLock
FinishExCatch:
OnFail(ExList)
End If
End Set
End Property
Private _FailCount As Integer = 0
#End Region
''' <summary>
''' 刷新公开属性。由 NetManager 每 0.2 秒调用一次。
''' </summary>
Public Sub RefreshStat()
'计算进度
Dim NewProgress As Double = 0
Dim TotalProgress As Double = 0
SyncLock FilesLock
For Each File In Files
If File.IsCopy Then
NewProgress += File.Progress * 0.2
TotalProgress += 0.2
Else
NewProgress += File.Progress '* If(File.Progress < 1, 0.9, 1)
TotalProgress += 1
End If
Next
End SyncLock
If TotalProgress > 0 Then NewProgress /= TotalProgress
'刷新进度
If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 1 - (1 - NewProgress) ^ 0.9 'MathBezier(NewProgress, 0, 0.05, 1, 0.8, 0.0001)
_Progress = NewProgress * 0.99 + 0.01
End Sub
Public Sub New(Name As String, FileTasks As List(Of NetFile))
Me.Name = Name
Files = FileTasks
End Sub
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
SyncLock FilesLock
If Input IsNot Nothing Then Files = Input
'去重
Dim ResultArray As New List(Of NetFile)
For i = 0 To Files.Count - 1
For ii = i + 1 To Files.Count - 1
If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
Next
ResultArray.Add(Files(i))
NextElement:
Next i
Files = ResultArray
'设置剩余文件数
SyncLock FileRemainLock
For Each File In Files
If File.State <> NetState.Finish Then FileRemain += 1
Next
End SyncLock
End SyncLock
State = LoadState.Loading
'开始执行
RunInNewThread(Sub()
Try
'输入检测
If Files.Count = 0 Then
OnFinish()
Exit Sub
End If
For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
For Each Source As NetSource In File.Sources
If Not (Source.Url.ToLower.StartsWith("https://") OrElse Source.Url.ToLower.StartsWith("http://")) Then
Source.Ex = New ArgumentException("输入的下载链接不正确!")
Source.IsFailed = True
End If
Next
If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确!")
If File.LocalPath.EndsWith("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
'文件夹检测
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
Next
'接入下载管理器
NetManager.Start(Me)
'将文件分配给多个线程以进行已存在查找
Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
Dim FoldersFinal As New List(Of String) '最终用于查找的列表
If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹,因为 HMCL 会把所有文件存在这里
For Each Folder In McFolderList
Folders.Add(Folder.Path)
Next
Folders = ArrayNoDouble(Folders)
For Each Folder In Folders
If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
Next
End If
'最多 5 个线程,最少每个线程分配 10 个文件
SyncLock FilesLock
Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
Dim FilesInThread As New List(Of NetFile)
For Each File In Files
FilesInThread.Add(File)
If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
Next
If FilesInThread.Count > 0 Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
End SyncLock
Catch ex As Exception
OnFail(New List(Of Exception) From {ex})
End Try
End Sub, "NetTask " & Uuid & " Main")
End Sub
Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String))
Try
If ModeDebug Then Log("[Download] 检查线程分配文件数:" & Files.Count)
'试图从已存在的 Minecraft 文件夹中寻找目标文件
Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
For Each File As NetFile In Files
Dim ExistFilePath As String = Nothing
'判断是否有已存在的文件
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWith(PathMcFolder) Then
Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
For Each Folder In FolderList
Dim Target = Folder & Relative
If File.Check.Check(Target) Is Nothing Then
ExistFilePath = Target
Exit For
End If
Next
End If
'若存在,则改变状态
SyncLock LockState
If ExistFilePath IsNot Nothing Then
File.State = NetState.WaitForCopy
File.IsCopy = True
ExistFiles.Add(New KeyValuePair(Of NetFile, String)(File, ExistFilePath))
Else
File.State = NetState.WaitForDownload
File.IsCopy = False
End If
End SyncLock
Next
'复制已存在的文件
For Each FileToken In ExistFiles
Dim File As NetFile = FileToken.Key
Dim LocalPath As String = FileToken.Value
Dim RetryCount As Integer = 0
Retry:
Try
Log("[Download] 复制已存在的文件(" & LocalPath & "")
FileIO.FileSystem.CopyFile(LocalPath, File.LocalPath, True)
File.Finish(False)
Catch ex As Exception
RetryCount += 1
Log(ex, String.Format("复制已存在的文件失败,重试第 {2} 次({0} -> {1}", LocalPath, File.LocalPath, RetryCount))
If RetryCount < 3 Then
Thread.Sleep(200)
GoTo Retry
End If
File.State = NetState.WaitForDownload
File.IsCopy = False
End Try
Next
Catch ex As Exception
Log(ex, "下载已存在文件查找失败", LogLevel.Feedback)
End Try
End Sub
Public Sub OnFileFinish(File As NetFile)
'要求全部文件完成
SyncLock FileRemainLock
FileRemain -= 1
If FileRemain > 0 Then Exit Sub
End SyncLock
OnFinish()
End Sub
Public Sub OnFinish()
RaisePreviewFinish()
SyncLock LockState
If State > LoadState.Loading Then Exit Sub
State = LoadState.Finished
End SyncLock
End Sub
Public Sub OnFileFail(File As NetFile)
'将下载源的错误加入主错误列表
For Each Source In File.Sources
If Not IsNothing(Source.Ex) Then File.Ex.Add(Source.Ex)
Next
OnFail(File.Ex)
End Sub
Public Sub OnFail(ExList As List(Of Exception))
SyncLock LockState
If State > LoadState.Loading Then Exit Sub
If ExList Is Nothing OrElse ExList.Count = 0 Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
[Error] = ExList(0)
'获取实际失败的文件
SyncLock FilesLock
For Each File In Files
If File.State = NetState.Error Then
[Error] = New Exception("文件下载失败:" & File.LocalPath & "(第一下载源:" & File.Sources(0).Url & "", ExList(0))
Exit For
End If
Next
End SyncLock
'在设置 Error 对象后再更改为失败,避免 WaitForExit 无法捕获错误
State = LoadState.Failed
End SyncLock
'中断所有文件
SyncLock FilesLock
For Each TaskFile In Files
If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error
Next
End SyncLock
'在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList
ErrOutput.Add(GetString(Ex, False))
Next
Log("[Download] " & Join(ArrayNoDouble(ErrOutput.ToArray), vbCrLf))
End Sub
Public Overrides Sub Abort()
SyncLock LockState
If State >= LoadState.Finished Then Exit Sub
State = LoadState.Aborted
End SyncLock
Log("[Download] " & Name & " 已取消!")
'中断所有文件
SyncLock FilesLock
For Each TaskFile In Files
TaskFile.Abort(Me)
Next
End SyncLock
End Sub
End Class
Public NetManager As New NetManagerClass
''' <summary>
''' 下载文件管理。
''' </summary>
Public Class NetManagerClass
#Region "属性"
''' <summary>
''' 需要下载的文件。为“本地地址 - 文件对象”键值对。
''' </summary>
Public Files As New Dictionary(Of String, NetFile)
Public ReadOnly LockFiles As New Object
''' <summary>
''' 当前的所有下载任务。
''' </summary>
Public Tasks As New List(Of LoaderDownload)
Private ReadOnly LockTasks As New Object
''' <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
''' <summary>
''' 尚未完成下载的文件数。
''' </summary>
Public FileRemain As Integer = 0
Public ReadOnly LockRemain As New Object
''' <summary>
''' 上次记速时的已下载大小。
''' </summary>
Private SpeedLastDone As Long = 0
''' <summary>
''' 最近 10 次下载速度的记录,较新的在后面。间隔为 0.2 秒,故记录了 2 秒的速度。
''' </summary>
Public SpeedLast As New List(Of Long) From {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
'这些属性由 RefreshStat 刷新
''' <summary>
''' 当前的全局下载速度,单位为 Byte / 秒。
''' </summary>
Public Speed As Long = 0
Public ReadOnly Uuid As Integer = GetUuid()
#End Region
''' <summary>
''' 进度与下载速度由下载管理线程每隔约 0.2 秒刷新一次。
''' </summary>
Private Sub RefreshStat()
Try
Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
RefreshStatLast += DeltaTime
#Region "刷新整体速度"
'计算即时速度
Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000))
SpeedLast.Add(ActualSpeed)
SpeedLast.RemoveAt(0)
SpeedLastDone = DownloadDone
'计算用于显示的速度
'If SpeedLast(9) = 0 Then
' Speed = 0
'Else
Speed = (SpeedLast(9) + SpeedLast(8) * 0.9 + SpeedLast(7) * 0.8 + SpeedLast(6) * 0.7 + SpeedLast(5) * 0.6 + SpeedLast(4) * 0.5 + SpeedLast(3) * 0.4 + SpeedLast(2) * 0.3 + SpeedLast(1) * 0.2 + SpeedLast(0) * 0.1) / 5.5
'End If
'计算新的速度下限
SpeedLast.Add(ActualSpeed)
SpeedLast.RemoveAt(0)
Dim Limit As Long = Math.Min(Math.Min(Math.Min(Math.Min(SpeedLast(5), SpeedLast(6)), SpeedLast(7)), SpeedLast(8)), SpeedLast(9)) * 0.9
If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit
Log("[Download] " & "速度下限已提升到 " & GetString(Limit))
End If
#End Region
#Region "刷新下载任务属性"
SyncLock LockTasks
For Each Task In Tasks
Task.RefreshStat()
Next
End SyncLock
#End Region
Catch ex As Exception
Log(ex, "刷新下载公开属性失败")
End Try
End Sub
Private RefreshStatLast As Long
''' <summary>
''' 启动监控线程,用于新增下载线程。
''' </summary>
Private Sub StartManager()
If IsManagerStarted Then Exit Sub
IsManagerStarted = True
RunInNewThread(Sub()
Try
Dim LastLoopTime As Long
While True
LastLoopTime = GetTimeTick()
'若已完成,则清空
If FileRemain = 0 AndAlso Files.Count > 0 Then
SyncLock LockFiles
Files.Clear()
End SyncLock
End If
'开启新线程
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
'速度小于下限或剩余文件还贼多,尝试开启线程
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
'启动 Wait 的文件后立即会变成 Connect导致第二次循环再次调用所以需要先暂时存储进去……
'此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
Dim FilesWaiting As New List(Of NetFile)
Dim FilesLoading As New List(Of NetFile)
SyncLock LockFiles
For Each File As NetFile In Files.Values
If File.RandomCode Mod 2 = 0 Then Continue For
If File.State = NetState.WaitForDownload Then
FilesWaiting.Add(File)
ElseIf File.State < NetState.Merge Then
FilesLoading.Add(File)
End If
Next
End SyncLock
'为文件列表中的文件开始线程
For Each File As NetFile In FilesWaiting
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
For Each File As NetFile In FilesLoading
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
Loop While NewThreadCount > 0 AndAlso IsSuccess
End If
'等待直至 120 ms
Do While GetTimeTick() - LastLoopTime < 120
Thread.Sleep(10)
Loop
End While
Catch ex As Exception
Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert)
End Try
End Sub, "NetManager ThreadStarter Single")
RunInNewThread(Sub()
Try
Dim LastLoopTime As Long
While True
LastLoopTime = GetTimeTick()
'开启新线程
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
'速度小于下限或剩余文件还贼多,尝试开启线程
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
'启动 Wait 的文件后立即会变成 Connect导致第二次循环再次调用所以需要先暂时存储进去……
'此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
Dim FilesWaiting As New List(Of NetFile)
Dim FilesLoading As New List(Of NetFile)
SyncLock LockFiles
For Each File As NetFile In Files.Values
If File.RandomCode Mod 2 = 1 Then Continue For
If File.State = NetState.WaitForDownload Then
FilesWaiting.Add(File)
ElseIf File.State < NetState.Merge Then
FilesLoading.Add(File)
End If
Next
End SyncLock
'为文件列表中的文件开始线程
For Each File As NetFile In FilesWaiting
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
For Each File As NetFile In FilesLoading
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
Loop While NewThreadCount > 0 AndAlso IsSuccess
End If
'等待直至 120 ms
Do While GetTimeTick() - LastLoopTime < 120
Thread.Sleep(10)
Loop
End While
Catch ex As Exception
Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
End Try
End Sub, "NetManager ThreadStarter Odd")
RunInNewThread(Sub()
Try
Dim LastLoopTime As Long
NetTaskSpeedLimitLeftLast = GetTimeTick()
While True
Dim TimeNow = GetTimeTick()
LastLoopTime = TimeNow
'增加限速余量
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
NetTaskSpeedLimitLeftLast = TimeNow
'刷新公开属性
RefreshStat()
'等待直至 170 ms
Do While GetTimeTick() - LastLoopTime < 170
Thread.Sleep(10)
Loop
End While
Catch ex As Exception
Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
End Try
End Sub, "NetManager StatRefresher")
End Sub
Private IsManagerStarted As Boolean = False
'Public FileRemainList As New List(Of String)
Private IsDownloadCacheCleared As Boolean = False
''' <summary>
''' 开始一个下载任务。
''' </summary>
Public Sub Start(Task As LoaderDownload)
StartManager()
'清理缓存
If Not IsDownloadCacheCleared Then
Try
DeleteDirectory(PathTemp & "Download")
Catch ex As Exception
Log(ex, "清理下载缓存失败")
End Try
IsDownloadCacheCleared = True
End If
Directory.CreateDirectory(PathTemp & "Download")
'文件处理
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.Finish Then
'该文件已经下载过一次,且下载完成
'将已下载的文件替换成当前文件,重新下载
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
Files(File.LocalPath) = File
SyncLock LockRemain
FileRemain += 1
If ModeDebug Then Log("[Download] " & File.LocalName & ":已替换列表,剩余文件 " & FileRemain)
'FileRemainList.Add(File.LocalPath)
End SyncLock
Else
'该文件正在下载中
'将当前文件替换成下载中的文件,即两个任务指向同一个文件
File = Files(File.LocalPath)
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
End If
Else
'没有该文件
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
Files.Add(File.LocalPath, File)
SyncLock LockRemain
FileRemain += 1
If ModeDebug Then Log("[Download] " & File.LocalName & ":已加入列表,剩余文件 " & FileRemain)
'FileRemainList.Add(File.LocalPath)
End SyncLock
End If
Task.Files(i) = File '回设
Next
End SyncLock
SyncLock LockTasks
Tasks.Add(Task)
End SyncLock
End Sub
End Class
''' <summary>
''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
''' </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
Return False
End Function
End Module